From c790672cc244ac4caba1bda3572829a6c6862891 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Sun, 27 Oct 2019 09:48:52 -0700
Subject: move everything to namespace directories

---
 com/influencedbybooks/move.hs | 43 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 43 insertions(+)
 create mode 100644 com/influencedbybooks/move.hs

(limited to 'com/influencedbybooks/move.hs')

diff --git a/com/influencedbybooks/move.hs b/com/influencedbybooks/move.hs
new file mode 100644
index 0000000..2c0ee37
--- /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 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
+                  }
-- 
cgit v1.2.3