{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FunctionalDependencies #-}
module Factis.Haskoon.WebReaderT (WebReaderT, runWebReaderT) where

----------------------------------------
-- STDLIB
----------------------------------------
import Control.Monad (liftM)
import Control.Monad.Trans (MonadTrans, MonadIO, lift)
import Control.Monad.Reader (MonadReader, ReaderT, runReaderT, local, ask)

----------------------------------------
-- LOCAL
----------------------------------------
import Factis.Haskoon.Web (Web(..))
import Factis.Haskoon.WebTrans (WebTrans(..), liftWebRec)

newtype WebReaderT r m a = WebReaderT (ReaderT r m a)
    deriving (Monad, MonadTrans, MonadIO)

instance Monad m => MonadReader r (WebReaderT r m) where
    ask = WebReaderT ask
    local f (WebReaderT cont) = WebReaderT (local f cont)

instance WebTrans (WebReaderT r) where
    liftWeb web = WebReaderT (lift web)
    liftWebFun f cont = WebReaderT $ ask >>= lift . f . runWebReaderT cont

instance Web m => Web (WebReaderT r m) where
    type WebRes (WebReaderT r m) = WebRes m
    webRec = liftWebRec (liftM id) webRec

runWebReaderT :: Monad m => WebReaderT r m a -> r -> m a
runWebReaderT (WebReaderT readerT) = runReaderT readerT