diff options
author | Ben Sima <ben@bsima.me> | 2019-08-29 06:26:52 -0700 |
---|---|---|
committer | Ben Sima <ben@bsima.me> | 2019-08-29 06:26:52 -0700 |
commit | 7a0e9725e691bd84cda8f6b169414581e5e1d4f1 (patch) | |
tree | 7be077badb2cc362a03fc73459a708e8a5ba3c88 | |
parent | cac8297fa42721e09d96614c1b16ab17d2c383d0 (diff) |
implement Network.RemoteData
-rw-r--r-- | apex/Ibb.hs | 4 | ||||
-rw-r--r-- | lore/Biz/Ibb/Core.hs | 9 | ||||
-rw-r--r-- | lore/Biz/Ibb/Move.hs | 7 | ||||
-rw-r--r-- | lore/Network/RemoteData.hs | 33 |
4 files changed, 40 insertions, 13 deletions
diff --git a/apex/Ibb.hs b/apex/Ibb.hs index dd26d96..973960c 100644 --- a/apex/Ibb.hs +++ b/apex/Ibb.hs @@ -10,11 +10,11 @@ module Ibb where import Alpha import Biz.Ibb import Data.Maybe (fromMaybe) -import Data.Proxy import qualified Lucid as L import Lucid.Base import Miso import Network.HTTP.Types +import Network.RemoteData import Network.Wai import Network.Wai.Application.Static import Network.Wai.Handler.Warp @@ -25,7 +25,7 @@ import System.Environment (lookupEnv) main :: IO () main = do - say "running" + say "running: ibb" port <- read <$> fromMaybe "3000" <$> lookupEnv "PORT" :: IO Int diff --git a/lore/Biz/Ibb/Core.hs b/lore/Biz/Ibb/Core.hs index 4ec87e3..39f506c 100644 --- a/lore/Biz/Ibb/Core.hs +++ b/lore/Biz/Ibb/Core.hs @@ -6,9 +6,9 @@ module Biz.Ibb.Core where import Alpha import Biz.Ibb.Influencers -import Data.Proxy import Miso import Miso.String +import Network.RemoteData import Servant.API import Servant.Links @@ -21,13 +21,6 @@ data Model = Model , 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 diff --git a/lore/Biz/Ibb/Move.hs b/lore/Biz/Ibb/Move.hs index 291e015..ea3904d 100644 --- a/lore/Biz/Ibb/Move.hs +++ b/lore/Biz/Ibb/Move.hs @@ -16,6 +16,7 @@ import Biz.Ibb.Core as Core import JavaScript.Web.XMLHttpRequest (Request(..), Method(GET), RequestData(NoData), contents, xhrByteString) import Miso import Miso.String +import Network.RemoteData move :: Action -> Model -> Effect Action Model move Nop m = noEff m @@ -29,9 +30,9 @@ 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 + Just a -> pure + $ either (Failure . ms) Network.RemoteData.Success + $ eitherDecodeStrict a where req = Request { reqMethod = GET , reqURI = "/api/people" -- FIXME: can replace this hardcoding with a function? diff --git a/lore/Network/RemoteData.hs b/lore/Network/RemoteData.hs new file mode 100644 index 0000000..a2c58a7 --- /dev/null +++ b/lore/Network/RemoteData.hs @@ -0,0 +1,33 @@ +-- | A port of Kris Jenkins' RemoteData Elm module +-- <https://github.com/krisajenkins/remotedata>. +-- +module Network.RemoteData where + +data RemoteData a b + = NotAsked + | Loading + | Failure a + | Success b + +-- TODO figure out Http.Error +-- type WebData a = RemoteData Http.Error a + +instance Functor (RemoteData a) where + fmap _ NotAsked = NotAsked + fmap _ Loading = Loading + fmap _ (Failure a) = Failure a + fmap f (Success a) = Success (f a) + +instance Applicative (RemoteData e) where + pure = Success + NotAsked <*> _ = NotAsked + Loading <*> _ = Loading + Failure a <*> _ = Failure a + Success a <*> b = fmap a b + +instance Show (RemoteData a b) +instance Eq (RemoteData a b) + +fromEither :: Either a b -> RemoteData a b +fromEither (Left a) = Failure a +fromEither (Right a) = Success a |