use monad transformers

4 files changed, 46 insertions, 26 deletions

diff --git a/apps/AddPath.hs b/apps/AddPath.hs
index a32244c..2f1870c 100644
--- a/apps/AddPath.hs
+++ b/apps/AddPath.hs
@@ -7,6 +7,8 @@
 module Main (main) where
 
 import Control.Monad   (void, when)
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except
 import Data.List       (union)
 import System.IO.Error (ioError, isDoesNotExistError)
 
@@ -52,16 +54,8 @@ main = execParser parser >>= addPath
 
 addPath :: Options -> IO ()
 addPath options = do
-    oldValue <- Env.query profile varName >>= emptyIfMissing
-    let oldPaths = Env.pathSplit oldValue
-    let newPaths = oldPaths `union` pathsToAdd
-    when (length oldPaths /= length newPaths) $ do
-        let newValue = Env.pathJoin newPaths
-        let promptAnd = if skipPrompt
-            then withoutPrompt
-            else withPrompt $ engraveMessage profile varName oldValue newValue
-        let engrave = Env.engrave profile varName newValue
-        void $ promptAnd engrave
+    ret <- runExceptT $ doAddPath
+    either ioError return ret
   where
     varName = optName options
     pathsToAdd = optPaths options
@@ -73,7 +67,17 @@ addPath options = do
 
     skipPrompt = optYes options
 
-    emptyIfMissing (Left e)
-        | isDoesNotExistError e = return ""
-        | otherwise = ioError e
-    emptyIfMissing (Right s) = return s
+    emptyIfMissing e | isDoesNotExistError e = return ""
+                     | otherwise = throwE e
+
+    doAddPath = do
+        oldValue <- Env.query profile varName `catchE` emptyIfMissing
+        let oldPaths = Env.pathSplit oldValue
+        let newPaths = oldPaths `union` pathsToAdd
+        when (length oldPaths /= length newPaths) $ do
+            let newValue = Env.pathJoin newPaths
+            let promptAnd = if skipPrompt
+                then withoutPrompt
+                else withPrompt $ engraveMessage profile varName oldValue newValue
+            let engrave = Env.engrave profile varName newValue
+            lift $ void $ promptAnd $ runExceptT engrave
diff --git a/apps/RemovePath.hs b/apps/RemovePath.hs
index eb1cb00..02bda10 100644
--- a/apps/RemovePath.hs
+++ b/apps/RemovePath.hs
@@ -7,6 +7,8 @@
 module Main (main) where
 
 import Control.Monad   (void, when)
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except
 import Data.List       ((\\))
 import System.IO.Error (ioError, isDoesNotExistError)
 
@@ -52,9 +54,8 @@ main = execParser parser >>= removePath
 
 removePath :: Options -> IO ()
 removePath options = do
-    removePathFrom Env.CurrentUser
-    when forAllUsers $
-        removePathFrom Env.AllUsers
+    ret <- runExceptT $ doRemovePath
+    either ioError return ret
   where
     varName = optName options
     pathsToRemove = optPaths options
@@ -63,13 +64,18 @@ removePath options = do
 
     skipPrompt = optYes options
 
-    removePathFrom profile = do
-        oldValue <- Env.query profile varName
-        either ignoreMissing (doRemovePathFrom profile) oldValue
-
     ignoreMissing e
-        | isDoesNotExistError e = return ()
-        | otherwise = ioError e
+        | isDoesNotExistError e = return ""
+        | otherwise = throwE e
+
+    doRemovePath = do
+        removePathFrom Env.CurrentUser
+        when forAllUsers $
+            removePathFrom Env.AllUsers
+
+    removePathFrom profile = do
+        oldValue <- Env.query profile varName `catchE` ignoreMissing
+        doRemovePathFrom profile oldValue
 
     doRemovePathFrom profile oldValue = do
         let oldPaths = Env.pathSplit oldValue
@@ -80,4 +86,4 @@ removePath options = do
                 then withoutPrompt
                 else withPrompt $ engraveMessage profile varName oldValue newValue
             let engrave = Env.engrave profile varName newValue
-            void $ promptAnd engrave
+            lift $ void $ promptAnd $ runExceptT engrave
diff --git a/apps/SetEnv.hs b/apps/SetEnv.hs
index 96ef7b1..2f3b8f7 100644
--- a/apps/SetEnv.hs
+++ b/apps/SetEnv.hs
@@ -7,6 +7,9 @@
 module Main (main) where
 
 import Control.Monad (void)
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except
+import System.IO.Error (ioError)
 
 import           Options.Applicative
 import qualified Windows.Environment as Env
@@ -48,7 +51,9 @@ main = execParser parser >>= setEnv
         fullDesc <> progDesc "Set environment variables"
 
 setEnv :: Options -> IO ()
-setEnv options = void $ promptAnd engrave
+setEnv options = do
+    ret <- runExceptT $ lift $ void $ promptAnd $ runExceptT engrave
+    either ioError return ret
   where
     varName = optName options
     varValue = optValue options
diff --git a/apps/UnsetEnv.hs b/apps/UnsetEnv.hs
index 2ca0997..d56d40c 100644
--- a/apps/UnsetEnv.hs
+++ b/apps/UnsetEnv.hs
@@ -7,6 +7,9 @@
 module Main (main) where
 
 import Control.Monad (void)
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except
+import System.IO.Error (ioError)
 
 import           Options.Applicative
 import qualified Windows.Environment as Env
@@ -43,7 +46,9 @@ main = execParser parser >>= unsetEnv
         fullDesc <> progDesc "Unset environment variables"
 
 unsetEnv :: Options -> IO ()
-unsetEnv options = void $ promptAnd wipe
+unsetEnv options = do
+    ret <- runExceptT $ lift $ void $ promptAnd $ runExceptT wipe
+    either ioError return ret
   where
     varName = optName options