Haskell servant: FormUrlEncoded request body with optional field-CodePudding

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

CodePudding user response：

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.