Servant HTML Combinator

HTML.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies      #-}

import           Data.ByteString.Lazy       ()
import           Text.Blaze.Html            (Html)
import           Text.Blaze.Renderer.Utf8   (renderMarkup)

import           Control.Monad.Trans.Either (EitherT, runEitherT)
import           Data.Proxy                 (Proxy (Proxy))
import           Servant.Server.Internal    (HasServer (..), RouteMismatch (WrongMethod, NotFound),
                                             failWith, succeedWith)

import           Network.HTTP.Types         (methodGet, methodGet, mkStatus,
                                             ok200)
import           Network.Wai                (pathInfo, requestMethod,
                                             responseLBS)

import           Data.String.Conversions    (cs)

-- | Example usage 
-- `type MyApi = "render" :> HTML`

data HTML

instance HasServer HTML where
  type Server HTML =  EitherT (Int, String) IO Html
  route Proxy action request respond
    | null (pathInfo request) && requestMethod request == methodGet = do
      e <- runEitherT action
      respond . succeedWith $ case e of
        Right output ->
          responseLBS ok200 [("Content-Type", "text/html")] (renderMarkup output)
        Left (status, message) ->
          responseLBS (mkStatus status (cs message)) [] (cs message)
    | null (pathInfo request) && requestMethod request /= methodGet =
        respond $ failWith WrongMethod
    | otherwise = respond $ failWith NotFound