diff options
Diffstat (limited to 'app')
| -rw-r--r-- | app/AddPath.hs | 83 | ||||
| -rw-r--r-- | app/ListPaths.hs | 84 | ||||
| -rw-r--r-- | app/RemovePath.hs | 85 | ||||
| -rw-r--r-- | app/SetEnv.hs | 72 | ||||
| -rw-r--r-- | app/UnsetEnv.hs | 66 | ||||
| -rw-r--r-- | app/Utils/Prompt.hs | 50 | ||||
| -rw-r--r-- | app/Utils/PromptMessage.hs | 39 |
7 files changed, 479 insertions, 0 deletions
diff --git a/app/AddPath.hs b/app/AddPath.hs new file mode 100644 index 0000000..683b82f --- /dev/null +++ b/app/AddPath.hs @@ -0,0 +1,83 @@ +-- | +-- Copyright : (c) 2015 Egor Tensin <Egor.Tensin@gmail.com> +-- License : MIT +-- Maintainer : Egor.Tensin@gmail.com +-- Stability : experimental +-- Portability : Windows-only + +module Main (main) where + +import Control.Monad (void, when) +import Control.Monad.Trans.Except (catchE, runExceptT, throwE) +import Data.List (union) +import System.IO.Error (ioError, isDoesNotExistError) + +import Options.Applicative + +import qualified WindowsEnv + +import Utils.Prompt +import Utils.PromptMessage + +data Options = Options + { optName :: WindowsEnv.VarName + , optYes :: Bool + , optGlobal :: Bool + , optPaths :: [WindowsEnv.VarValue] + } deriving (Eq, Show) + +optionParser :: Parser Options +optionParser = Options + <$> optNameDesc + <*> optYesDesc + <*> optGlobalDesc + <*> optPathsDesc + where + optNameDesc = strOption + $ long "name" <> short 'n' + <> metavar "NAME" <> value "PATH" + <> help "Variable name ('PATH' by default)" + optYesDesc = switch + $ long "yes" <> short 'y' + <> help "Skip confirmation prompt" + optGlobalDesc = switch + $ long "global" <> short 'g' + <> help "Add for all users" + optPathsDesc = many $ argument str + $ metavar "PATH" + <> help "Directories to add" + +main :: IO () +main = execParser parser >>= addPath + where + parser = info (helper <*> optionParser) $ + fullDesc <> progDesc "Add directories to your PATH" + +addPath :: Options -> IO () +addPath options = runExceptT doAddPath >>= either ioError return + where + varName = optName options + pathsToAdd = optPaths options + + forAllUsers = optGlobal options + profile + | forAllUsers = WindowsEnv.AllUsers + | otherwise = WindowsEnv.CurrentUser + + skipPrompt = optYes options + + emptyIfMissing e + | isDoesNotExistError e = return "" + | otherwise = throwE e + + doAddPath = do + oldValue <- WindowsEnv.query profile varName `catchE` emptyIfMissing + let oldPaths = WindowsEnv.pathSplit oldValue + let newPaths = oldPaths `union` pathsToAdd + when (length oldPaths /= length newPaths) $ do + let newValue = WindowsEnv.pathJoin newPaths + let promptAnd = if skipPrompt + then withoutPrompt + 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 new file mode 100644 index 0000000..666423f --- /dev/null +++ b/app/ListPaths.hs @@ -0,0 +1,84 @@ +-- | +-- Copyright : (c) 2015 Egor Tensin <Egor.Tensin@gmail.com> +-- License : MIT +-- Maintainer : Egor.Tensin@gmail.com +-- Stability : experimental +-- Portability : Windows-only + +module Main (main) where + +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) + +import Options.Applicative + +import qualified WindowsEnv + +data WhichPaths = All | ExistingOnly | MissingOnly + deriving (Eq, Show) + +shouldListPath :: WhichPaths -> WindowsEnv.VarValue -> IO Bool +shouldListPath All = return . const True +shouldListPath ExistingOnly = doesDirectoryExist +shouldListPath MissingOnly = fmap not . doesDirectoryExist + +data Source = Environment | Registry WindowsEnv.Profile + deriving (Eq, Show) + +data Options = Options + { optName :: WindowsEnv.VarName + , optWhichPaths :: WhichPaths + , optSource :: Source + } deriving (Eq, Show) + +optionParser :: Parser Options +optionParser = Options + <$> optNameDesc + <*> optWhichPathsDesc + <*> optSourceDesc + where + optNameDesc = strOption + $ long "name" <> short 'n' + <> metavar "NAME" <> value "PATH" + <> help "Variable name ('PATH' by default)" + optWhichPathsDesc = pure All + <|> flag' ExistingOnly (long "existing" <> short 'e' + <> help "List existing paths only") + <|> flag' MissingOnly (long "missing" <> short 'm' + <> help "List missing paths only") + optSourceDesc = pure Environment + <|> flag' (Registry WindowsEnv.CurrentUser) (long "user" <> short 'u' + <> help "List current user's paths only") + <|> flag' (Registry WindowsEnv.AllUsers) (long "global" <> short 'g' + <> help "List global (all users') paths only") + +main :: IO () +main = execParser parser >>= listPaths + where + parser = info (helper <*> optionParser) $ + fullDesc <> progDesc "List directories in your PATH" + +listPaths :: Options -> IO () +listPaths options = runExceptT doListPaths >>= either ioError return + where + varName = optName options + whichPaths = optWhichPaths options + source = optSource options + + query = queryFrom source + + queryFrom Environment = lift $ fromMaybe "" <$> lookupEnv varName + queryFrom (Registry profile) = WindowsEnv.query profile varName + + filterPaths = filterM $ shouldListPath whichPaths + + doListPaths = do + paths <- WindowsEnv.pathSplit <$> query + lift $ do + pathsToPrint <- filterPaths paths + mapM_ putStrLn pathsToPrint diff --git a/app/RemovePath.hs b/app/RemovePath.hs new file mode 100644 index 0000000..6f2174b --- /dev/null +++ b/app/RemovePath.hs @@ -0,0 +1,85 @@ +-- | +-- Copyright : (c) 2015 Egor Tensin <Egor.Tensin@gmail.com> +-- License : MIT +-- Maintainer : Egor.Tensin@gmail.com +-- Stability : experimental +-- Portability : Windows-only + +module Main (main) where + +import Control.Monad (void, when) +import Control.Monad.Trans.Except (catchE, runExceptT, throwE) +import Data.List ((\\)) +import System.IO.Error (ioError, isDoesNotExistError) + +import Options.Applicative + +import qualified WindowsEnv + +import Utils.Prompt +import Utils.PromptMessage + +data Options = Options + { optName :: WindowsEnv.VarName + , optYes :: Bool + , optGlobal :: Bool + , optPaths :: [WindowsEnv.VarValue] + } deriving (Eq, Show) + +optionParser :: Parser Options +optionParser = Options + <$> optNameDesc + <*> optYesDesc + <*> optGlobalDesc + <*> optPathsDesc + where + optNameDesc = strOption + $ long "name" <> short 'n' + <> metavar "NAME" <> value "PATH" + <> help "Variable name ('PATH' by default)" + optYesDesc = switch + $ long "yes" <> short 'y' + <> help "Skip confirmation prompt" + optGlobalDesc = switch + $ long "global" <> short 'g' + <> help "Remove for all users" + optPathsDesc = many $ argument str + $ metavar "PATH" + <> help "Directories to remove" + +main :: IO () +main = execParser parser >>= removePath + where + parser = info (helper <*> optionParser) $ + fullDesc <> progDesc "Remove directories from your PATH" + +removePath :: Options -> IO () +removePath options = runExceptT doRemovePath >>= either ioError return + where + varName = optName options + pathsToRemove = optPaths options + + forAllUsers = optGlobal options + + skipPrompt = optYes options + + emptyIfMissing e + | isDoesNotExistError e = return "" + | otherwise = throwE e + + doRemovePath = do + removePathFrom WindowsEnv.CurrentUser + when forAllUsers $ + removePathFrom WindowsEnv.AllUsers + + removePathFrom profile = do + oldValue <- WindowsEnv.query profile varName `catchE` emptyIfMissing + let oldPaths = WindowsEnv.pathSplit oldValue + let newPaths = oldPaths \\ pathsToRemove + when (length oldPaths /= length newPaths) $ do + let newValue = WindowsEnv.pathJoin newPaths + let promptAnd = if skipPrompt + then withoutPrompt + 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 new file mode 100644 index 0000000..5948d3e --- /dev/null +++ b/app/SetEnv.hs @@ -0,0 +1,72 @@ +-- | +-- Copyright : (c) 2015 Egor Tensin <Egor.Tensin@gmail.com> +-- License : MIT +-- Maintainer : Egor.Tensin@gmail.com +-- Stability : experimental +-- Portability : Windows-only + +module Main (main) where + +import Control.Monad (void) +import Control.Monad.Trans.Except (runExceptT) +import System.IO.Error (ioError) + +import Options.Applicative + +import qualified WindowsEnv + +import Utils.Prompt +import Utils.PromptMessage + +data Options = Options + { optYes :: Bool + , optGlobal :: Bool + , optName :: WindowsEnv.VarName + , optValue :: WindowsEnv.VarValue + } deriving (Eq, Show) + +optionParser :: Parser Options +optionParser = Options + <$> optYesDesc + <*> optGlobalDesc + <*> optNameDesc + <*> optValueDesc + where + optYesDesc = switch + $ long "yes" <> short 'y' + <> help "Skip confirmation prompt" + optGlobalDesc = switch + $ long "global" <> short 'g' + <> help "Set for all users" + optNameDesc = argument str + $ metavar "NAME" + <> help "Variable name" + optValueDesc = argument str + $ metavar "VALUE" + <> help "Variable value" + +main :: IO () +main = execParser parser >>= setEnv + where + parser = info (helper <*> optionParser) $ + fullDesc <> progDesc "Define environment variables" + +setEnv :: Options -> IO () +setEnv options = runExceptT doSetEnv >>= either ioError return + where + varName = optName options + varValue = optValue options + + forAllUsers = optGlobal options + profile + | forAllUsers = WindowsEnv.AllUsers + | otherwise = WindowsEnv.CurrentUser + + skipPrompt = optYes options + promptAnd + | skipPrompt = withoutPrompt + | otherwise = withPrompt $ newMessage profile varName varValue + + engrave = WindowsEnv.engraveForce profile varName varValue + + doSetEnv = void $ promptAnd engrave diff --git a/app/UnsetEnv.hs b/app/UnsetEnv.hs new file mode 100644 index 0000000..98b52e3 --- /dev/null +++ b/app/UnsetEnv.hs @@ -0,0 +1,66 @@ +-- | +-- Copyright : (c) 2015 Egor Tensin <Egor.Tensin@gmail.com> +-- License : MIT +-- Maintainer : Egor.Tensin@gmail.com +-- Stability : experimental +-- Portability : Windows-only + +module Main (main) where + +import Control.Monad (void) +import Control.Monad.Trans.Except (runExceptT) +import System.IO.Error (ioError) + +import Options.Applicative + +import qualified WindowsEnv + +import Utils.Prompt +import Utils.PromptMessage + +data Options = Options + { optYes :: Bool + , optGlobal :: Bool + , optName :: WindowsEnv.VarName + } deriving (Eq, Show) + +optionParser :: Parser Options +optionParser = Options + <$> optYesDesc + <*> optGlobalDesc + <*> optNameDesc + where + optYesDesc = switch + $ long "yes" <> short 'y' + <> help "Skip confirmation prompt" + optGlobalDesc = switch + $ long "global" <> short 'g' + <> help "Unset for all users" + optNameDesc = argument str + $ metavar "NAME" + <> help "Variable name" + +main :: IO () +main = execParser parser >>= unsetEnv + where + parser = info (helper <*> optionParser) $ + fullDesc <> progDesc "Delete environment variables" + +unsetEnv :: Options -> IO () +unsetEnv options = runExceptT doUnsetEnv >>= either ioError return + where + varName = optName options + + forAllUsers = optGlobal options + profile + | forAllUsers = WindowsEnv.AllUsers + | otherwise = WindowsEnv.CurrentUser + + skipPrompt = optYes options + promptAnd + | skipPrompt = withoutPrompt + | otherwise = withPrompt $ wipeMessage profile varName + + wipe = WindowsEnv.wipe profile varName + + doUnsetEnv = void $ promptAnd wipe diff --git a/app/Utils/Prompt.hs b/app/Utils/Prompt.hs new file mode 100644 index 0000000..51b3f0c --- /dev/null +++ b/app/Utils/Prompt.hs @@ -0,0 +1,50 @@ +-- | +-- Copyright : (c) 2015 Egor Tensin <Egor.Tensin@gmail.com> +-- License : MIT +-- Maintainer : Egor.Tensin@gmail.com +-- Stability : experimental +-- Portability : portable + +module Utils.Prompt + ( withPrompt + , withoutPrompt + ) where + +import Control.Monad (void, when) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (ExceptT) +import Data.Char (toLower) +import System.IO (hFlush, stdout) + +prompt :: String -> IO String +prompt msg = do + putStr msg + hFlush stdout + getLine + +promptYesNo :: String -> IO Bool +promptYesNo msg = do + response <- map toLower <$> prompt msg + if response `elem` yeses + then return True + else if response `elem` noes + then return False + else promptToContinue + where + yeses = ["y", "yes"] + noes = ["n", "no"] + +promptToContinue :: IO Bool +promptToContinue = promptYesNo "Continue? (y/n) " + +withPrompt :: String -> ExceptT IOError IO a -> ExceptT IOError IO Bool +withPrompt msg m = do + lift $ do + putStr msg + hFlush stdout + agreed <- lift promptToContinue + when agreed $ void m + return agreed + +withoutPrompt :: ExceptT IOError IO a -> ExceptT IOError IO Bool +withoutPrompt m = m >> return True diff --git a/app/Utils/PromptMessage.hs b/app/Utils/PromptMessage.hs new file mode 100644 index 0000000..37fc1e6 --- /dev/null +++ b/app/Utils/PromptMessage.hs @@ -0,0 +1,39 @@ +-- | +-- Copyright : (c) 2016 Egor Tensin <Egor.Tensin@gmail.com> +-- License : MIT +-- Maintainer : Egor.Tensin@gmail.com +-- Stability : experimental +-- Portability : Windows-only + +module Utils.PromptMessage + ( oldNewMessage + , newMessage + , wipeMessage + ) where + +import Text.Printf (printf) + +import qualified WindowsEnv + +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 + +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 + +wipeMessage :: WindowsEnv.Profile -> WindowsEnv.VarName -> String +wipeMessage profile name = + printf "Deleting variable '%s' from '%s'...\n" name (show profileKey) + where + profileKey = WindowsEnv.profileKeyPath profile |