Lucid Servant GET HTML page

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

module Main where

import Prelude ()
import Prelude.Compat

import Control.Monad.Except
import Control.Monad.Reader
import Data.Aeson
import Data.Aeson.Types
import Data.Attoparsec.ByteString
import Data.ByteString (ByteString)
import Data.List
import Data.Maybe
import Data.String.Conversions
import Data.Time.Calendar
import GHC.Generics
import Lucid
import Network.HTTP.Media ((//), (/:))
import Network.Wai
import Network.Wai.Handler.Warp
import Servant
import System.Directory
import Text.Blaze
import Text.Blaze.Html.Renderer.Utf8
import Servant.Types.SourceT (source)
import qualified Data.Aeson.Parser
import qualified Text.Blaze.Html

data User = User
  { name :: String
  , age :: Int
  , email :: String
  , registration_date :: Day
  } deriving (Eq, Show, Generic)
instance ToJSON User

loginPage :: Html ()
loginPage = html_ $ do
  head_ $ do
    title_ "Random Stuff"
    link_ [rel_ "stylesheet", type_ "text/css", href_ "screen.css"]
  body_ $ do
    h1_ "Welcome to our site!"
    h2_ $ span_ "New user?"

users :: [User]
users =
  [ User "Isaac Newton"    372 "isaac@newton.co.uk" (fromGregorian 1683  3 1)
  , User "Albert Einstein" 136 "ae@mc2.org"         (fromGregorian 1905 12 1)
  ]

data HTMLLucid
instance Accept HTMLLucid where
    contentType _ = "text" // "html" /: ("charset", "utf-8")
instance ToHtml a => MimeRender HTMLLucid a where
    mimeRender _ = renderBS . toHtml
-- let's also provide an instance for lucid's
-- 'Html' wrapper.
instance MimeRender HTMLLucid (Html a) where
    mimeRender _ = renderBS

type UserAPI = "users" :> Get '[JSON] [User]
         :<|> "login" :> Get '[HTMLLucid] (Html ())

server :: Server UserAPI
server = return users
    :<|> return loginPage

userAPI :: Proxy UserAPI
userAPI = Proxy

userHandler :: Application
userHandler = serve userAPI server

main :: IO ()
main = run 8081 userHandler

Hello. I have been trying to get a HTML page, but without any luck. Could you please correct the code so that by going to the /login URL the HTML page renders correctly.

Currently, it shows this error during compilation:

Main.hs:83:15: error:
    • Overlapping instances for MimeRender
                                  HTMLLucid (HtmlT Data.Functor.Identity.Identity ())
        arising from a use of ‘serve’
      Matching instances:
        two instances involving out-of-scope types
        (use -fprint-potential-instances to see them all)
    • In the expression: serve userAPI server
      In an equation for ‘userHandler’:
          userHandler = serve userAPI server
   |
83 | userHandler = serve userAPI server

The error is saying:

You have two instances defined of this thing, and I don’t know which one I should use.

Have you tried using the -fprint-potential-instances to see more info about those?

Or have you tried looking into why there are two instances and what you should do about it / how to tell GHC to use only one?

1 Like

Thank you for your answer.

I am compiling the code using $ cabal build, therefore I do not know how to apply the flag " -fprint-potential-instances". This flag does not exist for the $ cabal build command ($ cabal build | grep “potential” does not return anything).

If I keep only “/users”, it works. The error arises when adding the “/login” route.

I only see two instances of MimeRender for HTMLLucid

instance ToHtml a => MimeRender HTMLLucid a where
    mimeRender _ = renderBS . toHtml
-- let's also provide an instance for lucid's
-- 'Html' wrapper.
instance MimeRender HTMLLucid (Html a) where
    mimeRender _ = renderBS

Is it possible that Html a has a ToHtml a instance? Because then both instances would apply.

1 Like

Thank you, guys.

I have commented this section as per comment by @ntwilson , and after that it works.

-- instance ToHtml a => MimeRender HTMLLucid a where
--    mimeRender _ = renderBS . toHtml
2 Likes

You may be confusing what the first few code blocks in this section of the Servant tutorial docs are.

They’re meant to be showing what’s happening inside the libraries servant-lucid and servant-blaze. It’s only later (when talking about PersonAPI & Person) does the tutorial give you code examples that you would use as guides for your own work.

I’ll give you a minimum working example that uses the existing instances in the servant-lucid library.

I refer to the HTML type in the API type signature by its fully-qualified Servant.HTML.Lucid.HTML name so that its clear for you where it’s coming from. And likewise for refering to lucid's Html type in its qualified form of Lucid.Html also.

Note that I have not had to either 1) create my own Html type or write any instances for any these types as it is all provided by the imported libraries servant-lucid or servant-blaze :slight_smile:

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module ServantLucidExample where

import Data.Proxy ( Proxy(Proxy) )
import qualified Lucid
import qualified Network.Wai.Handler.Warp as Warp
import Servant ( Handler, serve, Server )
import Servant.API ( Get, JSON, type (:<|>)(..), type (:>) )
import qualified Servant.HTML.Lucid

type NumberAPI
  = Get '[JSON] Int

type LoginAPI
  = "login" :> Get '[Servant.HTML.Lucid.HTML] (Lucid.Html ())

type API = NumberAPI :<|> LoginAPI

numberHandler :: Server NumberAPI
numberHandler = pure 42

loginHandler :: Server LoginAPI
loginHandler = pure someHtml
  where
  someHtml :: Lucid.Html ()
  someHtml = 
    Lucid.div_ do
      Lucid.p_ "Hello"
      Lucid.p_ "World"

handler :: Server API
handler = numberHandler :<|> loginHandler

main :: IO ()
main = Warp.run 8080 (serve (Proxy @API) handler)

4 Likes