{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Hanzo
( Mainable(..)
, Termination(..)
, Exit.ExitCode(..)
) 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
r <- guardExceptions action
code <- report r
Exit.exitWith code
instance Termination r => Mainable (Except.ExceptT String IO r) where
main action = do
exn <- guardExceptions (Except.runExceptT action)
case exn of
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
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