com/influencedbybooks/move.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

-- | App update logic
module Com.InfluencedByBooks.Move (
    move
  -- * Server interactions
  , fetchPeople
  ) where

import Alpha
import Data.Aeson
import Com.InfluencedByBooks.Core as Core
import JavaScript.Web.XMLHttpRequest (Request(..), Method(GET), RequestData(NoData), contents, xhrByteString)
import Miso
import Miso.String
import Com.Simatime.Network

move :: Action -> Model -> Effect Action Model
move Nop m = noEff m
move (HandleRoute u) m = m { uri = u } <# pure Nop
move (ChangeRoute u) m = m <# do pushURI u >> pure Nop
move FetchPeople m = m <# (SetPeople /@ fetchPeople)
move (SetPeople ps) m = noEff m { people = ps }

fetchPeople :: IO (WebData [Core.Person])
fetchPeople = do
  mjson <- contents /@ xhrByteString req
  case mjson of
    Nothing -> pure $ Failure "could not read from server"
    Just a -> pure
      $ fromEither
      $ either (Left . ms) pure
      $ eitherDecodeStrict a
  where
    req = Request { reqMethod = GET
                  -- FIXME: can replace this hardcoding with a function?
                  , reqURI = "/api/people"
                  , reqLogin = Nothing
                  , reqHeaders = []
                  , reqWithCredentials = False
                  , reqData = NoData
                  }