gdritter repos hanzo / 043e4e2
simple geometry Getty Ritter 5 years ago
7 changed file(s) with 152 addition(s) and 0 deletion(s). Collapse all Expand all
+20
-0
.gitignore less more
1 dist
2 dist-*
3 *~
4 cabal-dev
5 *.o
6 *.hi
7 *.chi
8 *.chs.h
9 *.dyn_o
10 *.dyn_hi
11 .hpc
12 .hsenv
13 .cabal-sandbox/
14 cabal.sandbox.config
15 *.prof
16 *.aux
17 *.hp
18 *.eventlog
19 cabal.project.local
20 .ghc.environment.*
+8
-0
examples/IOExitCode.hs less more
1 module Main where
2
3 import qualified Hanzo
4
5 main :: IO ()
6 main = Hanzo.main $ do
7 putStrLn "Hello, world!"
8 pure Hanzo.ExitSuccess
+7
-0
examples/IOUnit.hs less more
1 module Main where
2
3 import qualified Hanzo
4
5 main :: IO ()
6 main = Hanzo.main $ do
7 putStrLn "Hello, world!"
+11
-0
examples/WithArgs.hs less more
1 module Main where
2
3 import qualified Hanzo
4
5 main :: IO ()
6 main = Hanzo.main $ \ args -> do
7 case args of
8 [] -> pure (Left "No arguments provided!")
9 xs -> do
10 putStrLn ("Hello, " ++ unwords xs ++ "!")
11 pure (Right ())
+29
-0
examples/hanzo-examples.cabal less more
1 name: hanzo-examples
2 version: 0.1.0.0
3 -- synopsis:
4 -- description:
5 license: BSD3
6 author: Getty Ritter <hanzo@infinitenegativeutility.com
7 maintainer: Getty Ritter <hanzo@infinitenegativeutility.com>
8 copyright: @2019 Getty Ritter
9 -- category:
10 build-type: Simple
11 cabal-version: >=1.14
12
13 executable hanzo-io-unit
14 main-is: IOUnit.hs
15 ghc-options: -Wall
16 build-depends: base >=4.7 && <5, hanzo
17 default-language: Haskell2010
18
19 executable hanzo-io-exitcode
20 main-is: IOUnit.hs
21 ghc-options: -Wall
22 build-depends: base >=4.7 && <5, hanzo
23 default-language: Haskell2010
24
25 executable hanzo-withargs
26 main-is: WithArgs.hs
27 ghc-options: -Wall
28 build-depends: base >=4.7 && <5, hanzo
29 default-language: Haskell2010
+18
-0
hanzo.cabal less more
1 name: hanzo
2 version: 0.1.0.0
3 -- synopsis:
4 -- description:
5 license: BSD3
6 author: Getty Ritter <gettylefou@gmail.com>
7 maintainer: Getty Ritter <gettylefou@gmail.com>
8 copyright: @2019 Getty Ritter
9 -- category:
10 build-type: Simple
11 cabal-version: >=1.14
12
13 library
14 hs-source-dirs: src
15 ghc-options: -Wall
16 build-depends: base >=4.7 && <5
17 default-language: Haskell2010
18 exposed-modules: Hanzo
+59
-0
src/Hanzo.hs less more
1 {-# LANGUAGE FlexibleInstances #-}
2 {-# LANGUAGE ScopedTypeVariables #-}
3
4 module Hanzo
5 ( Mainable(..)
6 , Termination(..)
7 , Exit.ExitCode(..)
8 ) where
9
10 import qualified Control.Exception as Exn
11 import qualified System.Environment as Env
12 import qualified System.Exit as Exit
13 import qualified System.IO as IO
14
15 class Mainable k where
16 main :: k -> IO ()
17
18 instance Termination r => Mainable (IO r) where
19 main action = do
20 exn <- Exn.try action
21 case exn of
22 Left (e :: Exn.SomeException) -> do
23 IO.hPutStrLn IO.stderr (Exn.displayException e)
24 Right r -> do
25 code <- report r
26 Exit.exitWith code
27
28 instance Termination r => Mainable ([String] -> IO r) where
29 main action = do
30 args <- Env.getArgs
31 exn <- Exn.try (action args)
32 case exn of
33 Left (e :: Exn.SomeException) -> do
34 IO.hPutStrLn IO.stderr (Exn.displayException e)
35 Right r -> do
36 code <- report r
37 Exit.exitWith code
38
39
40 class Termination t where
41 report :: t -> IO Exit.ExitCode
42
43 instance Termination () where
44 report _ = pure Exit.ExitSuccess
45
46 instance Termination Exit.ExitCode where
47 report x = pure x
48
49 instance Show e => Termination (Either e ()) where
50 report (Left err) = do
51 IO.hPutStrLn IO.stderr (show err)
52 pure (Exit.ExitFailure 1)
53 report (Right ()) =
54 pure Exit.ExitSuccess
55
56 instance Termination (Maybe ()) where
57 report Nothing = pure (Exit.ExitFailure 1)
58 report (Just ()) =
59 pure Exit.ExitSuccess