aboutsummaryrefslogtreecommitdiffstatshomepage
diff options
context:
space:
mode:
authorEgor Tensin <Egor.Tensin@gmail.com>2016-12-13 01:47:35 +0300
committerEgor Tensin <Egor.Tensin@gmail.com>2016-12-13 01:47:35 +0300
commitd7d33810d562a80e0954bafe045ae2275109999a (patch)
treeb07e041a8d6c840df460b5a6dd3e4fa1d56b29a8
parentuse monad transformers (diff)
downloadwindows-env-d7d33810d562a80e0954bafe045ae2275109999a.tar.gz
windows-env-d7d33810d562a80e0954bafe045ae2275109999a.zip
bugfix (withPrompt no longer swallows IOError)
Diffstat (limited to '')
-rw-r--r--apps/AddPath.hs12
-rw-r--r--apps/ListPath.hs3
-rw-r--r--apps/Prompt.hs13
-rw-r--r--apps/RemovePath.hs19
-rw-r--r--apps/SetEnv.hs14
-rw-r--r--apps/UnsetEnv.hs14
-rw-r--r--src/Windows/Environment.hs4
-rw-r--r--src/Windows/Registry.hs7
-rw-r--r--src/Windows/Utils.hs3
-rw-r--r--windows-env.cabal7
10 files changed, 48 insertions, 48 deletions
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
diff --git a/src/Windows/Environment.hs b/src/Windows/Environment.hs
index 0399d5b..859667e 100644
--- a/src/Windows/Environment.hs
+++ b/src/Windows/Environment.hs
@@ -22,8 +22,8 @@ module Windows.Environment
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (ExceptT(..))
-import Data.List (intercalate)
-import Data.List.Split (splitOn)
+import Data.List (intercalate)
+import Data.List.Split (splitOn)
import qualified Windows.Registry as Registry
import Windows.Utils (notifyEnvironmentUpdate)
diff --git a/src/Windows/Registry.hs b/src/Windows/Registry.hs
index 5203fb8..41275bf 100644
--- a/src/Windows/Registry.hs
+++ b/src/Windows/Registry.hs
@@ -35,21 +35,20 @@ module Windows.Registry
, setStringPreserveType
) where
+import Control.Exception (bracket)
+import Control.Monad.Trans.Except (ExceptT(..), catchE, throwE)
import Data.Bits ((.|.))
import qualified Data.ByteString as B
import Data.List (intercalate)
import Data.Maybe (fromJust)
-import Data.Tuple (swap)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf16LE, encodeUtf16LE)
-import Control.Exception (bracket)
-import Control.Monad.Trans.Except (ExceptT(..), catchE, throwE)
+import Data.Tuple (swap)
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Foreign.Marshal.Array (peekArray, pokeArray)
import Foreign.Storable (peek, poke)
import System.IO.Error (catchIOError, isDoesNotExistError)
-
import qualified System.Win32.Types as WinAPI
import qualified System.Win32.Registry as WinAPI
diff --git a/src/Windows/Utils.hs b/src/Windows/Utils.hs
index 66f2df5..6dfaa5c 100644
--- a/src/Windows/Utils.hs
+++ b/src/Windows/Utils.hs
@@ -8,8 +8,7 @@ module Windows.Utils
( notifyEnvironmentUpdate
) where
-import Foreign.C.Types (CIntPtr(..))
-
+import Foreign.C.Types (CIntPtr(..))
import qualified Graphics.Win32.GDI.Types as WinAPI
import qualified Graphics.Win32.Message as WinAPI
import qualified System.Win32.Types as WinAPI
diff --git a/windows-env.cabal b/windows-env.cabal
index 98f4e3d..6209a1d 100644
--- a/windows-env.cabal
+++ b/windows-env.cabal
@@ -18,7 +18,12 @@ library
exposed-modules: Windows.Environment
other-modules: Windows.Registry, Windows.Utils
ghc-options: -Wall -Werror
- build-depends: base, bytestring, split, text, transformers, Win32
+ build-depends: base
+ , bytestring
+ , split
+ , text
+ , transformers
+ , Win32
default-language: Haskell2010
executable addpath