diff options
Diffstat (limited to '')
-rw-r--r-- | app/AddPath.hs | 2 | ||||
-rw-r--r-- | app/ListPaths.hs | 20 | ||||
-rw-r--r-- | app/RemovePath.hs | 2 | ||||
-rw-r--r-- | app/SetEnv.hs | 4 | ||||
-rw-r--r-- | app/Utils/PromptMessage.hs | 16 | ||||
-rw-r--r-- | src/WindowsEnv/Environment.hs | 50 | ||||
-rw-r--r-- | windows-env.cabal | 2 |
7 files changed, 56 insertions, 40 deletions
diff --git a/app/AddPath.hs b/app/AddPath.hs index 1993b4a..ff80b18 100644 --- a/app/AddPath.hs +++ b/app/AddPath.hs @@ -97,6 +97,6 @@ addPath options = runExceptT doAddPath >>= either ioError return promptAndEngrave oldValue newValue = do let promptAnd = if skipPrompt then withoutPrompt - else withPrompt $ oldNewMessage profile varName (show oldValue) (show newValue) + else withPrompt $ oldNewMessage profile varName oldValue newValue let engrave = WindowsEnv.engrave profile varName newValue void $ promptAnd engrave diff --git a/app/ListPaths.hs b/app/ListPaths.hs index 8a31cb8..f832686 100644 --- a/app/ListPaths.hs +++ b/app/ListPaths.hs @@ -11,7 +11,6 @@ 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) @@ -22,10 +21,10 @@ import qualified WindowsEnv data WhichPaths = All | ExistingOnly | MissingOnly deriving (Eq, Show) -shouldListPath :: WhichPaths -> String -> IO Bool +shouldListPath :: WhichPaths -> WindowsEnv.ExpandedPath -> IO Bool shouldListPath All = return . const True -shouldListPath ExistingOnly = doesDirectoryExist -shouldListPath MissingOnly = fmap not . doesDirectoryExist +shouldListPath ExistingOnly = WindowsEnv.pathExists +shouldListPath MissingOnly = fmap not . WindowsEnv.pathExists data Source = Environment | Registry WindowsEnv.Profile deriving (Eq, Show) @@ -71,13 +70,12 @@ listPaths options = runExceptT doListPaths >>= either ioError return query = queryFrom $ optSource options - queryFrom Environment = lift $ fromMaybe "" <$> lookupEnv varName - queryFrom (Registry profile) = show <$> WindowsEnv.query profile varName - - filterPaths = filterM (shouldListPath whichPaths . WindowsEnv.pathExpanded) + queryFrom Environment = lift $ WindowsEnv.VarValue False <$> fromMaybe "" <$> lookupEnv varName + queryFrom (Registry profile) = WindowsEnv.query profile varName doListPaths = do - paths <- query >>= WindowsEnv.pathSplitAndExpand + value <- query + split <- WindowsEnv.pathSplitAndExpand value lift $ do - pathsToPrint <- filterPaths paths - mapM_ (putStrLn . WindowsEnv.pathOriginal) pathsToPrint + wanted <- filterM (shouldListPath whichPaths) split + mapM_ (putStrLn . WindowsEnv.pathOriginal) wanted diff --git a/app/RemovePath.hs b/app/RemovePath.hs index 2d0d47c..23cabb7 100644 --- a/app/RemovePath.hs +++ b/app/RemovePath.hs @@ -85,6 +85,6 @@ removePath options = runExceptT doRemovePath >>= either ioError return let newValue = WindowsEnv.VarValue (WindowsEnv.varValueExpandable oldValue) (WindowsEnv.pathJoin newPaths) let promptAnd = if skipPrompt then withoutPrompt - else withPrompt $ oldNewMessage profile varName (show oldValue) (show newValue) + else withPrompt $ oldNewMessage profile varName oldValue newValue let engrave = WindowsEnv.engrave profile varName newValue void $ promptAnd engrave diff --git a/app/SetEnv.hs b/app/SetEnv.hs index bb058d8..a986226 100644 --- a/app/SetEnv.hs +++ b/app/SetEnv.hs @@ -55,7 +55,7 @@ setEnv :: Options -> IO () setEnv options = runExceptT doSetEnv >>= either ioError return where varName = optName options - varValue = optValue options + varValue = WindowsEnv.VarValue False $ optValue options forAllUsers = optGlobal options profile @@ -67,6 +67,6 @@ setEnv options = runExceptT doSetEnv >>= either ioError return | skipPrompt = withoutPrompt | otherwise = withPrompt $ newMessage profile varName varValue - engrave = WindowsEnv.engrave profile varName $ WindowsEnv.VarValue False varValue + engrave = WindowsEnv.engrave profile varName varValue doSetEnv = void $ promptAnd engrave diff --git a/app/Utils/PromptMessage.hs b/app/Utils/PromptMessage.hs index 9afffb1..1315b85 100644 --- a/app/Utils/PromptMessage.hs +++ b/app/Utils/PromptMessage.hs @@ -15,25 +15,25 @@ import Text.Printf (printf) import qualified WindowsEnv -oldNewMessage :: WindowsEnv.Profile -> WindowsEnv.VarName -> String -> String -> String +oldNewMessage :: WindowsEnv.Profile -> WindowsEnv.VarName -> WindowsEnv.VarValue -> WindowsEnv.VarValue -> String oldNewMessage profile name oldValue newValue = descrMsg ++ oldValueMsg ++ newValueMsg where profileKey = WindowsEnv.profileKeyPath profile - descrMsg = printf "Saving variable '%s' to '%s'...\n" name (show profileKey) - oldValueMsg = printf "\tOld value: %s\n" oldValue - newValueMsg = printf "\tNew value: %s\n" newValue + descrMsg = printf "Saving variable '%s' to '%s'...\n" name $ show profileKey + oldValueMsg = printf "\tOld value: %s\n" $ WindowsEnv.varValueString oldValue + newValueMsg = printf "\tNew value: %s\n" $ WindowsEnv.varValueString newValue -newMessage :: WindowsEnv.Profile -> WindowsEnv.VarName -> String -> String +newMessage :: WindowsEnv.Profile -> WindowsEnv.VarName -> WindowsEnv.VarValue -> String newMessage profile name newValue = descrMsg ++ newValueMsg where profileKey = WindowsEnv.profileKeyPath profile - descrMsg = printf "Saving variable '%s' to '%s'...\n" name (show profileKey) - newValueMsg = printf "\tNew value: %s\n" newValue + descrMsg = printf "Saving variable '%s' to '%s'...\n" name $ show profileKey + newValueMsg = printf "\tNew value: %s\n" $ WindowsEnv.varValueString newValue wipeMessage :: WindowsEnv.Profile -> WindowsEnv.VarName -> String wipeMessage profile name = - printf "Deleting variable '%s' from '%s'...\n" name (show profileKey) + printf "Deleting variable '%s' from '%s'...\n" name $ show profileKey where profileKey = WindowsEnv.profileKeyPath profile diff --git a/src/WindowsEnv/Environment.hs b/src/WindowsEnv/Environment.hs index e56f5c9..9a42748 100644 --- a/src/WindowsEnv/Environment.hs +++ b/src/WindowsEnv/Environment.hs @@ -25,8 +25,12 @@ module WindowsEnv.Environment , pathSplit , expand - , ExpandedPath(..) , pathSplitAndExpand + + , ExpandedPath(..) + , pathOriginal + , pathExpanded + , pathExists ) where import Control.Monad.Trans.Class (lift) @@ -35,6 +39,7 @@ 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) import qualified System.Win32.Types as WinAPI @@ -119,19 +124,32 @@ expand value = ExceptT $ catchIOError (Right <$> doExpand) (return . Left) else WinAPI.peekTString bufferPtr doExpand = WinAPI.withTString value $ \valuePtr -> doExpandIn valuePtr WinAPI.nullPtr 0 -data ExpandedPath = ExpandedPath - { pathOriginal :: String - , pathExpanded :: String - } deriving (Eq, Show) - -pathSplitAndExpand :: String -> ExceptT IOError IO [ExpandedPath] -pathSplitAndExpand value = do - expandedOnce <- expandOnce - zipWith ExpandedPath originalPaths <$> - if length expandedOnce == length originalPaths - then return expandedOnce - else expandEach +data ExpandedPath = UnexpandedPath String + | ExpandedPath String String + deriving (Eq, Show) + +pathOriginal :: ExpandedPath -> String +pathOriginal (UnexpandedPath path) = path +pathOriginal (ExpandedPath original expanded) = original + +pathExpanded :: ExpandedPath -> String +pathExpanded (UnexpandedPath path) = path +pathExpanded (ExpandedPath original expanded) = expanded + +pathExists :: ExpandedPath -> IO Bool +pathExists = doesDirectoryExist . pathExpanded + +pathSplitAndExpand :: VarValue -> ExceptT IOError IO [ExpandedPath] +pathSplitAndExpand value + | varValueExpandable value = do + expanded <- expandOnce + zipWith ExpandedPath split <$> + if length expanded == length split + then return expanded + else expandEach + | otherwise = return $ map UnexpandedPath $ pathSplit joined where - originalPaths = pathSplit value - expandOnce = pathSplit <$> expand value - expandEach = mapM expand originalPaths + joined = varValueString value + split = pathSplit joined + expandOnce = pathSplit <$> expand joined + expandEach = mapM expand split diff --git a/windows-env.cabal b/windows-env.cabal index 9990cc6..9850c2c 100644 --- a/windows-env.cabal +++ b/windows-env.cabal @@ -27,6 +27,7 @@ library ghc-options: -Wall -Werror build-depends: base , bytestring + , directory , split , text , transformers @@ -50,7 +51,6 @@ executable paths other-modules: Utils.Prompt, Utils.PromptMessage ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N build-depends: base - , directory , optparse-applicative , transformers , windows-env |