----------------------------------------------------------------------
--
-- 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' = s2t . show

type ErrOrVal = Either Text

type ErrIO = ExceptT Text IO

-- instance Exception [Text]


toErrOrVal :: Either String a -> ErrOrVal a
toErrOrVal (Left s) = Left (s2t s)
toErrOrVal (Right r) = Right r

-- | runErr to avoid the depreceated message for runErrorT, which is identical
runErr :: ErrIO a -> IO (ErrOrVal a)
runErr = runExceptT

runErrorVoid :: ErrIO () -> IO ()
-- ^ run an operation in ErrIO which is not returning anything
-- simpler to use than runErr
runErrorVoid a = do
  res <- runErr a
  case res of
    Left msg -> error (t2s msg)
    Right _ -> return ()

undef :: Text -> a
undef = error . t2s
-- ^ for type specification, not to be evaluated

fromRightEOV :: ErrOrVal a -> a
fromRightEOV (Right a) = a
fromRightEOV (Left msg) = errorT ["fromrightEOV", 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 before after thing =
  fmap fromRightEOV . callIO $
    bracket
      ( do
          ra <- runErr $ before
          return ra --  (ra :: ErrOrVal a) )
      )
      (\a -> runErr $ after . fromRightEOV $ a)
      (\a -> runErr $ thing . fromRightEOV $ 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 op = do
    r2 <- liftIO $
            do
                r <- op
                return $ Right r
            `catch` ( \e -> do
                        -- putStrLn "callIO catch caught error\n"
                        return . Left $  (e :: SomeException)
                    )
    case r2 of
        Left e -> do
      --                        putIOwords ["\ncallIO Left branch\n", showT e, "throwError\n"]
                        throwE (showT e)
        Right v -> return v


throwErrorWords :: [Text] -> ErrIO a
-- throw an error with a list of texts as a text
throwErrorWords = throwE . unwordsT


throwErrorT :: Text -> ErrIO a
-- throw an error - for compatibility with old code
throwErrorT = 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 = catchE 

maybe2error :: Maybe a -> ErrIO a
maybe2error Nothing = fail "was Nothing"
maybe2error (Just a) = return a

errorT :: [Text] -> a
-- ^ a list of texts is output with failure
errorT = error . t2s . unwordsT

errorWords :: [Text] -> a
errorWords = errorT

fromJustNoteT :: [Text] -> Maybe a -> a
-- produce error with msg when Nothing, msg is list of texts
fromJustNoteT msgs a = fromJustNote (t2s . unlinesT $ msgs) a

fromRightNoteString :: Text -> Either String b -> b
-- produce an error when assuming that a value is Right
fromRightNoteString msg (Left a) = errorT ["fromRight", showT a, msg]
fromRightNoteString _ (Right a) = a

fromRightNote :: Text -> Either Text b -> b
-- produce an error when assuming that a value is Right
fromRightNote msg (Left a) = errorT ["fromRight", showT a, msg]
fromRightNote _ (Right a) = a

headNoteT :: [Text] -> [a] -> a
-- get head with a list of texts
headNoteT msg s = headNote (t2s $ unwords' msg) s

startProg :: Show a => Text -> ErrIO a -> IO ()
startProg programName mainProg =
      (do
        putIOwords
            [ "------------------ ",
                programName,
                " ----------------------------\n"
            ]
        r <-  runErr $ mainProg
        putIOwords
            [ "\n------------------",
                "main",
                programName,
                "\nreturning",
                either id showT r,
                "\n"
            ]
        return ()
        )
    `catch` ( \e -> do  -- here catch because in the IO monad 
                        -- (not ExceptT )
                     putIOwords
                       [ "startProg error caught\n",
                         programName, "\n",
                         showT (e :: SomeException)
                       ]
                     return ()
                 )