From d7d33810d562a80e0954bafe045ae2275109999a Mon Sep 17 00:00:00 2001 From: Egor Tensin Date: Tue, 13 Dec 2016 01:47:35 +0300 Subject: bugfix (withPrompt no longer swallows IOError) --- apps/AddPath.hs | 12 +++++------- apps/ListPath.hs | 3 ++- apps/Prompt.hs | 13 ++++++++----- apps/RemovePath.hs | 19 +++++++------------ apps/SetEnv.hs | 14 +++++++------- apps/UnsetEnv.hs | 14 +++++++------- 6 files changed, 36 insertions(+), 39 deletions(-) (limited to 'apps') diff --git a/apps/AddPath.hs b/apps/AddPath.hs index 2f1870c..5ff96c5 100644 --- a/apps/AddPath.hs +++ b/apps/AddPath.hs @@ -7,12 +7,12 @@ module Main (main) where import Control.Monad (void, when) -import Control.Monad.Trans.Class -import Control.Monad.Trans.Except +import Control.Monad.Trans.Except (catchE, runExceptT, throwE) import Data.List (union) import System.IO.Error (ioError, isDoesNotExistError) -import Options.Applicative +import Options.Applicative + import qualified Windows.Environment as Env import Prompt @@ -53,9 +53,7 @@ main = execParser parser >>= addPath fullDesc <> progDesc "Add directories to your PATH" addPath :: Options -> IO () -addPath options = do - ret <- runExceptT $ doAddPath - either ioError return ret +addPath options = runExceptT doAddPath >>= either ioError return where varName = optName options pathsToAdd = optPaths options @@ -80,4 +78,4 @@ addPath options = do then withoutPrompt else withPrompt $ engraveMessage profile varName oldValue newValue let engrave = Env.engrave profile varName newValue - lift $ void $ promptAnd $ runExceptT engrave + void $ promptAnd engrave diff --git a/apps/ListPath.hs b/apps/ListPath.hs index 5aac18d..ebc9188 100644 --- a/apps/ListPath.hs +++ b/apps/ListPath.hs @@ -11,7 +11,8 @@ import Data.Maybe (fromMaybe) import System.Directory (doesDirectoryExist) import System.Environment (lookupEnv) -import Options.Applicative +import Options.Applicative + import qualified Windows.Environment as Env data WhichPaths = All | ExistingOnly | MissingOnly diff --git a/apps/Prompt.hs b/apps/Prompt.hs index d256f63..12a967f 100644 --- a/apps/Prompt.hs +++ b/apps/Prompt.hs @@ -10,6 +10,8 @@ module Prompt ) 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) @@ -34,13 +36,14 @@ promptYesNo msg = do promptToContinue :: IO Bool promptToContinue = promptYesNo "Continue? (y/n) " -withPrompt :: String -> IO a -> IO Bool +withPrompt :: String -> ExceptT IOError IO a -> ExceptT IOError IO Bool withPrompt msg m = do - putStr msg - hFlush stdout - agreed <- promptToContinue + lift $ do + putStr msg + hFlush stdout + agreed <- lift promptToContinue when agreed $ void m return agreed -withoutPrompt :: IO a -> IO Bool +withoutPrompt :: ExceptT IOError IO a -> ExceptT IOError IO Bool withoutPrompt m = m >> return True diff --git a/apps/RemovePath.hs b/apps/RemovePath.hs index 02bda10..7b8f1ac 100644 --- a/apps/RemovePath.hs +++ b/apps/RemovePath.hs @@ -7,12 +7,12 @@ module Main (main) where import Control.Monad (void, when) -import Control.Monad.Trans.Class -import Control.Monad.Trans.Except +import Control.Monad.Trans.Except (catchE, runExceptT, throwE) import Data.List ((\\)) import System.IO.Error (ioError, isDoesNotExistError) -import Options.Applicative +import Options.Applicative + import qualified Windows.Environment as Env import Prompt @@ -53,9 +53,7 @@ main = execParser parser >>= removePath fullDesc <> progDesc "Remove directories from your PATH" removePath :: Options -> IO () -removePath options = do - ret <- runExceptT $ doRemovePath - either ioError return ret +removePath options = runExceptT doRemovePath >>= either ioError return where varName = optName options pathsToRemove = optPaths options @@ -64,7 +62,7 @@ removePath options = do skipPrompt = optYes options - ignoreMissing e + emptyIfMissing e | isDoesNotExistError e = return "" | otherwise = throwE e @@ -74,10 +72,7 @@ removePath options = do removePathFrom Env.AllUsers removePathFrom profile = do - oldValue <- Env.query profile varName `catchE` ignoreMissing - doRemovePathFrom profile oldValue - - doRemovePathFrom profile oldValue = do + oldValue <- Env.query profile varName `catchE` emptyIfMissing let oldPaths = Env.pathSplit oldValue let newPaths = oldPaths \\ pathsToRemove when (length oldPaths /= length newPaths) $ do @@ -86,4 +81,4 @@ removePath options = do then withoutPrompt else withPrompt $ engraveMessage profile varName oldValue newValue let engrave = Env.engrave profile varName newValue - lift $ void $ promptAnd $ runExceptT engrave + void $ promptAnd engrave diff --git a/apps/SetEnv.hs b/apps/SetEnv.hs index 2f3b8f7..0c8df32 100644 --- a/apps/SetEnv.hs +++ b/apps/SetEnv.hs @@ -6,12 +6,12 @@ module Main (main) where -import Control.Monad (void) -import Control.Monad.Trans.Class -import Control.Monad.Trans.Except +import Control.Monad (void) +import Control.Monad.Trans.Except (runExceptT) import System.IO.Error (ioError) -import Options.Applicative +import Options.Applicative + import qualified Windows.Environment as Env import Prompt @@ -51,9 +51,7 @@ main = execParser parser >>= setEnv fullDesc <> progDesc "Set environment variables" setEnv :: Options -> IO () -setEnv options = do - ret <- runExceptT $ lift $ void $ promptAnd $ runExceptT engrave - either ioError return ret +setEnv options = runExceptT doSetEnv >>= either ioError return where varName = optName options varValue = optValue options @@ -69,3 +67,5 @@ setEnv options = do | otherwise = withPrompt $ engraveMessage profile varName "" varValue engrave = Env.engrave profile varName varValue + + doSetEnv = void $ promptAnd engrave diff --git a/apps/UnsetEnv.hs b/apps/UnsetEnv.hs index d56d40c..f0352b4 100644 --- a/apps/UnsetEnv.hs +++ b/apps/UnsetEnv.hs @@ -6,12 +6,12 @@ module Main (main) where -import Control.Monad (void) -import Control.Monad.Trans.Class -import Control.Monad.Trans.Except +import Control.Monad (void) +import Control.Monad.Trans.Except (runExceptT) import System.IO.Error (ioError) -import Options.Applicative +import Options.Applicative + import qualified Windows.Environment as Env import Prompt @@ -46,9 +46,7 @@ main = execParser parser >>= unsetEnv fullDesc <> progDesc "Unset environment variables" unsetEnv :: Options -> IO () -unsetEnv options = do - ret <- runExceptT $ lift $ void $ promptAnd $ runExceptT wipe - either ioError return ret +unsetEnv options = runExceptT doUnsetEnv >>= either ioError return where varName = optName options @@ -63,3 +61,5 @@ unsetEnv options = do | otherwise = withPrompt $ wipeMessage profile varName wipe = Env.wipe profile varName + + doUnsetEnv = void $ promptAnd wipe -- cgit v1.2.3