bugfix (withPrompt no longer swallows IOError)

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