addpath: detect expandable paths

5 files changed, 78 insertions, 62 deletions

diff --git a/app/AddPath.hs b/app/AddPath.hs
index 1152df6..209e28c 100644
--- a/app/AddPath.hs
+++ b/app/AddPath.hs
@@ -7,15 +7,16 @@
 
 module Main (main) where
 
-import Control.Monad   (unless, void)
+import Control.Monad   (when, void)
 import Control.Monad.Trans.Except (catchE, runExceptT, throwE)
-import Data.List       ((\\), nub)
+import Data.List       (nub)
 import System.IO.Error (ioError, isDoesNotExistError)
 
 import Options.Applicative
 
 import qualified WindowsEnv
 
+import Utils.Path
 import Utils.Prompt
 import Utils.PromptMessage
 
@@ -71,30 +72,27 @@ addPath options = runExceptT doAddPath >>= either ioError return
         | otherwise   = WindowsEnv.CurrentUser
 
     prepend = optPrepend options
-    mergePaths old new
+    appendPaths old new
         | prepend = new ++ old
         | otherwise = old ++ new
 
     emptyIfMissing e
-        | isDoesNotExistError e = defaultValue
+        | isDoesNotExistError e = return $ WindowsEnv.Value False ""
         | otherwise = throwE e
 
-    defaultValue = do
-        expandedPaths <- mapM WindowsEnv.expand pathsToAdd
-        if pathsToAdd == expandedPaths
-            then return $ WindowsEnv.Value False ""
-            else return $ WindowsEnv.Value True ""
-
     doAddPath = do
-        oldValue <- WindowsEnv.query profile varName `catchE` emptyIfMissing
-        let expandable = WindowsEnv.valueExpandable oldValue
-        let joined = WindowsEnv.valueString oldValue
-        let split = WindowsEnv.pathSplit joined
-        let missing = pathsToAdd \\ split
-        unless (null missing) $ do
-            let merged = mergePaths split missing
-            let newValue = WindowsEnv.Value expandable (WindowsEnv.pathJoin merged)
-            promptAndEngrave oldValue newValue
+        newPaths <- pathExpandAll pathsToAdd
+        let newExpandable = pathAnyExpanded newPaths
+        srcValue <- WindowsEnv.query profile varName `catchE` emptyIfMissing
+        let srcExpandable = WindowsEnv.valueExpandable srcValue
+        let destExpandable = newExpandable || srcExpandable
+        srcPaths <- pathExpandValue srcValue
+            { WindowsEnv.valueExpandable = destExpandable }
+        let destPaths = appendPaths srcPaths $ filter (`notElem` srcPaths) newPaths
+        let destPathsJoined = WindowsEnv.pathJoin $ map pathOriginal destPaths
+        let destValue = WindowsEnv.Value destExpandable destPathsJoined
+        when (srcValue /= destValue) $ do
+            promptAndEngrave srcValue destValue
 
     promptAndEngrave oldValue newValue = do
         let promptAnd = if skipPrompt
diff --git a/app/ListPaths.hs b/app/ListPaths.hs
index 0c8483c..792c98b 100644
--- a/app/ListPaths.hs
+++ b/app/ListPaths.hs
@@ -11,6 +11,7 @@ import Control.Monad      (filterM)
 import Control.Monad.Trans.Class  (lift)
 import Control.Monad.Trans.Except (runExceptT)
 import Data.Maybe         (fromMaybe)
+import System.Directory   (doesDirectoryExist)
 import System.Environment (lookupEnv)
 import System.IO.Error    (ioError)
 
@@ -18,13 +19,15 @@ import Options.Applicative
 
 import qualified WindowsEnv
 
+import Utils.Path
+
 data WhichPaths = All | ExistingOnly | MissingOnly
                 deriving (Eq, Show)
 
-shouldListPath :: WhichPaths -> WindowsEnv.ExpandedPath -> IO Bool
+shouldListPath :: WhichPaths -> ExpandedPath -> IO Bool
 shouldListPath All = return . const True
-shouldListPath ExistingOnly = WindowsEnv.pathExists
-shouldListPath MissingOnly  = fmap not . WindowsEnv.pathExists
+shouldListPath ExistingOnly = doesDirectoryExist . pathExpanded
+shouldListPath MissingOnly  = fmap not . doesDirectoryExist . pathExpanded
 
 data Source = Environment | Registry WindowsEnv.Profile
             deriving (Eq, Show)
@@ -77,7 +80,7 @@ listPaths options = runExceptT doListPaths >>= either ioError return
 
     doListPaths = do
         varValue <- query
-        split <- WindowsEnv.pathSplitAndExpand varValue
+        split <- pathExpandValue varValue
         lift $ do
             wanted <- filterM (shouldListPath whichPaths) split
-            mapM_ (putStrLn . WindowsEnv.pathOriginal) wanted
+            mapM_ (putStrLn . pathOriginal) wanted
diff --git a/app/Utils/Path.hs b/app/Utils/Path.hs
new file mode 100644
index 0000000..01259e7
--- /dev/null
+++ b/app/Utils/Path.hs
@@ -0,0 +1,47 @@
+-- |
+-- Copyright   : (c) 2017 Egor Tensin <Egor.Tensin@gmail.com>
+-- License     : MIT
+-- Maintainer  : Egor.Tensin@gmail.com
+-- Stability   : experimental
+-- Portability : Windows-only
+
+module Utils.Path
+    ( ExpandedPath(..)
+    , pathExpandValue
+
+    , pathExpandAll
+    , pathAnyExpanded
+    ) where
+
+import Control.Monad.Trans.Except (ExceptT)
+
+import qualified WindowsEnv
+
+data ExpandedPath = ExpandedPath
+    { pathOriginal :: String
+    , pathExpanded :: String
+    } deriving (Eq, Show)
+
+pathExpandValue :: WindowsEnv.Value -> ExceptT IOError IO [ExpandedPath]
+pathExpandValue value
+    | WindowsEnv.valueExpandable value = do
+        expanded <- expandOnce
+        zipWith ExpandedPath split <$>
+            if length expanded == length split
+                then return expanded
+                else expandEach
+    | otherwise = return $ zipWith ExpandedPath split split
+  where
+    joined = WindowsEnv.valueString value
+    split = WindowsEnv.pathSplit joined
+    expandOnce = WindowsEnv.pathSplit <$> WindowsEnv.expand joined
+    expandEach = WindowsEnv.expandAll split
+
+pathExpandAll :: [String] -> ExceptT IOError IO [ExpandedPath]
+pathExpandAll paths = zipWith ExpandedPath paths <$> WindowsEnv.expandAll paths
+
+pathIsExpanded :: ExpandedPath -> Bool
+pathIsExpanded path = pathOriginal path /= pathExpanded path
+
+pathAnyExpanded :: [ExpandedPath] -> Bool
+pathAnyExpanded = any pathIsExpanded
diff --git a/src/WindowsEnv/Environment.hs b/src/WindowsEnv/Environment.hs
index 5bd5bf6..258a1ae 100644
--- a/src/WindowsEnv/Environment.hs
+++ b/src/WindowsEnv/Environment.hs
@@ -25,12 +25,7 @@ module WindowsEnv.Environment
     , pathSplit
 
     , expand
-
-    , pathSplitAndExpand
-    , ExpandedPath(..)
-    , pathOriginal
-    , pathExpanded
-    , pathExists
+    , expandAll
     ) where
 
 import           Control.Monad.Trans.Class  (lift)
@@ -39,7 +34,6 @@ import           Data.List             (intercalate)
 import           Data.List.Split       (splitOn)
 import           Foreign.Marshal.Alloc (allocaBytes)
 import           Foreign.Storable      (sizeOf)
-import           System.Directory      (doesDirectoryExist)
 import           System.IO.Error       (catchIOError, isDoesNotExistError)
 import qualified System.Win32.Types    as WinAPI
 
@@ -125,32 +119,5 @@ expand value = ExceptT $ catchIOError (Right <$> doExpand) (return . Left)
             else WinAPI.peekTString bufferPtr
     doExpand = WinAPI.withTString value $ \valuePtr -> doExpandIn valuePtr WinAPI.nullPtr 0
 
-data ExpandedPath = UnexpandedPath String
-                  | ExpandedPath String String
-                  deriving (Eq, Show)
-
-pathOriginal :: ExpandedPath -> String
-pathOriginal (UnexpandedPath path) = path
-pathOriginal (ExpandedPath original _) = original
-
-pathExpanded :: ExpandedPath -> String
-pathExpanded (UnexpandedPath path) = path
-pathExpanded (ExpandedPath _ expanded) = expanded
-
-pathExists :: ExpandedPath -> IO Bool
-pathExists = doesDirectoryExist . pathExpanded
-
-pathSplitAndExpand :: Value -> ExceptT IOError IO [ExpandedPath]
-pathSplitAndExpand value
-    | valueExpandable value = do
-        expanded <- expandOnce
-        zipWith ExpandedPath split <$>
-            if length expanded == length split
-                then return expanded
-                else expandEach
-    | otherwise = return $ map UnexpandedPath $ pathSplit joined
-  where
-    joined = valueString value
-    split = pathSplit joined
-    expandOnce = pathSplit <$> expand joined
-    expandEach = mapM expand split
+expandAll :: [String] -> ExceptT IOError IO [String]
+expandAll = mapM expand
diff --git a/windows-env.cabal b/windows-env.cabal
index 9850c2c..d25e427 100644
--- a/windows-env.cabal
+++ b/windows-env.cabal
@@ -37,7 +37,7 @@ library
 executable addpath
   hs-source-dirs:     app
   main-is:            AddPath.hs
-  other-modules:      Utils.Prompt, Utils.PromptMessage
+  other-modules:      Utils.Path, Utils.Prompt, Utils.PromptMessage
   ghc-options:        -Wall -Werror -threaded -rtsopts -with-rtsopts=-N
   build-depends:      base
                     , optparse-applicative
@@ -48,9 +48,10 @@ executable addpath
 executable paths
   hs-source-dirs:     app
   main-is:            ListPaths.hs
-  other-modules:      Utils.Prompt, Utils.PromptMessage
+  other-modules:      Utils.Path, Utils.Prompt, Utils.PromptMessage
   ghc-options:        -Wall -Werror -threaded -rtsopts -with-rtsopts=-N
   build-depends:      base
+                    , directory
                     , optparse-applicative
                     , transformers
                     , windows-env