Monad.hs

{-# LANGUAGE DerivingStrategies #-}

module Photoname.Monad
  ( Env (..)
  , Ph
  , runRename

  -- Re-exporting:
  , ask, asks
  , liftIO
  )
  where

import Colog.Simple (HasLog (..), LogAction, Message)
import Control.Monad.Reader (MonadReader, ReaderT, ask, asks, runReaderT)
import Control.Monad.Trans (MonadIO, liftIO)

import Photoname.Common (Options)


data Env m = Env
  { envOptions :: !Options
  , envLogAction :: !(LogAction m Message)
  }

instance HasLog (Env m) Message m where
  getLogAction :: Env m -> LogAction m Message
  getLogAction = envLogAction
  {-# INLINE getLogAction #-}

  setLogAction :: LogAction m Message -> Env m -> Env m
  setLogAction newLogAction env = env { envLogAction = newLogAction }
  {-# INLINE setLogAction #-}


newtype Ph a = Ph { unPh :: ReaderT (Env Ph) IO a }
  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader (Env Ph))

runRename :: Env Ph -> Ph a -> IO a
runRename env action = runReaderT (unPh action) env