{-# LANGUAGE OverloadedStrings #-}

{-|
    Use this module if you like to write simple scripts with 'Text'-based
    errors, but you prefer to use 'ExceptT' to handle errors rather than
    @Control.Exception@.

> import Control.Error
>
> main = runScript $ do
>     str <- scriptIO getLine
>     n   <- tryRead "Read failed" str
>     scriptIO $ print (n + 1)
-}

module Control.Error.Script (
    -- * The Script Monad
    Script,
    runScript,
    scriptIO
    ) where

import Control.Exception (try, SomeException)
import Control.Monad (liftM)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT)
import Control.Error.Util (errLn)
import Data.EitherR (fmapL)
import Data.Monoid ((<>))
import Data.Text (Text)
import System.Environment (getProgName)
import System.Exit (exitFailure)

-- Documentation
import Control.Monad.Trans.Class (lift)
import System.IO (stderr)

import qualified Data.Text

-- | An 'IO' action that can fail with a 'Text' error message
type Script = ExceptT Text IO

{-| Runs the 'Script' monad

    Prints the first error to 'stderr' and exits with 'exitFailure'
-}
runScript :: Script a -> IO a
runScript :: Script a -> IO a
runScript Script a
s = do
    Either Text a
e <- Script a -> IO (Either Text a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT Script a
s
    case Either Text a
e of
        Left  Text
e -> do
            let adapt :: String -> Text
adapt String
str = String -> Text
Data.Text.pack String
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
            Text -> IO ()
errLn (Text -> IO ()) -> IO Text -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String -> Text) -> IO String -> IO Text
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Text
adapt IO String
getProgName
            IO a
forall a. IO a
exitFailure
        Right a
a -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

{-| 'scriptIO' resembles 'lift', except it catches all exceptions and converts
    them to 'Text'

    Note that 'scriptIO' is compatible with the 'Script' monad.
-}
scriptIO :: (MonadIO m) => IO a -> ExceptT Text m a
scriptIO :: IO a -> ExceptT Text m a
scriptIO = m (Either Text a) -> ExceptT Text m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT
         (m (Either Text a) -> ExceptT Text m a)
-> (IO a -> m (Either Text a)) -> IO a -> ExceptT Text m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either Text a) -> m (Either Text a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
         (IO (Either Text a) -> m (Either Text a))
-> (IO a -> IO (Either Text a)) -> IO a -> m (Either Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either SomeException a -> Either Text a)
-> IO (Either SomeException a) -> IO (Either Text a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((SomeException -> Text) -> Either SomeException a -> Either Text a
forall a b r. (a -> b) -> Either a r -> Either b r
fmapL (String -> Text
Data.Text.pack (String -> Text)
-> (SomeException -> String) -> SomeException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show))
         (IO (Either SomeException a) -> IO (Either Text a))
-> (IO a -> IO (Either SomeException a))
-> IO a
-> IO (Either Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try :: IO a -> IO (Either SomeException a))