|
@@ -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
|
|
|
|