diff options
author | Ben Sima <ben@bsima.me> | 2019-03-27 16:24:07 -0700 |
---|---|---|
committer | Ben Sima <ben@bsima.me> | 2019-03-27 16:24:07 -0700 |
commit | 1cfeff547d80eb61a1db8102f06011e73dd2fd9f (patch) | |
tree | 8efeed3a3c8245fe916494aeb49cb33980b7dea5 /lore/Biz/Ibb/Move.hs | |
parent | 3f0471b314fa2792207b3116aa7491f5f353b31e (diff) |
almost working
Diffstat (limited to 'lore/Biz/Ibb/Move.hs')
-rw-r--r-- | lore/Biz/Ibb/Move.hs | 36 |
1 files changed, 33 insertions, 3 deletions
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 + } |