diff options
Diffstat (limited to 'lore/Biz/Ibb')
-rw-r--r-- | lore/Biz/Ibb/Core.hs | 24 | ||||
-rw-r--r-- | lore/Biz/Ibb/Influencers.hs | 13 | ||||
-rw-r--r-- | lore/Biz/Ibb/Move.hs | 36 |
3 files changed, 65 insertions, 8 deletions
diff --git a/lore/Biz/Ibb/Core.hs b/lore/Biz/Ibb/Core.hs index 8fd0068..4ec87e3 100644 --- a/lore/Biz/Ibb/Core.hs +++ b/lore/Biz/Ibb/Core.hs @@ -17,14 +17,28 @@ type Routes = Home type Home = View Action data Model = Model - { modelUri :: URI - , people :: [Person] + { uri :: URI + , people :: WebData [Person] } deriving (Show, Eq) +data RemoteData e a + = NotAsked + | Loading + | Failure e + | Success a + deriving (Show, Eq) + +type WebData a = RemoteData MisoString a + +init :: URI -> Model +init u = Model u Loading + data Action = Nop | ChangeRoute URI | HandleRoute URI + | FetchPeople + | SetPeople (WebData [Person]) deriving (Show, Eq) home :: Model -> View Action @@ -51,7 +65,11 @@ see m = div_ [ class_ "container mt-5" ] [ text "Get new book recommendations from the world's influencers in your email." ] ] ] - , div_ [ class_ "card-columns" ] $ seePerson /@ people m + , div_ [ class_ "card-columns" ] $ case people m of + NotAsked -> [ text "Initializing..." ] + Loading -> [ text "Loading..." ] + Failure err -> [ text err ] + Success ps -> seePerson /@ ps ] seePerson :: Person -> View Action diff --git a/lore/Biz/Ibb/Influencers.hs b/lore/Biz/Ibb/Influencers.hs index beeaf41..f00fe2e 100644 --- a/lore/Biz/Ibb/Influencers.hs +++ b/lore/Biz/Ibb/Influencers.hs @@ -1,7 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} module Biz.Ibb.Influencers where +import Data.Aeson import Data.Text.Lazy (Text) +import GHC.Generics (Generic) data Person = Person { _name :: Text @@ -10,13 +13,19 @@ data Person = Person , _website :: Text , _books :: [Book] , _blurb :: Text - } deriving (Show, Eq) + } deriving (Generic, Show, Eq) + +instance FromJSON Person +instance ToJSON Person data Book = Book { _title :: Text , _author :: Text , _amznref :: Text - } deriving (Show, Eq) + } deriving (Generic, Show, Eq) + +instance FromJSON Book +instance ToJSON Book allPeople :: [Person] allPeople = 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 + } |