reflex-gadt-api
===============
[](https://haskell.org) [](https://hackage.haskell.org/package/reflex-gadt-api) [](https://github.com/reflex-frp/reflex-gadt-api/actions) [](https://github.com/reflex-frp/reflex-gadt-api/blob/master/LICENSE)
This package is designed to be used in full-stack Haskell applications where the API is defined as a GADT, the wire format is JSON, and the frontend is using reflex-dom(-core). reflex-gadt-api provides the basic FRP and encoding/decoding infrastructure to support this architecture.
To serialize the GADT API definition, we use [aeson-gadt-th](https://github.com/obsidiansystems/aeson-gadt-th) with a little help from [constraints-extras](https://github.com/obsidiansystems/constraints-extras).
Example Usage:
Let's start with some imports and language pragmas.
```haskell
> {-# LANGUAGE ConstraintKinds #-}
> {-# LANGUAGE DeriveGeneric #-}
> {-# LANGUAGE FlexibleContexts #-}
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE GADTs #-}
> {-# LANGUAGE LambdaCase #-}
> {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE OverloadedStrings #-}
> {-# LANGUAGE QuantifiedConstraints #-}
> {-# LANGUAGE RecursiveDo #-}
> {-# LANGUAGE ScopedTypeVariables #-}
> {-# LANGUAGE TemplateHaskell #-}
> {-# LANGUAGE TypeFamilies #-}
> {-# LANGUAGE UndecidableInstances #-}
> module Readme where
> import Control.Monad (void)
> import Control.Monad.IO.Class (MonadIO)
> import Control.Monad.Fix (MonadFix)
> import Data.Aeson (ToJSON(..), FromJSON(..))
> import Data.Aeson.GADT.TH (deriveJSONGADT)
> import Data.Constraint.Extras (Has)
> import Data.Constraint.Extras.TH (deriveArgDict)
> import Data.Kind (Type)
> import Data.Text as T (Text, null, pack)
> import Data.Time (UTCTime, Day)
> import GHC.Generics (Generic)
> import Reflex.Dom.Core
> import Reflex.Dom.GadtApi
```
The code that follows would typically go in a common module, since it would be used on the frontend and on the backend. It sets up the basic data type definitions and a couple of GADTs that describe the API.
```haskell
> data Dog = Dog
> { Dog -> Text
_dog_name :: Text
> , Dog -> UTCTime
_dog_sighted :: UTCTime
> , Dog -> Bool
_dog_suspicious :: Bool
> , Dog -> Maybe Text
_dog_imageUri :: Maybe Text
> }
> deriving ((forall x. Dog -> Rep Dog x)
-> (forall x. Rep Dog x -> Dog) -> Generic Dog
forall x. Rep Dog x -> Dog
forall x. Dog -> Rep Dog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Dog -> Rep Dog x
from :: forall x. Dog -> Rep Dog x
$cto :: forall x. Rep Dog x -> Dog
to :: forall x. Rep Dog x -> Dog
Generic)
> instance ToJSON Dog
> instance FromJSON Dog
```
Here we have an API for retrieving and interacting with the `Dog` data:
```haskell
> data DogApi :: Type -> Type where
> DogApi_GetByDay :: Day -> DogApi [Dog]
> DogApi_GetByName :: Text -> DogApi [Dog]
> DogApi_GetLastSeen :: DogApi (Maybe Dog)
> DogApi_ReportSighting :: Text -> Bool -> Maybe Text -> DogApi (Either Text ())
> DogApi_GetSuspiciousSightings :: DogApi [Dog]
> newtype Token = Token { Token -> Text
unToken :: Text }
> deriving ((forall x. Token -> Rep Token x)
-> (forall x. Rep Token x -> Token) -> Generic Token
forall x. Rep Token x -> Token
forall x. Token -> Rep Token x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Token -> Rep Token x
from :: forall x. Token -> Rep Token x
$cto :: forall x. Rep Token x -> Token
to :: forall x. Rep Token x -> Token
Generic)
> instance ToJSON Token
> instance FromJSON Token
```
We can take the `DogApi` and embed it in another GADT API. This outer API will handle authentication. (Note that we're not actually implementing a secure authentication scheme or anything here. This is just a toy example.)
```haskell
> data CatApi a where
> CatApi_Identify :: Text -> CatApi (Either Text Token)
> CatApi_DogApi :: Token -> DogApi a -> CatApi a
> deriveJSONGADT ''DogApi
> deriveJSONGADT ''CatApi
> deriveArgDict ''DogApi
> deriveArgDict ''CatApi
```
On the frontend, we'll run a `RequesterT` widget that allows us to emit an event of requests, and we'll transform those requests into XHR calls to the API endpoint.
```haskell
> type Catnet t m = (RequesterT t CatApi (Either Text) m)
```
This synonym is just here for convenience. The right-hand-side describes a `RequesterT` widget that issues `CatApi` requests and receives responses. In other words, when we're inside this `RequesterT` we can call the `requesting` function to send API requests and receive responses.
The `Either` here represents the possibility that we'll receive an error instead of the response we expected.
Now, we'll actually start up the `RequesterT`:
```haskell
> startCatnet
> :: forall t m.
> ( Prerender t m, MonadHold t m
> , MonadIO (Performable m), MonadFix m
> , DomBuilder t m, PostBuild t m
> , TriggerEvent t m, PerformEvent t m
> , Has FromJSON CatApi
> , forall a. ToJSON (CatApi a)
> )
> => Either ApiEndpoint WebSocketEndpoint
> -> m ()
> startCatnet :: forall t (m :: * -> *).
(Prerender t m, MonadHold t m, MonadIO (Performable m), MonadFix m,
DomBuilder t m, PostBuild t m, TriggerEvent t m, PerformEvent t m,
Has FromJSON CatApi, forall a. ToJSON (CatApi a)) =>
Either Text Text -> m ()
startCatnet Either Text Text
endpoint = do
```
`runRequesterT` expects us to provide some reflex widget as its first argument (here `start`). The reflex widget is able to issue API requests, and one of the results of `runRequesterT` is an `Event` of those requests.
The second argument to `runRequesterT` is an `Event` of responses. Because we need to get this `Event` of requests and feed it into a function that can produce the responses, and then feed those responses back into `runRequesterT`, we have to use `RecursiveDo`. If we didn't we wouldn't have access to the responses inside of the reflex widget that issued the requests. This is the main loop of a `RequesterT` widget.
```haskell
> rec (_, requests) <- runRequesterT start responses
```
The `Event` of responses comes, in this case, from a function that will take the requests emitted on the previous line and fetch responses to those requests. It produces an `Event` of responses. We can use either `Reflex.Dom.GadtApi.XHR.performXhrRequests` if we want to send requests using XHR or `Reflex.Dom.GadtApi.WebSocket.performWebSocketRequests` to use WebSockets.
```haskell
> responses <- case endpoint of
> Left Text
xhr -> Text
-> Event t (RequesterData CatApi)
-> m (Event t (RequesterData (Either Text)))
forall t (m :: * -> *) (api :: * -> *).
(Has FromJSON api, forall a. ToJSON (api a), Prerender t m,
Applicative m) =>
Text
-> Event t (RequesterData api)
-> m (Event t (RequesterData (Either Text)))
performXhrRequests Text
xhr (Event t (RequesterData CatApi)
requests :: Event t (RequesterData CatApi))
> Right Text
ws -> Text
-> Event t (RequesterData CatApi)
-> m (Event t (RequesterData (Either Text)))
forall (req :: * -> *) t (m :: * -> *).
(Prerender t m, Applicative m, FromJSON (Some req),
forall a. ToJSON (req a), Has FromJSON req) =>
Text
-> Event t (RequesterData req)
-> m (Event t (RequesterData (Either Text)))
performWebSocketRequests Text
ws (Event t (RequesterData CatApi)
requests :: Event t (RequesterData CatApi))
> pure ()
> where
```
Our `start` widget has the type `Catnet t m ()`, so it (and its child widgets) can potentially issue `CatApi` requests.
The actual widget code here isn't important to the way that `RequesterT` works, nor is this meant to be production-grade application. Nevertheless, there are a few interesting bits that we'll point out.
We're using reflex `Workflow`s to switch between pages, but we could accomplish the same result in other ways. Each `Workflow` can run a widget and send the user to another page based on the firing of some `Event` (either produced by the child widget or in scope from somewhere else).
```haskell
> start :: Catnet t m ()
> start :: RequesterT t CatApi (Either Text) m ()
start = RequesterT t CatApi (Either Text) m (Event t ())
-> RequesterT t CatApi (Either Text) m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RequesterT t CatApi (Either Text) m (Event t ())
-> RequesterT t CatApi (Either Text) m ())
-> RequesterT t CatApi (Either Text) m (Event t ())
-> RequesterT t CatApi (Either Text) m ()
forall a b. (a -> b) -> a -> b
$ Workflow t (RequesterT t CatApi (Either Text) m) ()
-> RequesterT t CatApi (Either Text) m (Event t ())
forall t (m :: * -> *) a.
(Reflex t, NotReady t m, Adjustable t m, MonadFix m, MonadHold t m,
PostBuild t m) =>
Workflow t m a -> m (Event t a)
workflowView Workflow t (RequesterT t CatApi (Either Text) m) ()
loginW
> loginW :: Workflow t (Catnet t m) ()
> loginW :: Workflow t (RequesterT t CatApi (Either Text) m) ()
loginW = Catnet
t
m
((), Event t (Workflow t (RequesterT t CatApi (Either Text) m) ()))
-> Workflow t (RequesterT t CatApi (Either Text) m) ()
forall t (m :: * -> *) a.
m (a, Event t (Workflow t m a)) -> Workflow t m a
Workflow (Catnet
t
m
((), Event t (Workflow t (RequesterT t CatApi (Either Text) m) ()))
-> Workflow t (RequesterT t CatApi (Either Text) m) ())
-> Catnet
t
m
((), Event t (Workflow t (RequesterT t CatApi (Either Text) m) ()))
-> Workflow t (RequesterT t CatApi (Either Text) m) ()
forall a b. (a -> b) -> a -> b
$ do
> token <- Catnet t m (Event t Token)
forall t (m :: * -> *).
(DomBuilder t m, MonadHold t m, MonadFix m, Prerender t m) =>
Catnet t m (Event t Token)
login
> pure ((), catnetW <$> token)
> catnetW :: Token -> Workflow t (RequesterT t CatApi (Either Text) m) ()
catnetW Token
token = RequesterT
t
CatApi
(Either Text)
m
((), Event t (Workflow t (RequesterT t CatApi (Either Text) m) ()))
-> Workflow t (RequesterT t CatApi (Either Text) m) ()
forall t (m :: * -> *) a.
m (a, Event t (Workflow t m a)) -> Workflow t m a
Workflow (RequesterT
t
CatApi
(Either Text)
m
((), Event t (Workflow t (RequesterT t CatApi (Either Text) m) ()))
-> Workflow t (RequesterT t CatApi (Either Text) m) ())
-> RequesterT
t
CatApi
(Either Text)
m
((), Event t (Workflow t (RequesterT t CatApi (Either Text) m) ()))
-> Workflow t (RequesterT t CatApi (Either Text) m) ()
forall a b. (a -> b) -> a -> b
$ do
> addDog <- Token -> Catnet t m (Event t ())
forall t (m :: * -> *).
(DomBuilder t m, MonadHold t m, MonadFix m, Prerender t m) =>
Token -> Catnet t m (Event t ())
catnet Token
token
> pure ((), dogSightingW token <$ addDog)
> dogSightingW :: Token -> Workflow t (RequesterT t CatApi (Either Text) m) ()
dogSightingW Token
token = RequesterT
t
CatApi
(Either Text)
m
((), Event t (Workflow t (RequesterT t CatApi (Either Text) m) ()))
-> Workflow t (RequesterT t CatApi (Either Text) m) ()
forall t (m :: * -> *) a.
m (a, Event t (Workflow t m a)) -> Workflow t m a
Workflow (RequesterT
t
CatApi
(Either Text)
m
((), Event t (Workflow t (RequesterT t CatApi (Either Text) m) ()))
-> Workflow t (RequesterT t CatApi (Either Text) m) ())
-> RequesterT
t
CatApi
(Either Text)
m
((), Event t (Workflow t (RequesterT t CatApi (Either Text) m) ()))
-> Workflow t (RequesterT t CatApi (Either Text) m) ()
forall a b. (a -> b) -> a -> b
$ do
> rsp <- Token -> Catnet t m (Event t (Either Text ()))
forall t (m :: * -> *).
(DomBuilder t m, MonadHold t m, PostBuild t m, Prerender t m,
MonadFix m) =>
Token -> Catnet t m (Event t (Either Text ()))
dogSighting Token
token
> leave <- delay 3 rsp
> pure ((), catnetW token <$ leave)
```
If you're building your frontend in a context where the user interface needs to be susceptible to server-side rendering (for example, if you're using [obelisk](https://github.com/obsidiansystems/obelisk)'s "prerendering" functionality to serve static pages that are "hydrated" once the JS loads), you'll need to wrap any code relying on Javascript (e.g., your XHR requests) in a `prerender`. The function below does this for us.
```haskell
> requestingJs
> :: (Reflex t, MonadFix m, Prerender t m)
> => Event t (Request (Client (Catnet t m)) a)
> -> Catnet t m (Event t (Response (Client (Catnet t m)) a))
> requestingJs :: forall t (m :: * -> *) a.
(Reflex t, MonadFix m, Prerender t m) =>
Event t (Request (Client (Catnet t m)) a)
-> Catnet t m (Event t (Response (Client (Catnet t m)) a))
requestingJs Event t (Request (Client (RequesterT t CatApi (Either Text) m)) a)
r = (Dynamic t (Event t (Either Text a))
-> Event
t (Response (Client (RequesterT t CatApi (Either Text) m)) a))
-> RequesterT
t CatApi (Either Text) m (Dynamic t (Event t (Either Text a)))
-> RequesterT
t
CatApi
(Either Text)
m
(Event
t (Response (Client (RequesterT t CatApi (Either Text) m)) a))
forall a b.
(a -> b)
-> RequesterT t CatApi (Either Text) m a
-> RequesterT t CatApi (Either Text) m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Behavior t (Event t (Either Text a)) -> Event t (Either Text a)
forall a. Behavior t (Event t a) -> Event t a
forall {k} (t :: k) a.
Reflex t =>
Behavior t (Event t a) -> Event t a
switch (Behavior t (Event t (Either Text a)) -> Event t (Either Text a))
-> (Dynamic t (Event t (Either Text a))
-> Behavior t (Event t (Either Text a)))
-> Dynamic t (Event t (Either Text a))
-> Event t (Either Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic t (Event t (Either Text a))
-> Behavior t (Event t (Either Text a))
forall a. Dynamic t a -> Behavior t a
forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current) (RequesterT
t CatApi (Either Text) m (Dynamic t (Event t (Either Text a)))
-> RequesterT
t
CatApi
(Either Text)
m
(Event
t (Response (Client (RequesterT t CatApi (Either Text) m)) a)))
-> RequesterT
t CatApi (Either Text) m (Dynamic t (Event t (Either Text a)))
-> RequesterT
t
CatApi
(Either Text)
m
(Event
t (Response (Client (RequesterT t CatApi (Either Text) m)) a))
forall a b. (a -> b) -> a -> b
$ RequesterT t CatApi (Either Text) m (Event t (Either Text a))
-> Client
(RequesterT t CatApi (Either Text) m) (Event t (Either Text a))
-> RequesterT
t CatApi (Either Text) m (Dynamic t (Event t (Either Text a)))
forall a.
RequesterT t CatApi (Either Text) m a
-> Client (RequesterT t CatApi (Either Text) m) a
-> RequesterT t CatApi (Either Text) m (Dynamic t a)
forall t (m :: * -> *) a.
Prerender t m =>
m a -> Client m a -> m (Dynamic t a)
prerender (Event t (Either Text a)
-> RequesterT t CatApi (Either Text) m (Event t (Either Text a))
forall a. a -> RequesterT t CatApi (Either Text) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Event t (Either Text a)
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never) (Client
(RequesterT t CatApi (Either Text) m) (Event t (Either Text a))
-> RequesterT
t CatApi (Either Text) m (Dynamic t (Event t (Either Text a))))
-> Client
(RequesterT t CatApi (Either Text) m) (Event t (Either Text a))
-> RequesterT
t CatApi (Either Text) m (Dynamic t (Event t (Either Text a)))
forall a b. (a -> b) -> a -> b
$ Event t (Request (RequesterT t CatApi (Either Text) (Client m)) a)
-> RequesterT
t
CatApi
(Either Text)
(Client m)
(Event
t (Response (RequesterT t CatApi (Either Text) (Client m)) a))
forall a.
Event t (Request (RequesterT t CatApi (Either Text) (Client m)) a)
-> RequesterT
t
CatApi
(Either Text)
(Client m)
(Event
t (Response (RequesterT t CatApi (Either Text) (Client m)) a))
forall t (m :: * -> *) a.
Requester t m =>
Event t (Request m a) -> m (Event t (Response m a))
requesting Event t (Request (RequesterT t CatApi (Either Text) (Client m)) a)
Event t (Request (Client (RequesterT t CatApi (Either Text) m)) a)
r
```
On the login page, we construct a `Behavior` of a `CatApi_Identify` request and send it when the user clicks the submit button.
The response from the server is an `Event` that can be used to update the user interface or perform other actions.
```haskell
> login
> :: (DomBuilder t m, MonadHold t m, MonadFix m, Prerender t m)
> => Catnet t m (Event t Token)
> login :: forall t (m :: * -> *).
(DomBuilder t m, MonadHold t m, MonadFix m, Prerender t m) =>
Catnet t m (Event t Token)
login = do
> Text
-> RequesterT t CatApi (Either Text) m ()
-> RequesterT t CatApi (Either Text) m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"h1" (RequesterT t CatApi (Either Text) m ()
-> RequesterT t CatApi (Either Text) m ())
-> RequesterT t CatApi (Either Text) m ()
-> RequesterT t CatApi (Either Text) m ()
forall a b. (a -> b) -> a -> b
$ Text -> RequesterT t CatApi (Either Text) m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
"Identify Yourself, Cat"
> cat <- InputElementConfig
EventResult
t
(DomBuilderSpace (RequesterT t CatApi (Either Text) m))
-> RequesterT
t
CatApi
(Either Text)
m
(InputElement
EventResult
(DomBuilderSpace (RequesterT t CatApi (Either Text) m))
t)
forall t (m :: * -> *) (er :: EventTag -> *).
DomBuilder t m =>
InputElementConfig er t (DomBuilderSpace m)
-> m (InputElement er (DomBuilderSpace m) t)
forall (er :: EventTag -> *).
InputElementConfig
er t (DomBuilderSpace (RequesterT t CatApi (Either Text) m))
-> RequesterT
t
CatApi
(Either Text)
m
(InputElement
er (DomBuilderSpace (RequesterT t CatApi (Either Text) m)) t)
inputElement InputElementConfig EventResult t (DomBuilderSpace m)
InputElementConfig
EventResult
t
(DomBuilderSpace (RequesterT t CatApi (Either Text) m))
forall a. Default a => a
def
> click <- button "submit"
> rsp <- requestingJs $
> tag (current $ CatApi_Identify <$> value cat) click
> let token = Event t (Either Text (Either Text Token))
-> (Either Text (Either Text Token) -> Maybe Token)
-> Event t Token
forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe Event t (Either Text (Either Text Token))
rsp ((Either Text (Either Text Token) -> Maybe Token) -> Event t Token)
-> (Either Text (Either Text Token) -> Maybe Token)
-> Event t Token
forall a b. (a -> b) -> a -> b
$ \case
> Right (Right Token
catToken) -> Token -> Maybe Token
forall a. a -> Maybe a
Just Token
catToken
> Either Text (Either Text Token)
_ -> Maybe Token
forall a. Maybe a
Nothing
> pure token
```
This function builds a UI with a few buttons. Depending on which button is clicked, we'll issue an API request and display the result, with one exception: the "Report a Sighting" button click event is returned (and used by the `Workflow` above to navigate to another page).
```haskell
> catnet
> :: (DomBuilder t m, MonadHold t m, MonadFix m, Prerender t m)
> => Token
> -> Catnet t m (Event t ())
> catnet :: forall t (m :: * -> *).
(DomBuilder t m, MonadHold t m, MonadFix m, Prerender t m) =>
Token -> Catnet t m (Event t ())
catnet Token
token = do
> Text
-> RequesterT t CatApi (Either Text) m ()
-> RequesterT t CatApi (Either Text) m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"h1" (RequesterT t CatApi (Either Text) m ()
-> RequesterT t CatApi (Either Text) m ())
-> RequesterT t CatApi (Either Text) m ()
-> RequesterT t CatApi (Either Text) m ()
forall a b. (a -> b) -> a -> b
$ Text -> RequesterT t CatApi (Either Text) m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
"Welcome, Fellow Cat."
> addDog <- Text -> RequesterT t CatApi (Either Text) m (Event t ())
forall t (m :: * -> *). DomBuilder t m => Text -> m (Event t ())
button Text
"Report a Sighting"
>
> getLastSeen <- button "Get Last Seen"
> lastSeen <- requestingJs $
> CatApi_DogApi token DogApi_GetLastSeen <$ getLastSeen
> widgetHold_ blank $ ffor lastSeen $ \case
> Left Text
err -> Text -> RequesterT t CatApi (Either Text) m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
err
> Right Maybe Dog
Nothing -> Text -> RequesterT t CatApi (Either Text) m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
"No dogs reported. Rest easy, catizen."
> Right (Just Dog
dog) -> Dog -> RequesterT t CatApi (Either Text) m ()
forall t (m :: * -> *). DomBuilder t m => Dog -> m ()
showDog Dog
dog
>
> showSuspicious <- button "Suspicious Dogs"
> suspicious <- requestingJs $
> CatApi_DogApi token DogApi_GetSuspiciousSightings <$ showSuspicious
> widgetHold_ blank $ ffor suspicious $ \case
> Left Text
err -> Text -> RequesterT t CatApi (Either Text) m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
err
> Right [Dog]
dogs -> Text
-> RequesterT t CatApi (Either Text) m ()
-> RequesterT t CatApi (Either Text) m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"ul" (RequesterT t CatApi (Either Text) m ()
-> RequesterT t CatApi (Either Text) m ())
-> RequesterT t CatApi (Either Text) m ()
-> RequesterT t CatApi (Either Text) m ()
forall a b. (a -> b) -> a -> b
$ (Dog -> RequesterT t CatApi (Either Text) m ())
-> [Dog] -> RequesterT t CatApi (Either Text) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text
-> RequesterT t CatApi (Either Text) m ()
-> RequesterT t CatApi (Either Text) m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"li" (RequesterT t CatApi (Either Text) m ()
-> RequesterT t CatApi (Either Text) m ())
-> (Dog -> RequesterT t CatApi (Either Text) m ())
-> Dog
-> RequesterT t CatApi (Either Text) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dog -> RequesterT t CatApi (Either Text) m ()
forall t (m :: * -> *). DomBuilder t m => Dog -> m ()
showDog) [Dog]
dogs
>
> pure addDog
```
The `showDog` widget below does not have `Catnet` or `RequesterT` in its type signature, so we know that it doesn't issue requests. It just builds a display widget for a particular `Dog`.
```haskell
> showDog :: DomBuilder t m => Dog -> m ()
> showDog :: forall t (m :: * -> *). DomBuilder t m => Dog -> m ()
showDog Dog
dog = Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
divClass Text
"dog" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"dl" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
> Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"dt" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
"Name"
> Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"dd" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Dog -> Text
_dog_name Dog
dog
> Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"dt" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
"Last Seen: "
> Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"dd" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ UTCTime -> String
forall a. Show a => a -> String
show (UTCTime -> String) -> UTCTime -> String
forall a b. (a -> b) -> a -> b
$ Dog -> UTCTime
_dog_sighted Dog
dog
> Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"dt" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
"Suspicious?"
> Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"dd" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ case Dog -> Bool
_dog_suspicious Dog
dog of
> Bool
True -> Text
"very"
> Bool
False -> Text
"not sure"
> Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"dt" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
"Mugshot"
> Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"dd" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ case Dog -> Maybe Text
_dog_imageUri Dog
dog of
> Just Text
img -> Text -> Map Text Text -> m () -> m ()
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Map Text Text -> m a -> m a
elAttr Text
"img" (Text
Index (Map Text Text)
"src" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: Text
IxValue (Map Text Text)
img Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<> Text
Index (Map Text Text)
"alt" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: Text
IxValue (Map Text Text)
"dog mugshot") m ()
forall (m :: * -> *). Monad m => m ()
blank
> Maybe Text
Nothing -> Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
"None"
```
This rudimentary form allows us to assemble a `Dynamic` `DogApi` request, embed it in a `CatApi` request, and send it.
```haskell
> dogSighting
> :: (DomBuilder t m, MonadHold t m, PostBuild t m, Prerender t m, MonadFix m)
> => Token
> -> Catnet t m (Event t (Either Text ()))
> dogSighting :: forall t (m :: * -> *).
(DomBuilder t m, MonadHold t m, PostBuild t m, Prerender t m,
MonadFix m) =>
Token -> Catnet t m (Event t (Either Text ()))
dogSighting Token
token = do
```
The input elements below produce `Dynamic` text and bool values that we will use to construct our `DogApi_ReportSighting` request. Recall that `DogApi_ReportSighting` has the type:
DogApi_ReportSighting :: Text -> Bool -> Maybe Text -> DogApi (Either Text ())
We need to get some text for the name, a bool indicating the dog's suspiciousness, and, optionally, some text for the url of the dog's picture.
```haskell
> name <- Text
-> RequesterT t CatApi (Either Text) m (Dynamic t Text)
-> RequesterT t CatApi (Either Text) m (Dynamic t Text)
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"label" (RequesterT t CatApi (Either Text) m (Dynamic t Text)
-> RequesterT t CatApi (Either Text) m (Dynamic t Text))
-> RequesterT t CatApi (Either Text) m (Dynamic t Text)
-> RequesterT t CatApi (Either Text) m (Dynamic t Text)
forall a b. (a -> b) -> a -> b
$ do
> Text -> RequesterT t CatApi (Either Text) m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
"Name"
> InputElement EventResult (DomBuilderSpace m) t -> Dynamic t Text
forall {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
InputElement er d t -> Dynamic t Text
_inputElement_value (InputElement EventResult (DomBuilderSpace m) t -> Dynamic t Text)
-> RequesterT
t
CatApi
(Either Text)
m
(InputElement EventResult (DomBuilderSpace m) t)
-> RequesterT t CatApi (Either Text) m (Dynamic t Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputElementConfig
EventResult
t
(DomBuilderSpace (RequesterT t CatApi (Either Text) m))
-> RequesterT
t
CatApi
(Either Text)
m
(InputElement
EventResult
(DomBuilderSpace (RequesterT t CatApi (Either Text) m))
t)
forall t (m :: * -> *) (er :: EventTag -> *).
DomBuilder t m =>
InputElementConfig er t (DomBuilderSpace m)
-> m (InputElement er (DomBuilderSpace m) t)
forall (er :: EventTag -> *).
InputElementConfig
er t (DomBuilderSpace (RequesterT t CatApi (Either Text) m))
-> RequesterT
t
CatApi
(Either Text)
m
(InputElement
er (DomBuilderSpace (RequesterT t CatApi (Either Text) m)) t)
inputElement InputElementConfig EventResult t (DomBuilderSpace m)
InputElementConfig
EventResult
t
(DomBuilderSpace (RequesterT t CatApi (Either Text) m))
forall a. Default a => a
def
> suspect <- el "label" $ do
> text "Suspicious?"
> value <$> checkbox False def
> img <- el "label" $ do
> text "Image URI (if available)"
> v <- _inputElement_value <$> inputElement def
> pure $ ffor v $ \Text
v' -> if Text -> Bool
T.null Text
v' then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v'
> send <- button "submit"
```
Once we've got those three values, we can apply them to the `DogApi_ReportSighting` constructor. We're using some infix functions from [Control.Applicative](https://hackage.haskell.org/package/base/docs/Control-Applicative.html) to apply the constructor to `Dynamic` values, and, as a result, we get a `Dynamic` `DogApi` request. When the submit `Event` fires, we take the `current` value of that `Dynamic` and send it.
```haskell
> let dogApi = Text -> Bool -> Maybe Text -> DogApi (Either Text ())
DogApi_ReportSighting (Text -> Bool -> Maybe Text -> DogApi (Either Text ()))
-> Dynamic t Text
-> Dynamic t (Bool -> Maybe Text -> DogApi (Either Text ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Text
name Dynamic t (Bool -> Maybe Text -> DogApi (Either Text ()))
-> Dynamic t Bool
-> Dynamic t (Maybe Text -> DogApi (Either Text ()))
forall a b. Dynamic t (a -> b) -> Dynamic t a -> Dynamic t b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t Bool
suspect Dynamic t (Maybe Text -> DogApi (Either Text ()))
-> Dynamic t (Maybe Text) -> Dynamic t (DogApi (Either Text ()))
forall a b. Dynamic t (a -> b) -> Dynamic t a -> Dynamic t b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Dynamic t (Maybe Text)
img
> rsp <- requestingJs $ tag (current $ CatApi_DogApi token <$> dogApi) send
> widgetHold_ blank $ ffor rsp $ \case
> Right (Right ()) -> Text -> RequesterT t CatApi (Either Text) m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
"Dog reported! Returning to catnet..."
> Either Text (Either Text ())
_ -> Text -> RequesterT t CatApi (Either Text) m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
"Couldn't submit."
> pure $ ffor rsp $ \case
> Right (Left Text
err) -> Text -> Either Text ()
forall a b. a -> Either a b
Left Text
err
> Left Text
err -> Text -> Either Text ()
forall a b. a -> Either a b
Left Text
err
> Right (Right ()
result) -> () -> Either Text ()
forall a b. b -> Either a b
Right ()
result
> main :: IO ()
> main :: IO ()
main = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
```
Go to the [example](example) directory to run this example (including the [backend](example/backend/src/Backend.md)).