{-# LANGUAGE CPP            #-}
{-# LANGUAGE ImplicitParams #-}
module Yam.Middleware(
    AppMiddleware(..)
  , simpleAppMiddleware
  , simpleWebMiddleware
  , runMiddleware
  ) where

import           Yam.Logger
import           Yam.Types

-- | Application Middleware
newtype AppMiddleware = AppMiddleware {runAM :: Env -> ((Env, Middleware)-> LoggingT IO ()) -> LoggingT IO ()}

instance Monoid AppMiddleware where
  mempty = AppMiddleware $ \a f -> f (a,id)
#if __GLASGOW_HASKELL__ >= 804
instance Semigroup AppMiddleware where
  (<>) = _append
#else
  mappend = _append
#endif


_append (AppMiddleware am) (AppMiddleware bm) = AppMiddleware $ \e f -> am e $ \(e', mw) -> bm e' $ \(e'',mw') -> f (e'', mw . mw')

-- | Simple AppMiddleware
simpleAppMiddleware :: HasCallStack => (Bool, Text) -> Key a -> a -> AppMiddleware
simpleAppMiddleware (enabled,amname) k v =
  v `seq` if enabled
    then AppMiddleware $ \e f -> do
      logInfoCS ?callStack $ amname <> " enabled"
      f (setAttr k v e, id)
    else mempty

simpleWebMiddleware :: HasCallStack => (Bool, Text) -> Middleware -> AppMiddleware
simpleWebMiddleware (enabled,amname) m =
  if enabled
    then AppMiddleware $ \e f -> do
      logInfoCS ?callStack $ amname <> " enabled"
      f (e,m)
    else mempty

runMiddleware :: MonadIO m => AppMiddleware -> App a -> m ()
runMiddleware (AppMiddleware f) a = liftIO $ withLogger "test" def $ do
  lf <- askLoggerIO
  f (putLogger lf def) $ \(e,_) -> liftIO $ void $ runApp e a