{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Linnet.Bootstrap
( bootstrap
, serve
, compile
, toApp
) where
import Control.Monad.Reader (ReaderT (..))
import qualified Linnet.Compile as Compile
import Linnet.Endpoint
import Linnet.Internal.Coproduct ((:+:), CNil)
import Linnet.Internal.HList (HList (..))
import Linnet.NaturalTransformation
import Network.Wai (Application, Request, Response)
newtype Bootstrap (m :: * -> *) cts es =
Bootstrap es
bootstrap :: forall ct m a. Endpoint m a -> Bootstrap m (ct :+: CNil) (HList '[ (Endpoint m a)])
bootstrap ea = Bootstrap @m @(ct :+: CNil) (ea ::: HNil)
serve ::
forall ct cts es m a.
Endpoint m a
-> Bootstrap m cts (HList es)
-> Bootstrap m (ct :+: cts) (HList (Endpoint m a ': es))
serve ea (Bootstrap e) = Bootstrap @m @(ct :+: cts) (ea ::: e)
compile ::
forall cts m es. (Compile.Compile cts m es)
=> Bootstrap m cts es
-> ReaderT Request m Response
compile (Bootstrap e) = Compile.compile @cts @m e
toApp ::
forall m. (NaturalTransformation m IO)
=> ReaderT Request m Response
-> Application
toApp !readerT request callback = mapK (runReaderT readerT request) >>= callback