summaryrefslogtreecommitdiff
path: root/Com/InfluencedByBooks/Move.hs
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2020-04-12 12:15:49 -0700
committerBen Sima <ben@bsima.me>2020-04-12 19:01:15 -0700
commit46a680f7ca7def264a0f0b616883fb8e47271bab (patch)
tree92020970623359e6dc76f02d7c537c846c1d4ed9 /Com/InfluencedByBooks/Move.hs
parent72e42deeb5d5b9cd2765d2ff20a06e708f8efc07 (diff)
De-namespace Alpha
A bunch of formatting changes got in there too. Oops. I will probably eventually de-namespace everything, mostly because I'm tired of typing "Com.Whatever.Thing" all the time. A better namespacing strategy might be to use normal Haskell namespacing (Data, Control, Network, etc) for code that is not specific to biz activities (i.e. if I could open-source it at any time), and use simply "Biz" for stuff that I would never want to open-source.
Diffstat (limited to 'Com/InfluencedByBooks/Move.hs')
-rw-r--r--Com/InfluencedByBooks/Move.hs57
1 files changed, 31 insertions, 26 deletions
diff --git a/Com/InfluencedByBooks/Move.hs b/Com/InfluencedByBooks/Move.hs
index d6cb12e..5d6f0c4 100644
--- a/Com/InfluencedByBooks/Move.hs
+++ b/Com/InfluencedByBooks/Move.hs
@@ -2,25 +2,32 @@
{-# LANGUAGE OverloadedStrings #-}
-- | App update logic
-module Com.InfluencedByBooks.Move (
- move
+module Com.InfluencedByBooks.Move
+ ( move
-- * Server interactions
, fetchPeople
- ) where
+ )
+where
-import Com.InfluencedByBooks.Core as Core
-import Com.Simatime.Alpha
-import Com.Simatime.Network
-import Data.Aeson
-import JavaScript.Web.XMLHttpRequest (Request(..), Method(GET), RequestData(NoData), contents, xhrByteString)
-import Miso
-import Miso.String
+import Alpha
+import Com.InfluencedByBooks.Core as Core
+import Com.Simatime.Network
+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 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 (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])
@@ -28,16 +35,14 @@ 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
- }
+ 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
+ }