summaryrefslogtreecommitdiff
path: root/Com/InfluencedByBooks/Move.hs
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2019-11-02 15:33:13 -0700
committerBen Sima <ben@bsima.me>2019-11-02 15:33:13 -0700
commit9d114cfc773171b0a95bd4d2c39f1bb0eb783c8d (patch)
tree20766a760ed0141cf39153565e8552f6739c632d /Com/InfluencedByBooks/Move.hs
parentd2a37f5de160160eadbacd7b8dc2567f78a0543d (diff)
rename everything back to caps to appease ghc
Diffstat (limited to 'Com/InfluencedByBooks/Move.hs')
-rw-r--r--Com/InfluencedByBooks/Move.hs43
1 files changed, 43 insertions, 0 deletions
diff --git a/Com/InfluencedByBooks/Move.hs b/Com/InfluencedByBooks/Move.hs
new file mode 100644
index 0000000..d372da6
--- /dev/null
+++ b/Com/InfluencedByBooks/Move.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | App update logic
+module Com.InfluencedByBooks.Move (
+ move
+ -- * Server interactions
+ , fetchPeople
+ ) where
+
+import Com.Simatime.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
+ }