| 8 | 8 |
) where
|
| 9 | 9 |
|
| 10 | 10 |
import qualified Control.Exception as Exn
|
| 11 |
import qualified Control.Monad.Trans.Except as Except
|
| 11 | 12 |
import qualified System.Environment as Env
|
| 12 | 13 |
import qualified System.Exit as Exit
|
| 13 | 14 |
import qualified System.IO as IO
|
| 14 | 15 |
|
| 16 |
-- | The 'Mainable' class represents computations which can be
|
| 17 |
-- encapsulated as the 'main' function of a program.
|
| 15 | 18 |
class Mainable k where
|
| 16 | 19 |
main :: k -> IO ()
|
| 17 | 20 |
|
| 21 |
guardExceptions :: IO a -> IO a
|
| 22 |
guardExceptions action = do
|
| 23 |
result <- Exn.try action
|
| 24 |
case result of
|
| 25 |
Left (e :: Exn.SomeException) -> do
|
| 26 |
IO.hPutStrLn IO.stderr (Exn.displayException e)
|
| 27 |
Exit.exitWith (Exit.ExitFailure 1)
|
| 28 |
Right x -> pure x
|
| 29 |
|
| 18 | 30 |
instance Termination r => Mainable (IO r) where
|
| 19 | 31 |
main action = do
|
| 20 | |
exn <- Exn.try action
|
| 32 |
r <- guardExceptions action
|
| 33 |
code <- report r
|
| 34 |
Exit.exitWith code
|
| 35 |
|
| 36 |
instance Termination r => Mainable (Except.ExceptT String IO r) where
|
| 37 |
main action = do
|
| 38 |
exn <- guardExceptions (Except.runExceptT action)
|
| 21 | 39 |
case exn of
|
| 22 | |
Left (e :: Exn.SomeException) -> do
|
| 23 | |
IO.hPutStrLn IO.stderr (Exn.displayException e)
|
| 40 |
Left err -> do
|
| 41 |
IO.hPutStrLn IO.stderr err
|
| 42 |
Exit.exitWith (Exit.ExitFailure 1)
|
| 24 | 43 |
Right r -> do
|
| 25 | 44 |
code <- report r
|
| 26 | 45 |
Exit.exitWith code
|
| 27 | 46 |
|
| 28 | |
instance Termination r => Mainable ([String] -> IO r) where
|
| 47 |
instance Mainable k => Mainable ([String] -> k) where
|
| 29 | 48 |
main action = do
|
| 30 | 49 |
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
|
| 50 |
let rest = action args
|
| 51 |
main rest
|
| 38 | 52 |
|
| 39 | |
|
| 53 |
-- | The 'Termination' class represents values which can be returned
|
| 54 |
-- from a 'Main' function which might represent success or failure.
|
| 40 | 55 |
class Termination t where
|
| 41 | 56 |
report :: t -> IO Exit.ExitCode
|
| 42 | 57 |
|
| 43 | 58 |
instance Termination () where
|
| 44 | 59 |
report _ = pure Exit.ExitSuccess
|
| 60 |
|
| 61 |
instance Termination Bool where
|
| 62 |
report True = pure Exit.ExitSuccess
|
| 63 |
report False = pure (Exit.ExitFailure 1)
|
| 45 | 64 |
|
| 46 | 65 |
instance Termination Exit.ExitCode where
|
| 47 | 66 |
report x = pure x
|