summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--apex/Ibb.hs4
-rw-r--r--lore/Biz/Ibb/Core.hs9
-rw-r--r--lore/Biz/Ibb/Move.hs7
-rw-r--r--lore/Network/RemoteData.hs33
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