Re-namespacing

Moving away from the DNS-driven namespacing toward more condensed names,
mostly because I don't like typing so much.

1 files changed, 48 insertions, 0 deletions

diff --git a/Biz/Ibb/Move.hs b/Biz/Ibb/Move.hs
new file mode 100644
index 0000000..1e635ac
--- /dev/null
+++ b/Biz/Ibb/Move.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | App update logic
+module Biz.Ibb.Move
+  ( move
+  -- * Server interactions
+  , fetchPeople
+  )
+where
+
+import           Alpha
+import           Biz.Ibb.Core    as Core
+import           Network.RemoteData
+import           Data.Aeson
+import           JavaScript.Web.XMLHttpRequest  ( Request(..)
+                                                , Method(GET)
+                                                , RequestData(NoData)
+                                                , contents
+                                                , xhrByteString
+                                                )
+import           Miso
+import           Miso.String
+
+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
+                }