simple geometry

.gitignore

@@ -0,0 +1,20 @@
+dist
+dist-*
+*~
+cabal-dev
+*.o
+*.hi
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.hpc
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+*.prof
+*.aux
+*.hp
+*.eventlog
+cabal.project.local
+.ghc.environment.*

examples/IOExitCode.hs

@@ -0,0 +1,8 @@
+module Main where
+
+import qualified Hanzo
+
+main :: IO ()
+main = Hanzo.main $ do
+  putStrLn "Hello, world!"
+  pure Hanzo.ExitSuccess

examples/IOUnit.hs

@@ -0,0 +1,7 @@
+module Main where
+
+import qualified Hanzo
+
+main :: IO ()
+main = Hanzo.main $ do
+  putStrLn "Hello, world!"

examples/WithArgs.hs

@@ -0,0 +1,11 @@
+module Main where
+
+import qualified Hanzo
+
+main :: IO ()
+main = Hanzo.main $ \ args -> do
+  case args of
+    [] -> pure (Left "No arguments provided!")
+    xs -> do
+      putStrLn ("Hello, " ++ unwords xs ++ "!")
+      pure (Right ())

examples/hanzo-examples.cabal

@@ -0,0 +1,29 @@
+name: hanzo-examples
+version: 0.1.0.0
+-- synopsis:
+-- description:
+license: BSD3
+author: Getty Ritter <hanzo@infinitenegativeutility.com
+maintainer: Getty Ritter <hanzo@infinitenegativeutility.com>
+copyright: @2019 Getty Ritter
+-- category:
+build-type: Simple
+cabal-version: >=1.14
+
+executable hanzo-io-unit
+  main-is: IOUnit.hs
+  ghc-options: -Wall
+  build-depends: base >=4.7 && <5, hanzo
+  default-language: Haskell2010
+
+executable hanzo-io-exitcode
+  main-is: IOUnit.hs
+  ghc-options: -Wall
+  build-depends: base >=4.7 && <5, hanzo
+  default-language: Haskell2010
+
+executable hanzo-withargs
+  main-is: WithArgs.hs
+  ghc-options: -Wall
+  build-depends: base >=4.7 && <5, hanzo
+  default-language: Haskell2010

hanzo.cabal

@@ -0,0 +1,18 @@
+name: hanzo
+version: 0.1.0.0
+-- synopsis:
+-- description:
+license: BSD3
+author: Getty Ritter <gettylefou@gmail.com>
+maintainer: Getty Ritter <gettylefou@gmail.com>
+copyright: @2019 Getty Ritter
+-- category:
+build-type: Simple
+cabal-version: >=1.14
+
+library
+  hs-source-dirs: src
+  ghc-options: -Wall
+  build-depends: base >=4.7 && <5
+  default-language: Haskell2010
+  exposed-modules: Hanzo

src/Hanzo.hs

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