move everything to namespace directories

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..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
+                  }