hanzo/src/Hanzo.hs

{-# 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