Browse Source

add transformers instances

Getty Ritter 5 years ago
parent
commit
6494ec8fca
2 changed files with 35 additions and 14 deletions
  1. 4 2
      hanzo.cabal
  2. 31 12
      src/Hanzo.hs

+ 4 - 2
hanzo.cabal

@@ -1,10 +1,10 @@
 name: hanzo
 version: 0.1.0.0
+synopsis: Simple convenient wrappers for logic around @main@
 -- description:
 license: BSD3
-author: Getty Ritter <gettylefou@gmail.com>
-maintainer: Getty Ritter <gettylefou@gmail.com>
+author: Getty Ritter <hanzo@infinitenegativeutility.com
+maintainer: Getty Ritter <hanzo@infinitenegativeutility.com>
 copyright: @2019 Getty Ritter
 -- category:
 build-type: Simple
@@ -14,5 +14,6 @@ library
   hs-source-dirs: src
   ghc-options: -Wall
   build-depends: base >=4.7 && <5
+               , transformers
   default-language: Haskell2010
   exposed-modules: Hanzo

+ 31 - 12
src/Hanzo.hs

@@ -8,41 +8,60 @@ module Hanzo
   ) where
 
 import qualified Control.Exception as Exn
+import qualified Control.Monad.Trans.Except as Except
 import qualified System.Environment as Env
 import qualified System.Exit as Exit
 import qualified System.IO as IO
 
+-- | The 'Mainable' class represents computations which can be
+-- encapsulated as the 'main' function of a program.
 class Mainable k where
   main :: k -> IO ()
 
+guardExceptions :: IO a -> IO a
+guardExceptions action = do
+  result <- Exn.try action
+  case result of
+    Left (e :: Exn.SomeException) -> do
+      IO.hPutStrLn IO.stderr (Exn.displayException e)
+      Exit.exitWith (Exit.ExitFailure 1)
+    Right x -> pure x
+
 instance Termination r => Mainable (IO r) where
   main action = do
-    exn <- Exn.try action
-    case exn of
-      Left (e :: Exn.SomeException) -> do
-        IO.hPutStrLn IO.stderr (Exn.displayException e)
-      Right r -> do
-        code <- report r
-        Exit.exitWith code
+    r <- guardExceptions action
+    code <- report r
+    Exit.exitWith code
 
-instance Termination r => Mainable ([String] -> IO r) where
+instance Termination r => Mainable (Except.ExceptT String IO r) where
   main action = do
-    args <- Env.getArgs
-    exn <- Exn.try (action args)
+    exn <- guardExceptions (Except.runExceptT action)
     case exn of
-      Left (e :: Exn.SomeException) -> do
-        IO.hPutStrLn IO.stderr (Exn.displayException e)
+      Left err -> do
+        IO.hPutStrLn IO.stderr err
+        Exit.exitWith (Exit.ExitFailure 1)
       Right r -> do
         code <- report r
         Exit.exitWith code
 
+instance Mainable k => Mainable ([String] -> k) where
+  main action = do
+    args <- Env.getArgs
+    let rest = action args
+    main rest
 
+-- | The 'Termination' class represents values which can be returned
+-- from a 'Main' function which might represent success or failure.
 class Termination t where
   report :: t -> IO Exit.ExitCode
 
 instance Termination () where
   report _ = pure Exit.ExitSuccess
 
+instance Termination Bool where
+  report True = pure Exit.ExitSuccess
+  report False = pure (Exit.ExitFailure 1)
+
 instance Termination Exit.ExitCode where
   report x = pure x