{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
{-# OPTIONS_GHC -w #-}
module Uniform.Error
( module Uniform.Error
, module Safe
, module Control.Monad
, module Control.Monad.Trans.Except
, liftIO, MonadIO
, SomeException
)
where
import Control.Exception (Exception, SomeException, bracket, catch, throw, SomeException)
import Control.Monad
import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Monad.Trans.Except
import Safe (headNote, readNote)
import Uniform.Strings hiding (S, (<.>), (</>))
instance CharChains2 IOError Text where
show' :: IOError -> Text
show' = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
type ErrOrVal = Either Text
type ErrIO = ExceptT Text IO
toErrOrVal :: Either String a -> ErrOrVal a
toErrOrVal :: forall a. Either String a -> ErrOrVal a
toErrOrVal (Left String
s) = forall a b. a -> Either a b
Left (String -> Text
s2t String
s)
toErrOrVal (Right a
r) = forall a b. b -> Either a b
Right a
r
runErr :: ErrIO a -> IO (ErrOrVal a)
runErr :: forall a. ErrIO a -> IO (ErrOrVal a)
runErr = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
runErrorVoid :: ErrIO () -> IO ()
runErrorVoid :: ErrIO () -> IO ()
runErrorVoid ErrIO ()
a = do
ErrOrVal ()
res <- forall a. ErrIO a -> IO (ErrOrVal a)
runErr ErrIO ()
a
case ErrOrVal ()
res of
Left Text
msg -> forall a. HasCallStack => String -> a
error (Text -> String
t2s Text
msg)
Right ()
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
undef :: Text -> a
undef :: forall a. Text -> a
undef = forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
t2s
fromRightEOV :: ErrOrVal a -> a
fromRightEOV :: forall a. ErrOrVal a -> a
fromRightEOV (Right a
a) = a
a
fromRightEOV (Left Text
msg) = forall a. [Text] -> a
errorT [Text
"fromrightEOV", Text
msg]
bracketErrIO ::
ErrIO a ->
(a -> ErrIO b) ->
(a -> ErrIO c) ->
ErrIO c
bracketErrIO :: forall a b c.
ErrIO a -> (a -> ErrIO b) -> (a -> ErrIO c) -> ErrIO c
bracketErrIO ErrIO a
before a -> ErrIO b
after a -> ErrIO c
thing =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ErrOrVal a -> a
fromRightEOV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
( do
ErrOrVal a
ra <- forall a. ErrIO a -> IO (ErrOrVal a)
runErr forall a b. (a -> b) -> a -> b
$ ErrIO a
before
forall (m :: * -> *) a. Monad m => a -> m a
return ErrOrVal a
ra
)
(\ErrOrVal a
a -> forall a. ErrIO a -> IO (ErrOrVal a)
runErr forall a b. (a -> b) -> a -> b
$ a -> ErrIO b
after forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ErrOrVal a -> a
fromRightEOV forall a b. (a -> b) -> a -> b
$ ErrOrVal a
a)
(\ErrOrVal a
a -> forall a. ErrIO a -> IO (ErrOrVal a)
runErr forall a b. (a -> b) -> a -> b
$ a -> ErrIO c
thing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ErrOrVal a -> a
fromRightEOV forall a b. (a -> b) -> a -> b
$ ErrOrVal a
a)
callIO ::
IO a -> ErrIO a
callIO :: forall a. IO a -> ErrIO a
callIO IO a
op = do
Either SomeException a
r2 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
do
a
r <- IO a
op
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right a
r
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` ( \SomeException
e -> do
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ (SomeException
e :: SomeException)
)
case Either SomeException a
r2 of
Left SomeException
e -> do
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (forall {a}. Show a => a -> Text
showT SomeException
e)
Right a
v -> forall (m :: * -> *) a. Monad m => a -> m a
return a
v
throwErrorWords :: [Text] -> ErrIO a
throwErrorWords :: forall a. [Text] -> ErrIO a
throwErrorWords = forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
unwordsT
throwErrorT :: Text -> ErrIO a
throwErrorT :: forall a. Text -> ErrIO a
throwErrorT = forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
catchError :: Monad m => ExceptT e m a
-> (e -> ExceptT e' m a) -> ExceptT e' m a
catchError :: forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
catchError = forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
catchE
maybe2error :: Maybe a -> ErrIO a
maybe2error :: forall a. Maybe a -> ErrIO a
maybe2error Maybe a
Nothing = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"was Nothing"
maybe2error (Just a
a) = forall (m :: * -> *) a. Monad m => a -> m a
return a
a
errorT :: [Text] -> a
errorT :: forall a. [Text] -> a
errorT = forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
t2s forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
unwordsT
errorWords :: [Text] -> a
errorWords :: forall a. [Text] -> a
errorWords = forall a. [Text] -> a
errorT
fromJustNoteT :: [Text] -> Maybe a -> a
fromJustNoteT :: forall a. [Text] -> Maybe a -> a
fromJustNoteT [Text]
msgs Maybe a
a = forall a. HasCallStack => String -> Maybe a -> a
fromJustNote (Text -> String
t2s forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
unlinesT forall a b. (a -> b) -> a -> b
$ [Text]
msgs) Maybe a
a
fromRightNoteString :: Text -> Either String b -> b
fromRightNoteString :: forall b. Text -> Either String b -> b
fromRightNoteString Text
msg (Left String
a) = forall a. [Text] -> a
errorT [Text
"fromRight", forall {a}. Show a => a -> Text
showT String
a, Text
msg]
fromRightNoteString Text
_ (Right b
a) = b
a
fromRightNote :: Text -> Either Text b -> b
fromRightNote :: forall b. Text -> Either Text b -> b
fromRightNote Text
msg (Left Text
a) = forall a. [Text] -> a
errorT [Text
"fromRight", forall {a}. Show a => a -> Text
showT Text
a, Text
msg]
fromRightNote Text
_ (Right b
a) = b
a
headNoteT :: [Text] -> [a] -> a
headNoteT :: forall a. [Text] -> [a] -> a
headNoteT [Text]
msg [a]
s = forall a. HasCallStack => String -> [a] -> a
headNote (Text -> String
t2s forall a b. (a -> b) -> a -> b
$ forall a. CharChains a => [a] -> a
unwords' [Text]
msg) [a]
s
startProg :: Show a => Text -> ErrIO a -> IO ()
startProg :: forall a. Show a => Text -> ErrIO a -> IO ()
startProg Text
programName ErrIO a
mainProg =
(do
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords
[ Text
"------------------ ",
Text
programName,
Text
" ----------------------------\n"
]
ErrOrVal a
r <- forall a. ErrIO a -> IO (ErrOrVal a)
runErr forall a b. (a -> b) -> a -> b
$ ErrIO a
mainProg
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords
[ Text
"\n------------------",
Text
"main",
Text
programName,
Text
"\nreturning",
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall {a}. Show a => a -> Text
showT ErrOrVal a
r,
Text
"\n"
]
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` ( \SomeException
e -> do
forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords
[ Text
"startProg error caught\n",
Text
programName, Text
"\n",
forall {a}. Show a => a -> Text
showT (SomeException
e :: SomeException)
]
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)