implement Network.RemoteData

3 files changed, 38 insertions, 11 deletions

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