aboutsummaryrefslogtreecommitdiffstatshomepage
diff options
context:
space:
mode:
authorEgor Tensin <Egor.Tensin@gmail.com>2017-06-13 06:21:34 +0300
committerEgor Tensin <Egor.Tensin@gmail.com>2017-06-13 06:21:34 +0300
commitc7094f015773285170c3ae15f2d4cb1f158a6c1a (patch)
tree2587b9e22f2a5c30ffb55b6ddbacae25e8f54f90
parentfeature registry value type in prompts (diff)
downloadwindows-env-c7094f015773285170c3ae15f2d4cb1f158a6c1a.tar.gz
windows-env-c7094f015773285170c3ae15f2d4cb1f158a6c1a.zip
addpath: detect expandable paths
-rw-r--r--app/AddPath.hs36
-rw-r--r--app/ListPaths.hs13
-rw-r--r--app/Utils/Path.hs47
-rw-r--r--src/WindowsEnv/Environment.hs39
-rw-r--r--windows-env.cabal5
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