hanzo/src/Hanzo.hs

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