diff options
Diffstat (limited to '')
| -rw-r--r-- | app/AddPath.hs | 36 | ||||
| -rw-r--r-- | app/ListPaths.hs | 13 | ||||
| -rw-r--r-- | app/Utils/Path.hs | 47 |
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 |