From 62f1e6b804a940506eff5f3f924d2d000e16119d Mon Sep 17 00:00:00 2001 From: Egor Tensin Date: Mon, 18 Jul 2016 04:47:21 +0300 Subject: fix compiler warnings + refactoring --- apps/AddPath.hs | 18 +++++++++--------- apps/Banner.hs | 31 ------------------------------- apps/FixNtSymbolPath.hs | 18 +++++++++--------- apps/ListPath.hs | 22 ++++++++++++---------- apps/Prompt.hs | 18 ++++++++++++------ apps/PromptMessage.hs | 33 +++++++++++++++++++++++++++++++++ apps/RemovePath.hs | 21 +++++++++++---------- apps/SetEnv.hs | 20 ++++++++++---------- apps/UnsetEnv.hs | 24 ++++++++++++------------ windows-env.cabal | 24 ++++++++++++------------ 10 files changed, 120 insertions(+), 109 deletions(-) delete mode 100644 apps/Banner.hs create mode 100644 apps/PromptMessage.hs diff --git a/apps/AddPath.hs b/apps/AddPath.hs index 343207c..1f80f70 100644 --- a/apps/AddPath.hs +++ b/apps/AddPath.hs @@ -13,8 +13,8 @@ import Data.Maybe (fromMaybe) import Options.Applicative import qualified Windows.Environment as Env -import Banner import Prompt +import PromptMessage data Options = Options { optName :: Env.VarName @@ -23,8 +23,8 @@ data Options = Options , optPaths :: [Env.VarValue] } deriving (Eq, Show) -options :: Parser Options -options = Options +optionParser :: Parser Options +optionParser = Options <$> optNameDesc <*> optYesDesc <*> optGlobalDesc @@ -46,7 +46,7 @@ options = Options main :: IO () main = execParser parser >>= addPath where - parser = info (helper <*> options) $ + parser = info (helper <*> optionParser) $ fullDesc <> progDesc "Add directories to your PATH" addPath :: Options -> IO () @@ -56,8 +56,11 @@ addPath options = do let newPaths = union oldPaths pathsToAdd when (length oldPaths /= length newPaths) $ do let newValue = Env.pathJoin newPaths - let banner = engraveBanner profile varName oldValue newValue - void $ prompt banner $ Env.engrave profile varName newValue + let promptAnd = if skipPrompt + then withoutPrompt + else withPrompt $ engraveMessage profile varName oldValue newValue + let engrave = Env.engrave profile varName newValue + void $ promptAnd engrave where varName = optName options pathsToAdd = optPaths options @@ -68,6 +71,3 @@ addPath options = do | otherwise = Env.CurrentUser skipPrompt = optYes options - prompt - | skipPrompt = const withoutPrompt - | otherwise = withPrompt diff --git a/apps/Banner.hs b/apps/Banner.hs deleted file mode 100644 index c25741b..0000000 --- a/apps/Banner.hs +++ /dev/null @@ -1,31 +0,0 @@ -{- - - Copyright 2016 Egor Tensin - - This file is licensed under the terms of the MIT License. - - See LICENSE.txt for details. --} - -module Banner - ( engraveBanner - , wipeBanner - ) where - -import Data.Maybe (fromJust, isJust) -import Text.Printf (printf) - -import qualified Windows.Environment as Env - -engraveBanner :: Env.Profile -> Env.VarName -> Maybe Env.VarValue -> Env.VarValue -> String -engraveBanner profile name oldValue newValue = - warning ++ valuesStr - where - warning = printf "Saving variable '%s' to '%s'...\n" name (Env.profileKeyPath profile) - valuesStr - | isJust oldValue = oldValueStr ++ newValueStr - | otherwise = theValueStr - oldValueStr = printf "\tOld value: %s\n" $ fromJust oldValue - newValueStr = printf "\tNew value: %s\n" newValue - theValueStr = printf "\tValue: %s\n" newValue - -wipeBanner :: Env.Profile -> Env.VarName -> String -wipeBanner profile name = - printf "Deleting variable '%s' from '%s'...\n" name (Env.profileKeyPath profile) diff --git a/apps/FixNtSymbolPath.hs b/apps/FixNtSymbolPath.hs index 219ceb2..a1b1e9e 100644 --- a/apps/FixNtSymbolPath.hs +++ b/apps/FixNtSymbolPath.hs @@ -15,16 +15,16 @@ import System.FilePath (combine) import Options.Applicative import qualified Windows.Environment as Env -import Banner import Prompt +import PromptMessage data Options = Options { optYes :: Bool , optGlobal :: Bool } deriving (Eq, Show) -options :: Parser Options -options = Options +optionParser :: Parser Options +optionParser = Options <$> optYesDesc <*> optGlobalDesc where @@ -73,8 +73,11 @@ fixNtSymbolPath options = do let newPaths = union oldPaths $ dirPaths remoteDirs when (length oldPaths /= length newPaths) $ do let newValue = Env.pathJoin newPaths - let banner = engraveBanner profile varName oldValue newValue - agreed <- prompt banner $ Env.engrave profile varName newValue + let promptAnd = if skipPrompt + then withoutPrompt + else withPrompt $ engraveMessage profile varName oldValue newValue + let engrave = Env.engrave profile varName newValue + agreed <- promptAnd engrave when agreed $ createDirs localDirs where @@ -86,12 +89,9 @@ fixNtSymbolPath options = do | otherwise = Env.CurrentUser skipPrompt = optYes options - prompt - | skipPrompt = const withoutPrompt - | otherwise = withPrompt main :: IO () main = execParser parser >>= fixNtSymbolPath where - parser = info (helper <*> options) $ + parser = info (helper <*> optionParser) $ fullDesc <> progDesc "Set up your _NT_SYMBOL_PATH" diff --git a/apps/ListPath.hs b/apps/ListPath.hs index f33983d..03c0e68 100644 --- a/apps/ListPath.hs +++ b/apps/ListPath.hs @@ -18,8 +18,8 @@ data Options = Options { optName :: Env.VarName } deriving (Eq, Show) -options :: Parser Options -options = Options <$> optNameDesc +optionParser :: Parser Options +optionParser = Options <$> optNameDesc where optNameDesc = strOption $ long "name" <> short 'n' <> metavar "NAME" <> value "PATH" <> @@ -28,18 +28,20 @@ options = Options <$> optNameDesc main :: IO () main = execParser parser >>= listPath where - parser = info (helper <*> options) $ + parser = info (helper <*> optionParser) $ fullDesc <> progDesc "List directories in your PATH" listPath :: Options -> IO () listPath options = do - oldValue <- getEnv varName - let oldPaths = Env.pathSplit oldValue - mapM_ printPath oldPaths + oldValue <- query + printPaths $ Env.pathSplit oldValue where varName = optName options - getEnv = liftM (fromMaybe "") . lookupEnv - printPath p = do - exists <- doesDirectoryExist p - putStrLn $ (if exists then "+" else "-") ++ " " ++ p + query = liftM (fromMaybe "") $ lookupEnv varName + + printPath path = do + exists <- doesDirectoryExist path + putStrLn $ (if exists then "+" else "-") ++ " " ++ path + + printPaths = mapM_ printPath diff --git a/apps/Prompt.hs b/apps/Prompt.hs index 97c23fa..d2127cd 100644 --- a/apps/Prompt.hs +++ b/apps/Prompt.hs @@ -7,6 +7,7 @@ module Prompt ( withPrompt , withoutPrompt + , promptUnless ) where import Control.Monad (liftM, void, when) @@ -14,14 +15,14 @@ import Data.Char (toLower) import System.IO (hFlush, stdout) prompt :: String -> IO String -prompt banner = do - putStr banner +prompt msg = do + putStr msg hFlush stdout getLine promptYesNo :: String -> IO Bool -promptYesNo banner = do - response <- liftM (map toLower) $ prompt banner +promptYesNo msg = do + response <- liftM (map toLower) $ prompt msg if response `elem` yeses then return True else if response `elem` noes @@ -35,8 +36,8 @@ promptToContinue :: IO Bool promptToContinue = promptYesNo "Continue? (y/n) " withPrompt :: String -> IO a -> IO Bool -withPrompt banner m = do - putStr banner +withPrompt msg m = do + putStr msg hFlush stdout agreed <- promptToContinue when agreed $ void m @@ -44,3 +45,8 @@ withPrompt banner m = do withoutPrompt :: IO a -> IO Bool withoutPrompt m = m >> return True + +promptUnless :: Bool -> String -> IO a -> IO Bool +promptUnless skipPrompt msg + | skipPrompt = withoutPrompt + | otherwise = withPrompt msg diff --git a/apps/PromptMessage.hs b/apps/PromptMessage.hs new file mode 100644 index 0000000..226a090 --- /dev/null +++ b/apps/PromptMessage.hs @@ -0,0 +1,33 @@ +{- + - Copyright 2016 Egor Tensin + - This file is licensed under the terms of the MIT License. + - See LICENSE.txt for details. +-} + +module PromptMessage + ( engraveMessage + , wipeMessage + ) where + +import Data.Maybe (fromJust, isJust) +import Text.Printf (printf) + +import qualified Windows.Environment as Env + +engraveMessage :: Env.Profile -> Env.VarName -> Maybe Env.VarValue -> Env.VarValue -> String +engraveMessage profile name oldValue newValue = + warning ++ values + where + warning = printf "Saving variable '%s' to '%s'...\n" name $ Env.profileKeyPath profile + + values + | isJust oldValue = oldValueMsg ++ newValueMsg + | otherwise = valueMsg + + oldValueMsg = printf "\tOld value: %s\n" $ fromJust oldValue + newValueMsg = printf "\tNew value: %s\n" newValue + valueMsg = printf "\tValue: %s\n" newValue + +wipeMessage :: Env.Profile -> Env.VarName -> String +wipeMessage profile name = + printf "Deleting variable '%s' from '%s'...\n" name $ Env.profileKeyPath profile diff --git a/apps/RemovePath.hs b/apps/RemovePath.hs index 871ebef..4c4f289 100644 --- a/apps/RemovePath.hs +++ b/apps/RemovePath.hs @@ -13,8 +13,8 @@ import Data.Maybe (fromJust, isJust) import Options.Applicative import qualified Windows.Environment as Env -import Banner import Prompt +import PromptMessage data Options = Options { optName :: Env.VarName @@ -23,7 +23,8 @@ data Options = Options , optPaths :: [Env.VarValue] } deriving (Eq, Show) -options = Options +optionParser :: Parser Options +optionParser = Options <$> optNameDesc <*> optYesDesc <*> optGlobalDesc @@ -45,7 +46,7 @@ options = Options main :: IO () main = execParser parser >>= removePath where - parser = info (helper <*> options) $ + parser = info (helper <*> optionParser) $ fullDesc <> progDesc "Remove directories from your PATH" removePath :: Options -> IO () @@ -59,6 +60,8 @@ removePath options = do forAllUsers = optGlobal options + skipPrompt = optYes options + removePathFrom profile = do oldValue <- Env.query profile varName when (isJust oldValue) $ do @@ -66,10 +69,8 @@ removePath options = do let newPaths = oldPaths \\ pathsToRemove when (length oldPaths /= length newPaths) $ do let newValue = Env.pathJoin newPaths - let banner = engraveBanner profile varName oldValue newValue - void $ prompt banner $ Env.engrave profile varName newValue - - skipPrompt = optYes options - prompt - | skipPrompt = const withoutPrompt - | otherwise = withPrompt + let promptAnd = if skipPrompt + then withoutPrompt + else withPrompt $ engraveMessage profile varName oldValue newValue + let engrave = Env.engrave profile varName newValue + void $ promptAnd engrave diff --git a/apps/SetEnv.hs b/apps/SetEnv.hs index e94e350..482bb31 100644 --- a/apps/SetEnv.hs +++ b/apps/SetEnv.hs @@ -11,8 +11,8 @@ import Control.Monad (void) import Options.Applicative import qualified Windows.Environment as Env -import Banner import Prompt +import PromptMessage data Options = Options { optYes :: Bool @@ -21,8 +21,8 @@ data Options = Options , optValue :: Env.VarValue } deriving (Eq, Show) -options :: Parser Options -options = Options +optionParser :: Parser Options +optionParser = Options <$> optYesDesc <*> optGlobalDesc <*> optNameDesc @@ -44,14 +44,12 @@ options = Options main :: IO () main = execParser parser >>= setEnv where - parser = info (helper <*> options) $ + parser = info (helper <*> optionParser) $ fullDesc <> progDesc "Set environment variable" setEnv :: Options -> IO () -setEnv options = void $ prompt banner $ Env.engrave profile varName varValue +setEnv options = void $ promptAnd engrave where - banner = engraveBanner profile varName Nothing varValue - varName = optName options varValue = optValue options @@ -61,6 +59,8 @@ setEnv options = void $ prompt banner $ Env.engrave profile varName varValue | otherwise = Env.CurrentUser skipPrompt = optYes options - prompt - | skipPrompt = const withoutPrompt - | otherwise = withPrompt + promptAnd + | skipPrompt = withoutPrompt + | otherwise = withPrompt $ engraveMessage profile varName Nothing varValue + + engrave = Env.engrave profile varName varValue diff --git a/apps/UnsetEnv.hs b/apps/UnsetEnv.hs index eebef00..767c681 100644 --- a/apps/UnsetEnv.hs +++ b/apps/UnsetEnv.hs @@ -11,8 +11,8 @@ import Control.Monad (void) import Options.Applicative import qualified Windows.Environment as Env -import Banner import Prompt +import PromptMessage data Options = Options { optYes :: Bool @@ -20,13 +20,13 @@ data Options = Options , optName :: Env.VarName } deriving (Eq, Show) -options :: Parser Options -options = Options - <$> optYes +optionParser :: Parser Options +optionParser = Options + <$> optYesDesc <*> optGlobalDesc <*> optNameDesc where - optYes = switch $ + optYesDesc = switch $ long "yes" <> short 'y' <> help "Skip confirmation prompt" optGlobalDesc = switch $ @@ -39,14 +39,12 @@ options = Options main :: IO () main = execParser parser >>= unsetEnv where - parser = info (helper <*> options) $ + parser = info (helper <*> optionParser) $ fullDesc <> progDesc "Unset environment variable" unsetEnv :: Options -> IO () -unsetEnv options = void $ prompt banner $ Env.wipe profile varName +unsetEnv options = void $ promptAnd wipe where - banner = wipeBanner profile varName - varName = optName options forAllUsers = optGlobal options @@ -55,6 +53,8 @@ unsetEnv options = void $ prompt banner $ Env.wipe profile varName | otherwise = Env.CurrentUser skipPrompt = optYes options - prompt - | skipPrompt = const withoutPrompt - | otherwise = withPrompt + promptAnd + | skipPrompt = withoutPrompt + | otherwise = withPrompt $ wipeMessage profile varName + + wipe = Env.wipe profile varName diff --git a/windows-env.cabal b/windows-env.cabal index 5a2857d..bb5677b 100644 --- a/windows-env.cabal +++ b/windows-env.cabal @@ -24,8 +24,8 @@ library executable add_path hs-source-dirs: apps main-is: AddPath.hs - other-modules: Banner, Prompt - ghc-options: -threaded -rtsopts -with-rtsopts=-N + other-modules: Prompt, PromptMessage + ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N build-depends: base , optparse-applicative , windows-env @@ -34,8 +34,8 @@ executable add_path executable fix_nt_symbol_path hs-source-dirs: apps main-is: FixNtSymbolPath.hs - other-modules: Banner, Prompt - ghc-options: -threaded -rtsopts -with-rtsopts=-N + other-modules: Prompt, PromptMessage + ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N build-depends: base, directory, filepath , optparse-applicative , windows-env @@ -44,8 +44,8 @@ executable fix_nt_symbol_path executable list_path hs-source-dirs: apps main-is: ListPath.hs - other-modules: Banner, Prompt - ghc-options: -threaded -rtsopts -with-rtsopts=-N + other-modules: Prompt, PromptMessage + ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N build-depends: base, directory , optparse-applicative , windows-env @@ -54,8 +54,8 @@ executable list_path executable remove_path hs-source-dirs: apps main-is: RemovePath.hs - other-modules: Banner, Prompt - ghc-options: -threaded -rtsopts -with-rtsopts=-N + other-modules: Prompt, PromptMessage + ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N build-depends: base , optparse-applicative , windows-env @@ -64,8 +64,8 @@ executable remove_path executable set_env hs-source-dirs: apps main-is: SetEnv.hs - other-modules: Banner, Prompt - ghc-options: -threaded -rtsopts -with-rtsopts=-N + other-modules: Prompt, PromptMessage + ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N build-depends: base , optparse-applicative , windows-env @@ -74,8 +74,8 @@ executable set_env executable unset_env hs-source-dirs: apps main-is: UnsetEnv.hs - other-modules: Banner, Prompt - ghc-options: -threaded -rtsopts -with-rtsopts=-N + other-modules: Prompt, PromptMessage + ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N build-depends: base , optparse-applicative , windows-env -- cgit v1.2.3