Given the following servant server definition:
#!/usr/bin/env stack
{- stack
--resolver lts-19.10
script
--package base
--package http-api-data
--package lucid
--package servant-lucid
--package servant-server
--package time
--package warp
-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
import Data.Proxy
import Data.Time
import GHC.Generics
import Lucid.Base
import Lucid.Html5
import Network.Wai.Handler.Warp
import Servant
import Servant.HTML.Lucid
import Web.FormUrlEncoded
data FormData = FormData {formTime :: Maybe TimeOfDay} deriving (Generic, Show)
instance FromForm FormData
type API = "form" :> ReqBody '[FormUrlEncoded] FormData :> Post '[HTML] (Html ()) :<|> Get '[HTML] (Html ())
main :: IO ()
main = do
putStrLn $ "starting on port " <> show port
run port $ serve (Proxy @API) ((pure . toHtml . show) :<|> pure page)
where
port = 8080
page = do
doctype_
html_ [lang_ "en"] $ do
form_ [action_ "form", method_ "post"] $ do
label_ [for_ "formTime"] "time"
input_ [type_ "time", id_ "formTime", name_ "formTime"]
input_ [type_ "submit", value_ "Submit"]
(This can be run as is using stack)
the time field in the parameter is supposed to be optional, so if the user doesn't provide a value for it, it should end up as Nothing
in the FormData
value that's passed to the Handler.
However, in the browser the field will be included in the request but with an empty value.
I'm not sure if this is a bug in servant or if it's intended behavior, but this does sound a bit counter-intuitive to me
The only possible solution I can think of is to wrap the Maybe TimeOfDay
in a newtype that then implements the expected behavior in the FromHttpApiData
instance, like so:
newtype MaybeTimeOfDay = MaybeTimeOfDay (Maybe TimeOfDay) deriving (Show)
instance FromHttpApiData MaybeTimeOfDay where
parseQueryParam "" = Right (MaybeTimeOfDay Nothing)
parseQueryParam t = MaybeTimeOfDay <$> parseQueryParam t
data FormData = FormData {formTime :: MaybeTimeOfDay} deriving (Generic, Show)
Or, more generically
newtype OptionalParameter a = OptionalParameter (Maybe a) deriving (Show)
instance FromHttpApiData a => FromHttpApiData (OptionalParameter a) where
parseQueryParam "" = Right (OptionalParameter Nothing)
parseQueryParam t = OptionalParameter <$> parseQueryParam t
This works but it feels a bit awkward to implement that manually.