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
 name: hanzo
 version: 0.1.0.0
 version: 0.1.0.0
+synopsis: Simple convenient wrappers for logic around @main@
 -- description:
 -- description:
 license: BSD3
 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
 copyright: @2019 Getty Ritter
 -- category:
 -- category:
 build-type: Simple
 build-type: Simple
@@ -14,5 +14,6 @@ library
   hs-source-dirs: src
   hs-source-dirs: src
   ghc-options: -Wall
   ghc-options: -Wall
   build-depends: base >=4.7 && <5
   build-depends: base >=4.7 && <5
+               , transformers
   default-language: Haskell2010
   default-language: Haskell2010
   exposed-modules: Hanzo
   exposed-modules: Hanzo

+ 31 - 12
src/Hanzo.hs

@@ -8,41 +8,60 @@ module Hanzo
   ) where
   ) where
 
 
 import qualified Control.Exception as Exn
 import qualified Control.Exception as Exn
+import qualified Control.Monad.Trans.Except as Except
 import qualified System.Environment as Env
 import qualified System.Environment as Env
 import qualified System.Exit as Exit
 import qualified System.Exit as Exit
 import qualified System.IO as IO
 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
 class Mainable k where
   main :: k -> IO ()
   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
 instance Termination r => Mainable (IO r) where
   main action = do
   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
   main action = do
-    args <- Env.getArgs
-    exn <- Exn.try (action args)
+    exn <- guardExceptions (Except.runExceptT action)
     case exn of
     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
       Right r -> do
         code <- report r
         code <- report r
         Exit.exitWith code
         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
 class Termination t where
   report :: t -> IO Exit.ExitCode
   report :: t -> IO Exit.ExitCode
 
 
 instance Termination () where
 instance Termination () where
   report _ = pure Exit.ExitSuccess
   report _ = pure Exit.ExitSuccess
 
 
+instance Termination Bool where
+  report True = pure Exit.ExitSuccess
+  report False = pure (Exit.ExitFailure 1)
+
 instance Termination Exit.ExitCode where
 instance Termination Exit.ExitCode where
   report x = pure x
   report x = pure x