{-# LANGUAGE
    OverloadedStrings
  #-}

module Network.Wai.Middleware.ContentType.Lucid where

import           Network.Wai.Middleware.ContentType.Types (FileExtListenerT, tell', FileExt (Html), ResponseVia (..))
import           Network.HTTP.Types                      (status200, Status, ResponseHeaders)
import           Network.Wai                             (Response, responseBuilder)

import qualified Lucid.Base                              as L
import           Control.Monad.Trans (MonadTrans (lift))
import qualified Data.HashMap.Lazy                       as HM


-- * Lifted Combinators

lucid :: Monad m =>
         L.HtmlT m ()
      -> FileExtListenerT urlbase m ()
lucid :: forall (m :: * -> *) urlbase.
Monad m =>
HtmlT m () -> FileExtListenerT urlbase m ()
lucid HtmlT m ()
i = do
  Status -> ResponseHeaders -> Response
f <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
Monad m =>
HtmlT m () -> m (Status -> ResponseHeaders -> Response)
lucidOnly HtmlT m ()
i)
  forall w (m :: * -> *). (Monoid w, MonadState w m) => w -> m ()
tell' forall a b. (a -> b) -> a -> b
$ forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton FileExt
Html forall a b. (a -> b) -> a -> b
$
    forall a.
a
-> Status
-> ResponseHeaders
-> (a -> Status -> ResponseHeaders -> Response)
-> ResponseVia
ResponseVia
      HtmlT m ()
i
      Status
status200
      [(HeaderName
"Content-Type",ByteString
"text/html")]
      (forall a b. a -> b -> a
const Status -> ResponseHeaders -> Response
f)

{-# INLINEABLE lucid #-}


-- * Data Only

lucidOnly :: Monad m => L.HtmlT m () -> m (Status -> ResponseHeaders -> Response)
lucidOnly :: forall (m :: * -> *).
Monad m =>
HtmlT m () -> m (Status -> ResponseHeaders -> Response)
lucidOnly HtmlT m ()
i =
  (\Builder
b Status
s ResponseHeaders
hs -> Status -> ResponseHeaders -> Builder -> Response
responseBuilder Status
s ResponseHeaders
hs Builder
b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Monad m => HtmlT m a -> m Builder
L.execHtmlT HtmlT m ()
i

{-# INLINEABLE lucidOnly #-}