Biz/Ibb/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
44
45
46
47
48
49
50
51
52

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

-- | App update logic
module Biz.Ibb.Move
  ( move,

    -- * Server interactions
    fetchPeople,
  )
where

import Alpha
import Biz.Ibb.Core as Core
import Data.Aeson
import JavaScript.Web.XMLHttpRequest
  ( Method (GET),
    Request (..),
    RequestData (NoData),
    contents,
    xhrByteString,
  )
import Miso
import Miso.String
import Network.RemoteData

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
        }