From 1cfeff547d80eb61a1db8102f06011e73dd2fd9f Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Wed, 27 Mar 2019 16:24:07 -0700
Subject: almost working

---
 lore/Biz/Ibb/Move.hs | 36 +++++++++++++++++++++++++++++++++---
 1 file changed, 33 insertions(+), 3 deletions(-)

(limited to 'lore/Biz/Ibb/Move.hs')

diff --git a/lore/Biz/Ibb/Move.hs b/lore/Biz/Ibb/Move.hs
index 9ff9b34..291e015 100644
--- a/lore/Biz/Ibb/Move.hs
+++ b/lore/Biz/Ibb/Move.hs
@@ -1,12 +1,42 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 -- | App update logic
 module Biz.Ibb.Move (
-    module X
+    module Core
   , move
+  -- * Server interactions
+  , fetchPeople
   ) where
 
-import Biz.Ibb.Core as X
+import Alpha
+import Data.Aeson
+import Biz.Ibb.Influencers (Person)
+import Biz.Ibb.Core as Core
+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 = undefined
+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 <# do SetPeople /@ fetchPeople
+move (SetPeople ps) m = noEff m { people = ps }
+
+fetchPeople :: IO (WebData [Person])
+fetchPeople = do
+  mjson <- contents /@ xhrByteString req
+  case mjson of
+    Nothing -> pure $ Failure "could not read from server"
+    Just json -> pure
+      $ either (Failure . ms) Core.Success
+      $ eitherDecodeStrict json
+  where
+    req = Request { reqMethod = GET
+                  , reqURI = "/api/people" -- FIXME: can replace this hardcoding with a function?
+                  , reqLogin = Nothing
+                  , reqHeaders = []
+                  , reqWithCredentials = False
+                  , reqData = NoData
+                  }
-- 
cgit v1.2.3