Haskell servant: FormUrlEncoded request body with optional field - haskell

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.

Related

In aeson-schemas how do you construct an Object of a SchemaType without encoding to text and decoding back?

I'm using aeson-schemas-1.0.3 and I want to construct values of Object Example without round-tripping through an external serialized representation. It seems like a hack and I'm worried about the performance impact.
I have this schema defined:
type Example = [schema|
{
example: Text,
}
|]
I want to be able to write something like this:
coerceJson $ object [ "example" .= ("Example" :: Text) ]
I have a workaround which does allow that, but it involves encoding to a ByteString and decoding to the Object of the desired SchemaType, which seems expensive and inelegant:
coerceJson :: FromJSON a => Value -> a
coerceJson = fromJust . decode . encode
This seems terribly inefficient.
Here's an SSCCE (Short, Self Contained, Correct (Compilable), Example) with my hack workaround employed. It works, but I'm convinced there's a better solution.
#!/usr/bin/env stack
{- stack
runghc
--resolver lts-14.15
--package aeson-schemas-1.0.3
--package aeson
--package text
-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}
import Data.Aeson (decode, encode, object, (.=), FromJSON, Value)
import Data.Aeson.Schema
import Data.Aeson.Text (encodeToLazyText)
import Data.Maybe (fromJust)
import qualified Data.Text.IO as T
import Data.Text(Text)
import Data.Text.Lazy (toStrict)
main :: IO ()
main = do
let example = coerceJson $ object [ "example" .= ("Example" :: Text) ]
useExample example
useExample :: Object Example -> IO ()
useExample example = T.putStrLn $ toStrict $ encodeToLazyText $ object [
"example" .= [get| example.example|]
]
coerceJson :: FromJSON a => Value -> a
coerceJson = fromJust . decode . encode
type Example = [schema|
{
example: Text,
}
|]
In aeson-schemas how do you construct an Object of a SchemaType without encoding to text and decoding back?
I'm the author of aeson-schemas. There is currently no way to make a literal Object. The issue with what you're trying to do is, how do you know that the literal Object matches the schema? It's possible I could make an unsafeObject quasiquoter that would assume the object matches the schema you type it as.
I know this is old, but if you're still having problems with this, what exactly is your use-case? Often times, you'll be loading JSON data from an external source, like an API or a file.

Navigating Haskell Servant API with Lucid WebUI

I've learnt that I can define my API with servant and Lucid in the following way:
type ClientAPI =
"users" :> Get '[HTML] (Html ())
:<|> "userdata" :> Get '[HTML] (Html ())
Then if I want to add a link to one of the endpoints in my HTML, I can use "a_" function provided by Lucid, e.g.
a_ [href_ "users"] "Show users"
The problem I have with this approach is that I need to repeat the endpoint's name twice. "users" occurs both in API definition and a_ tag. As a result if I change it in one place, the other one stops working immediately.
Is there a way to define a single symbol that could be used in both places instead ? Something like:
data MySites = UserSite | UserDataSite -- potentially more
type ClientAPI' =
UserSite :> Get '[HTML] (Html ())
-- ......
let html =
...
a_ [href_ UserSite] "Show users"
...
If you just want to abstract over the string "user", you can do this with a type alias, and then use GHC.TypeLits.symbolVal to get the string at the value level:
{-# LANGUAGE DataKinds #-}
import Data.Proxy
import GHC.TypeLits
type UserSite = "user"
html = ... href_ (symbolVal (Proxy :: Proxy UserSite)) ...
You can also make the symbolVal call a bit shorter by defining a helper with AllowAmbiguousTypes:
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
urlpath :: forall s . KnownSymbol s => String
urlpath = symbolVal (Proxy :: Proxy s)
html = ... href_ (urlpath #UserSite) ...
(I actually thought something like it was in the standard library somewhere but I can't find it.)

By what mechanism does Generic interact with Aeson's ToJSON class?

Looking at part of the servant example, I see:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
module Main where
import Prelude ()
import Prelude.Compat
import Control.Monad.Except
import Control.Monad.Reader
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 qualified Data.Aeson.Parser
import qualified Text.Blaze.Html
type UserAPI1 = "users" :> Get '[JSON] [User]
data User = User
{ name :: String
, age :: Int
, email :: String
, registration_date :: Day
} deriving (Eq, Show, Generic)
instance ToJSON User
When I removed the deriving of Generic, I got the following error:
• No instance for (Generic User)
arising from a use of ‘aeson-1.1.2.0:Data.Aeson.Types.ToJSON.$dmtoJSON’
So, it appears that the Generic typeclass instance for User enables instance ToJSON User to, I'm assuming, create a JSON Encoder for User.
What's the machinery of instance ToJSON User, i.e. type signature, if that's the right word?
I'm trying to look at its type from the stack ghci, i.e. REPL, but failing:
λ: >:t instance
<interactive>:1:1: error: parse error on input ‘instance’
λ: >:i instance
<interactive>:1:1: error: parse error on input ‘instance’
Let's look at the source for ToJSON:
class ToJSON a where
-- | Convert a Haskell value to a JSON-friendly intermediate type.
toJSON :: a -> Value
default toJSON :: (Generic a, GToJSON Zero (Rep a)) => a -> Value
toJSON = genericToJSON defaultOptions
The ToJSON class has a default toJSON implementation with additional type constraints (including Generic, as you've noticed). This requires the DefaultSignatures extension; notice at the top of that module you can see
{-# LANGUAGE DefaultSignatures #-}
The other constraint, GToJSON Zero (Rep a), imposes some further restrictions on the structure of a, and so not every type with a Generic instance will satisfy this signature.
Regarding your question about GHCi: instance is a Haskell keyword. Inspecting toJSON may be what you want instead. This will show you the same information we saw in the source:
λ> :i toJSON
class ToJSON a where
toJSON :: a -> Value
default toJSON :: (GHC.Generics.Generic a,
GToJSON Zero (GHC.Generics.Rep a)) =>
a -> Value
...
-- Defined in ‘aeson-1.1.2.0:Data.Aeson.Types.ToJSON’

Is jsonToRepJson broken?

I'm just starting doing some Yesod + Haskell stuff.
Is jsonToRepJson broken or something?
I made this code below but I always get an error in jsonToRepJson part.
It seems it doesn't get the expected type?
Any help would be great! Thanks :3
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
import Yesod
import Data.Text
data APP = APP
instance Yesod APP
mkYesod "APP" [parseRoutes|
/ TestR GET
|]
getTestR :: Handler RepJson
getTestR = jsonToRepJson $ object ["test".= ("test"::Text)]
main::IO()
main = warpDebug 3001 APP
this is what I get when I use runhaskell
api.hs:18:12:
Couldn't match expected type `RepJson' with actual type `Value'
Expected type: Handler RepJson
Actual type: HandlerT APP IO Value
In the expression:
jsonToRepJson $ object ["test" .= ("test" :: Text)]
In an equation for `getTestR':
getTestR = jsonToRepJson $ object ["test" .= ("test" :: Text)]
You must convert your value toJSON.
Eg.:
jsonToRepJson $ object [("result", toJSON resultValue)]
:)
You can read about that change in Yesod 1.2
What I did is, I used the TypeContent handler.
If I understood correctly what I've read, repSelect allows us to easily handle what type of data representation the client asks for.
It reads the request header and checks if it asks for JSON, then it will spit out JSON data, if it needs HTML it will then give the HTML page. Providing that you yourself had added the specific data needed using providRep.
Here's my code.
mkYesod "APP" [parseRoutes|
/ TestR GET
|]
getTestR::Handler TypedContent
getTestR = do
selectRep $ do
provideRep $ jsonToRepJson $ object $ (["test" .= ("test"::Text)])
main::IO()
main = warpDebug 3001 APP

CouchDB.Conduit: mapping views to data

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric, ScopedTypeVariables #-}
import Data.Generics (Data, Typeable)
import Data.Conduit
import qualified Data.Conduit.List as CL
import Database.CouchDB.Conduit.Generic
import Database.CouchDB.Conduit
import Database.CouchDB.Conduit.View
import Data.ByteString.Char8 (ByteString, empty)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson
import Data.Aeson.Types
import GHC.Generics
data Page = Page { id_ :: ByteString, url :: ByteString }
deriving (Show, Data, Typeable, Generic)
instance FromJSON Page
getPages :: IO ()
getPages = runCouch (def { couchHost = "192.168.0.103" }) $ do
couchView_ "reader" "reader" "pages" [] $ CL.mapM_ (liftIO . print)
This works and gives me this:
*Main> getPages
fromList [("key",String "802e343945c7f8da2d8a71fdb80025a7"),("id",String "802e343945c7f8da2d8a71fdb80025a7"),("value",String "http://yandex.ru")]`
But I actually want a function getPages :: IO [Page], so I tried this:
getPages = runCouch (def { couchHost = "192.168.0.103" }) $ do
couchView_ "reader" "reader" "pages" [] $ toType =$ CL.consume`
which gives me type error:
`Reader/Couch.hs:24:47:
Couldn't match expected type `Object' with actual type `Value'
Expected type: Conduit Object m1 b0
Actual type: Conduit Value m0 a0
In the first argument of `(=$)', namely `toType'
In the second argument of `($)', namely `toType =$ CL.consume'
Failed, modules loaded: none.
This is not surprising because couchView needs Sink Object m a as a parameter.
The question is: how to implement getPages :: IO [Page]?
I'm not familiar with conduit, aeson, or couchDB, but this at least type-checks:
getPages :: IO [Result Page]
getPages = runCouch (def { couchHost = "192.168.0.103" }) $ do
couchView_ "reader" "reader" "pages" [] $ CL.map (fromJSON . Object) =$ CL.consume

Resources