module Magicbane.App (
module X
, module Magicbane.App
) where
import ClassyPrelude hiding (Handler)
import Control.Monad.Trans.Except as X
import Control.Monad.Except as X (MonadError, throwError)
import Data.Proxy as X
import Data.Has as X
import Servant as X hiding (And)
newtype MagicbaneApp β α = MagicbaneApp {
unMagicbaneApp ∷ ReaderT β Handler α
} deriving (Functor, Applicative, Monad, MonadIO, MonadBase IO,
MonadThrow, MonadCatch, MonadError ServantErr, MonadReader β)
instance MonadBaseControl IO (MagicbaneApp β) where
type StM (MagicbaneApp β) α = StM (ReaderT β Handler) α
liftBaseWith f = MagicbaneApp $ liftBaseWith $ \x → f $ x . unMagicbaneApp
restoreM = MagicbaneApp . restoreM
runMagicbaneHandler ∷ β → MagicbaneApp β α → Handler α
runMagicbaneHandler ctx a = Handler $ ExceptT $ liftIO $ runHandler $ runReaderT (unMagicbaneApp a) ctx
#if MIN_VERSION_servant_server(0,12,0)
#else
magicbaneToHandler ∷ β → MagicbaneApp β :~> Handler
#if MIN_VERSION_servant_server(0,10,0)
magicbaneToHandler ctx = NT $ runMagicbaneHandler ctx
#else
magicbaneToHandler ctx = Nat $ runMagicbaneHandler ctx
#endif
#endif
magicbaneApp api sctx ctx actions = serveWithContext api sctx $ srv ctx
#if MIN_VERSION_servant_server(0,12,0)
where srv c = hoistServer api (runMagicbaneHandler c) actions
#else
where srv c = enter (magicbaneToHandler c) actions
#endif
askObj ∷ (Has β α, MonadReader α μ) ⇒ μ β
askObj = asks getter
askOpt ∷ (Has β α, MonadReader α μ) ⇒ (β → ψ) → μ ψ
askOpt f = asks $ f . getter