{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

module Blog
    ( runBlogT
    ) where

import           Control.Monad.Base          (MonadBase (..))
import           Control.Monad.IO.Unlift     (MonadUnliftIO(..), wrappedWithRunInIO)
import           Control.Monad.Logger        (MonadLoggerIO, MonadLogger, NoLoggingT (..))
import           Control.Monad.Reader
import           Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..),
                                              MonadTransControl (..),
                                              defaultLiftBaseWith,
                                              defaultRestoreM)
import           Database.Persist.Postgresql (ConnectionString)

newtype BlogT m a = BlogT { unBlogT :: NoLoggingT (ReaderT ConnectionString m) a }
  deriving ( Functor
           , Applicative
           , Monad
           , MonadLogger
           , MonadReader ConnectionString
           , MonadIO
           , MonadLoggerIO
           )

instance MonadUnliftIO m => MonadUnliftIO (BlogT m) where
  withRunInIO = wrappedWithRunInIO BlogT unBlogT

instance MonadTrans BlogT where
  lift = BlogT . lift . lift


deriving instance (MonadBase b m) => MonadBase b (BlogT m)


instance MonadBaseControl b m => MonadBaseControl b (BlogT m) where
  type StM (BlogT m) a = ComposeSt BlogT m a
  liftBaseWith     = defaultLiftBaseWith
  restoreM         = defaultRestoreM


instance MonadTransControl BlogT where
  type StT BlogT a = StT NoLoggingT (StT (ReaderT ConnectionString) a)
  liftWith f = BlogT $ liftWith $ \run ->
                                    liftWith $ \run' ->
                                                f (run' . run . unBlogT)
  restoreT = BlogT . restoreT . restoreT


runBlogT :: ConnectionString -> BlogT m a -> m a
runBlogT backend (BlogT m) =
  runReaderT (runNoLoggingT m) backend