-- |
-- Module: Staversion.Internal.EIO
-- Description: 
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __This is an internal module. End-users should not use it.__
module Staversion.Internal.EIO
       ( EIO,
         runEIO,
         toEIO,
         toEIOShow,
         loggedElse,
         maybeToEIO,
         eitherToEIO
       ) where

import Control.Monad.Trans.Except (runExceptT, ExceptT(..))
import qualified Data.Bifunctor as Bi

import Staversion.Internal.Log (Logger, logWarn)
import Staversion.Internal.Query (ErrorMsg)

type EIO = ExceptT ErrorMsg IO

runEIO :: EIO a -> IO (Either ErrorMsg a)
runEIO :: forall a. EIO a -> IO (Either ErrorMsg a)
runEIO = ExceptT ErrorMsg IO a -> IO (Either ErrorMsg a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT

toEIO :: IO (Either ErrorMsg a) -> EIO a
toEIO :: forall a. IO (Either ErrorMsg a) -> EIO a
toEIO = IO (Either ErrorMsg a) -> ExceptT ErrorMsg IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT

toEIOShow :: Show e => IO (Either e a) -> EIO a
toEIOShow :: forall e a. Show e => IO (Either e a) -> EIO a
toEIOShow = IO (Either ErrorMsg a) -> EIO a
forall a. IO (Either ErrorMsg a) -> EIO a
toEIO (IO (Either ErrorMsg a) -> EIO a)
-> (IO (Either e a) -> IO (Either ErrorMsg a))
-> IO (Either e a)
-> EIO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either e a -> Either ErrorMsg a)
-> IO (Either e a) -> IO (Either ErrorMsg a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> ErrorMsg) -> Either e a -> Either ErrorMsg a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bi.first e -> ErrorMsg
forall a. Show a => a -> ErrorMsg
show)

loggedElse :: Logger
           -> EIO a -- ^ first action tried.
           -> EIO a -- ^ the action executed if the first action returns 'Left'.
           -> EIO a
loggedElse :: forall a. Logger -> EIO a -> EIO a -> EIO a
loggedElse Logger
logger EIO a
first EIO a
second = IO (Either ErrorMsg a) -> EIO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ErrorMsg a) -> EIO a)
-> IO (Either ErrorMsg a) -> EIO a
forall a b. (a -> b) -> a -> b
$ do
  Either ErrorMsg a
eret <- EIO a -> IO (Either ErrorMsg a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT EIO a
first
  case Either ErrorMsg a
eret of
   Right a
_ -> Either ErrorMsg a -> IO (Either ErrorMsg a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Either ErrorMsg a
eret
   Left ErrorMsg
e -> Logger -> ErrorMsg -> IO ()
logWarn Logger
logger ErrorMsg
e IO () -> IO (Either ErrorMsg a) -> IO (Either ErrorMsg a)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EIO a -> IO (Either ErrorMsg a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT EIO a
second

maybeToEIO :: ErrorMsg -> Maybe a -> EIO a
maybeToEIO :: forall a. ErrorMsg -> Maybe a -> EIO a
maybeToEIO ErrorMsg
msg = IO (Either ErrorMsg a) -> ExceptT ErrorMsg IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ErrorMsg a) -> ExceptT ErrorMsg IO a)
-> (Maybe a -> IO (Either ErrorMsg a))
-> Maybe a
-> ExceptT ErrorMsg IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ErrorMsg a -> IO (Either ErrorMsg a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ErrorMsg a -> IO (Either ErrorMsg a))
-> (Maybe a -> Either ErrorMsg a)
-> Maybe a
-> IO (Either ErrorMsg a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ErrorMsg a
-> (a -> Either ErrorMsg a) -> Maybe a -> Either ErrorMsg a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ErrorMsg -> Either ErrorMsg a
forall a b. a -> Either a b
Left ErrorMsg
msg) a -> Either ErrorMsg a
forall a b. b -> Either a b
Right

eitherToEIO :: Either ErrorMsg a -> EIO a
eitherToEIO :: forall a. Either ErrorMsg a -> EIO a
eitherToEIO = IO (Either ErrorMsg a) -> ExceptT ErrorMsg IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ErrorMsg a) -> ExceptT ErrorMsg IO a)
-> (Either ErrorMsg a -> IO (Either ErrorMsg a))
-> Either ErrorMsg a
-> ExceptT ErrorMsg IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ErrorMsg a -> IO (Either ErrorMsg a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return