|
@@ -0,0 +1,59 @@
|
|
|
+{-# LANGUAGE FlexibleInstances #-}
|
|
|
+{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
+
|
|
|
+module Hanzo
|
|
|
+ ( Mainable(..)
|
|
|
+ , Termination(..)
|
|
|
+ , Exit.ExitCode(..)
|
|
|
+ ) where
|
|
|
+
|
|
|
+import qualified Control.Exception as Exn
|
|
|
+import qualified System.Environment as Env
|
|
|
+import qualified System.Exit as Exit
|
|
|
+import qualified System.IO as IO
|
|
|
+
|
|
|
+class Mainable k where
|
|
|
+ main :: k -> IO ()
|
|
|
+
|
|
|
+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
|
|
|
+
|
|
|
+instance Termination r => Mainable ([String] -> IO r) where
|
|
|
+ main action = do
|
|
|
+ args <- Env.getArgs
|
|
|
+ exn <- Exn.try (action args)
|
|
|
+ case exn of
|
|
|
+ Left (e :: Exn.SomeException) -> do
|
|
|
+ IO.hPutStrLn IO.stderr (Exn.displayException e)
|
|
|
+ Right r -> do
|
|
|
+ code <- report r
|
|
|
+ Exit.exitWith code
|
|
|
+
|
|
|
+
|
|
|
+class Termination t where
|
|
|
+ report :: t -> IO Exit.ExitCode
|
|
|
+
|
|
|
+instance Termination () where
|
|
|
+ report _ = pure Exit.ExitSuccess
|
|
|
+
|
|
|
+instance Termination Exit.ExitCode where
|
|
|
+ report x = pure x
|
|
|
+
|
|
|
+instance Show e => Termination (Either e ()) where
|
|
|
+ report (Left err) = do
|
|
|
+ IO.hPutStrLn IO.stderr (show err)
|
|
|
+ pure (Exit.ExitFailure 1)
|
|
|
+ report (Right ()) =
|
|
|
+ pure Exit.ExitSuccess
|
|
|
+
|
|
|
+instance Termination (Maybe ()) where
|
|
|
+ report Nothing = pure (Exit.ExitFailure 1)
|
|
|
+ report (Just ()) =
|
|
|
+ pure Exit.ExitSuccess
|