{-# LANGUAGE NoImplicitPrelude #-}
module RIO.Prelude.Simple
( SimpleApp
, mkSimpleApp
, runSimpleApp
) where
import RIO.Prelude.Reexports
import RIO.Prelude.Logger
import RIO.Prelude.Lens
import RIO.Prelude.RIO
import RIO.Process
import System.Environment (lookupEnv)
data SimpleApp = SimpleApp
{ SimpleApp -> LogFunc
saLogFunc :: !LogFunc
, SimpleApp -> ProcessContext
saProcessContext :: !ProcessContext
}
instance HasLogFunc SimpleApp where
logFuncL :: (LogFunc -> f LogFunc) -> SimpleApp -> f SimpleApp
logFuncL = (SimpleApp -> LogFunc)
-> (SimpleApp -> LogFunc -> SimpleApp) -> Lens' SimpleApp LogFunc
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SimpleApp -> LogFunc
saLogFunc (\SimpleApp
x LogFunc
y -> SimpleApp
x { saLogFunc :: LogFunc
saLogFunc = LogFunc
y })
instance HasProcessContext SimpleApp where
processContextL :: (ProcessContext -> f ProcessContext) -> SimpleApp -> f SimpleApp
processContextL = (SimpleApp -> ProcessContext)
-> (SimpleApp -> ProcessContext -> SimpleApp)
-> Lens' SimpleApp ProcessContext
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SimpleApp -> ProcessContext
saProcessContext (\SimpleApp
x ProcessContext
y -> SimpleApp
x { saProcessContext :: ProcessContext
saProcessContext = ProcessContext
y })
mkSimpleApp :: MonadIO m => LogFunc -> Maybe ProcessContext -> m SimpleApp
mkSimpleApp :: LogFunc -> Maybe ProcessContext -> m SimpleApp
mkSimpleApp LogFunc
logFunc Maybe ProcessContext
mProcessContext = do
ProcessContext
processContext <- m ProcessContext
-> (ProcessContext -> m ProcessContext)
-> Maybe ProcessContext
-> m ProcessContext
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m ProcessContext
forall (m :: * -> *). MonadIO m => m ProcessContext
mkDefaultProcessContext ProcessContext -> m ProcessContext
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ProcessContext
mProcessContext
SimpleApp -> m SimpleApp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleApp -> m SimpleApp) -> SimpleApp -> m SimpleApp
forall a b. (a -> b) -> a -> b
$ SimpleApp :: LogFunc -> ProcessContext -> SimpleApp
SimpleApp {saLogFunc :: LogFunc
saLogFunc = LogFunc
logFunc, saProcessContext :: ProcessContext
saProcessContext = ProcessContext
processContext}
runSimpleApp :: MonadIO m => RIO SimpleApp a -> m a
runSimpleApp :: RIO SimpleApp a -> m a
runSimpleApp RIO SimpleApp a
m = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ do
Bool
verbose <- Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"RIO_VERBOSE"
LogOptions
lo <- Handle -> Bool -> IO LogOptions
forall (m :: * -> *). MonadIO m => Handle -> Bool -> m LogOptions
logOptionsHandle Handle
stderr Bool
verbose
LogOptions -> (LogFunc -> IO a) -> IO a
forall (m :: * -> *) a.
MonadUnliftIO m =>
LogOptions -> (LogFunc -> m a) -> m a
withLogFunc LogOptions
lo ((LogFunc -> IO a) -> IO a) -> (LogFunc -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \LogFunc
lf -> do
SimpleApp
simpleApp <- LogFunc -> Maybe ProcessContext -> IO SimpleApp
forall (m :: * -> *).
MonadIO m =>
LogFunc -> Maybe ProcessContext -> m SimpleApp
mkSimpleApp LogFunc
lf Maybe ProcessContext
forall a. Maybe a
Nothing
SimpleApp -> RIO SimpleApp a -> IO a
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO SimpleApp
simpleApp RIO SimpleApp a
m