Bootstrap.hs

{-# 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

-- | Create 'Bootstrap' out of single 'Endpoint' and some given Content-Type:
--
-- > bootstrap @TextPlain (pure "foo")
--
-- To enable Content-Type negotiation based on @Accept@ header, use 'Coproduct' ':+:' type operator to set the type:
--
-- > bootstrap @(TextPlain :+: TextHtml) (pure "foo") -- in case of failed negotiation, text/html is picked as the last resort
-- > bootstrap @(TextPlain :+: TextHtml :+: NotAcceptable406) (pure "foo") -- in case of failed negotiation, 406 is returned
--
bootstrap :: forall ct m a. Endpoint m a -> Bootstrap m (ct :+: CNil) (HList '[ (Endpoint m a)])
bootstrap ea = Bootstrap @m @(ct :+: CNil) (ea ::: HNil)

-- | Add another endpoint to 'Bootstrap' for purpose of serving multiple Content-Types with *different* endpoints
--
-- > bootstrap @TextPlain (pure "foo") & serve @ApplicationJson (pure "bar")
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 'Bootstrap' into @ReaderT Request m Response@ for further combinations.
-- Might be useful to implement middleware in context of the same monad @m@:
--
-- > bootstrap @TextPlain (pure "foo") & compile
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

-- | Convert @ReaderT Request m Response@ into WAI @Application@
--
-- > bootstrap @TextPlain (pure "foo") & compile & toApp @IO
--
-- The constraint here is a natural transformation of 'Endpoint's monad @m@ into @IO@.
-- In case if selected monad is @IO@ already then provided instance is just enough.
-- Otherwise, it's necessary define how to "start" custom monad for each request to come and convert it to @IO@ as the
-- instance of 'NaturalTransformation' @m IO@.
toApp ::
     forall m. (NaturalTransformation m IO)
  => ReaderT Request m Response
  -> Application
toApp !readerT request callback = mapK (runReaderT readerT request) >>= callback