{-# LANGUAGE OverloadedStrings #-}

module PMS.UI.Notification.DS.Utility where

import System.Log.FastLogger
import qualified Control.Exception.Safe as E
import Control.Monad.IO.Class
import Control.Monad.Except
import Control.Monad.Reader

import qualified PMS.Domain.Model.DM.Type as DM
import qualified PMS.Domain.Model.DS.Utility as DM
import PMS.UI.Notification.DM.Type

-- |
--
runApp :: DM.DomainData -> AppData -> TimedFastLogger -> AppContext a -> IO (Either DM.ErrorData a)
runApp :: forall a.
DomainData
-> AppData
-> TimedFastLogger
-> AppContext a
-> IO (Either ErrorData a)
runApp DomainData
domDat AppData
appDat TimedFastLogger
logger AppContext a
ctx =
  DomainData
-> TimedFastLogger
-> LoggingT IO (Either ErrorData a)
-> IO (Either ErrorData a)
forall a. DomainData -> TimedFastLogger -> LoggingT IO a -> IO a
DM.runFastLoggerT DomainData
domDat TimedFastLogger
logger
    (LoggingT IO (Either ErrorData a) -> IO (Either ErrorData a))
-> LoggingT IO (Either ErrorData a) -> IO (Either ErrorData a)
forall a b. (a -> b) -> a -> b
$ ExceptT ErrorData (LoggingT IO) a
-> LoggingT IO (Either ErrorData a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
    (ExceptT ErrorData (LoggingT IO) a
 -> LoggingT IO (Either ErrorData a))
-> ExceptT ErrorData (LoggingT IO) a
-> LoggingT IO (Either ErrorData a)
forall a b. (a -> b) -> a -> b
$ (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)) a
 -> DomainData -> ExceptT ErrorData (LoggingT IO) a)
-> DomainData
-> ReaderT DomainData (ExceptT ErrorData (LoggingT IO)) a
-> ExceptT ErrorData (LoggingT IO) a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT DomainData (ExceptT ErrorData (LoggingT IO)) a
-> DomainData -> ExceptT ErrorData (LoggingT IO) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT DomainData
domDat
    (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)) a
 -> ExceptT ErrorData (LoggingT IO) a)
-> ReaderT DomainData (ExceptT ErrorData (LoggingT IO)) a
-> ExceptT ErrorData (LoggingT IO) a
forall a b. (a -> b) -> a -> b
$ AppContext a
-> AppData
-> ReaderT DomainData (ExceptT ErrorData (LoggingT IO)) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT AppContext a
ctx AppData
appDat


-- |
--
liftIOE :: IO a -> AppContext a
liftIOE :: forall a. IO a -> AppContext a
liftIOE IO a
f = IO (Either ErrorData a)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
     (Either ErrorData a)
forall a. IO a -> AppContext a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO (Either ErrorData a)
forall b. IO b -> IO (Either ErrorData b)
go IO a
f) ReaderT
  AppData
  (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
  (Either ErrorData a)
-> (Either ErrorData a
    -> ReaderT
         AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a)
-> ReaderT
     AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall a b.
ReaderT
  AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
-> (a
    -> ReaderT
         AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) b)
-> ReaderT
     AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either ErrorData a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
  where
    go :: IO b -> IO (Either String b)
    go :: forall b. IO b -> IO (Either ErrorData b)
go IO b
x = IO (Either ErrorData b)
-> (SomeException -> IO (Either ErrorData b))
-> IO (Either ErrorData b)
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny (b -> Either ErrorData b
forall a b. b -> Either a b
Right (b -> Either ErrorData b) -> IO b -> IO (Either ErrorData b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO b
x) SomeException -> IO (Either ErrorData b)
forall a. SomeException -> IO (Either ErrorData a)
errHdl

    errHdl :: E.SomeException -> IO (Either String a)
    errHdl :: forall a. SomeException -> IO (Either ErrorData a)
errHdl = Either ErrorData a -> IO (Either ErrorData a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ErrorData a -> IO (Either ErrorData a))
-> (SomeException -> Either ErrorData a)
-> SomeException
-> IO (Either ErrorData a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorData -> Either ErrorData a
forall a b. a -> Either a b
Left (ErrorData -> Either ErrorData a)
-> (SomeException -> ErrorData)
-> SomeException
-> Either ErrorData a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> ErrorData
forall a. Show a => a -> ErrorData
show