addpath: detect expandable paths

3 files changed, 72 insertions, 24 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