----------------------------------------------------------------------
--
-- Module      :  Uniform.Error
--
----------------------------------------------------------------------

    {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
-- runErrorT is depreceiated but used in monads-tf
{-# OPTIONS_GHC -w #-}

module Uniform.Error
  ( module Uniform.Error
    -- module Uniform.Strings,
    , module Safe
    , module Control.Monad
    , module Control.Monad.Trans.Except
    , liftIO, MonadIO 
    , SomeException
    -- , module Control.Monad.IO.Class  
    
    -- module Control.Monad.Error, -- is monads-tf
    -- module Control.Excepcation, -- to avoid control.error
  )
where

import Control.Exception (Exception, SomeException, bracket, catch, throw, SomeException)
import Control.Monad  -- just to make it available everywhere
import Control.Monad.IO.Class (liftIO, MonadIO)
-- import "monads-tf" Control.Monad.Error (Error, ErrorT, ErrorType, MonadError, MonadIO, catchError, liftIO, runErrorT, throwError, unless, when)

-- ErrorT Text IO xxx becomes ErrIO xxx

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

-- instance Exception [Text]


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 to avoid the depreceated message for runErrorT, which is identical
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 ()
-- ^ run an operation in ErrIO which is not returning anything
-- simpler to use than runErr
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
-- ^ for type specification, not to be evaluated

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 ::
  -- | computation to run first (\"acquire resource\")
  ErrIO a ->
  -- | computation to run last (\"release resource\")
  (a -> ErrIO b) ->
  -- | computation to run in-between
  (a -> ErrIO c) ->
  ErrIO c -- returns the value from the in-between computation
  --bracketErrIO before after thing = bracket before after thing
  -- no way to catch IO errors reliably in ErrIO -- missing Monad Mask or similar
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 --  (ra :: ErrOrVal a) )
      )
      (\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)

-- instance Error Text

callIO ::  
    -- (MonadError m, MonadIO m, ErrorType m ~ Text) => 
    -- (MonadIO m) => 
            IO a -> ErrIO a
-- | this is using catch to grab all errors
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
                        -- putStrLn "callIO catch caught error\n"
                        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
      --                        putIOwords ["\ncallIO Left branch\n", showT e, "throwError\n"]
                        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
-- throw an error with a list of texts as a text
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
-- throw an error - for compatibility with old code
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
-- catch Error in the ExceptT monad (but not others??)
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
-- ^ a list of texts is output with failure
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
-- produce error with msg when Nothing, msg is list of texts
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
-- produce an error when assuming that a value is Right
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
-- produce an error when assuming that a value is Right
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
-- get head with a list of texts
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  -- here catch because in the IO monad 
                        -- (not ExceptT )
                     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 ()
                 )