Http decodes data with aeson

chandlr.cabal

@@ -67,6 +67,7 @@ executable chandlr
                       Network.Http
                       Network.Client
                       Routes
+                      Common.PostsType
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
@@ -79,7 +80,8 @@ executable chandlr
                        servant,
                        ghcjs-dom,
                        ghcjs-dom-jsffi,
-                       text
+                       text,
+                       time
 
     -- Directories containing source files.
     hs-source-dirs:   src

src/Action.hs

@@ -4,6 +4,8 @@ import Component.CatalogGrid as Grid
 import Network.Client as Client
 import Data.Text (Text)
 
+import Common.PostsType (Post)
+
 data Action
     = GridAction Grid.Action
     | GetLatest
@@ -12,6 +14,6 @@ data Action
         , board           :: String
         , board_thread_id :: Int
         }
-    | HaveLatest (Client.HttpResult Text)
+    | HaveLatest (Client.HttpResult [Post])
     | ClientAction Client.Action
     | NoAction

src/Common

@@ -1 +1 @@
-Subproject commit 0026e48cea06e2768f7a22f4a25bf115debcea35
+Subproject commit a5d90ea96195ed6a5a7e3196d5b0e32b65af5058

src/Main.hs

@@ -100,8 +100,8 @@ mainUpdate (HaveLatest (Client.HttpResponse {..})) m = m <# do
     case body of
         Nothing -> do
             consoleLog "Didn't get anything back from API"
-        Just txt -> do
+        Just posts -> do
-            consoleLog $ toJSString txt
+            consoleLog $ toJSString $ show posts
 
     return NoAction
 

src/Network/Client.hs

@@ -20,14 +20,15 @@ import Control.Concurrent.MVar (takeMVar)
 import Miso (effectSub, Effect)
 
 import qualified Network.Http as Http
+import Common.PostsType (Post)
 
 
-data Action = Connect Http.HttpActionResult
+data Action = Connect (Http.HttpActionResult [Post])
 
 
 data Interface a = Interface
     { passAction :: Action -> a
-    , returnResult :: Http.HttpResult Text -> a
+    , returnResult :: Http.HttpResult [Post] -> a
     }
 
 
@@ -44,7 +45,7 @@ update
     -> Effect a Model
 update iface (Connect (abort, resultVar)) m = effectSub m $
     \sink -> void $ forkIO $ do
-        result :: Http.HttpResult Text <- takeMVar resultVar
+        result :: Http.HttpResult [Post] <- takeMVar resultVar
         sink $ (returnResult iface) result
 
 

src/Network/Http.hs

@@ -10,8 +10,10 @@ where
 
 import Prelude hiding (error)
 import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
 import Control.Monad.IO.Class (liftIO)
 import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar)
+import Data.Aeson (FromJSON, eitherDecodeStrict)
 import GHCJS.DOM.XMLHttpRequest
     ( newXMLHttpRequest
     , openSimple
@@ -27,33 +29,6 @@ import Data.JSString.Text (textToJSString)
 import GHCJS.DOM.EventM (onAsync)
 import GHCJS.DOM.XMLHttpRequestEventTarget (load, abortEvent, error)
 
--- What we actually want is to call send and not block the thread
---   - so that we can put the request into our list of ongoing requests.
---   - and have the response come back as an Action?
---      - we would need the onload event to send an Action to updateModel
-
-{-
- - Okay what the hell do I even want from an http function?
- -
- - the js implementation has these features:
- -
- -  - url
- -  - method
- -  - ability to abort
- -  - is async
- -  - get the result from it
- -      - this should be a fn (IO result), let's not expose the xhr object?
- -
- -  Also want:
- -  - return the same data structure always, but that data structure should
- -  inform of any errors, and have the status code, response body,
- -  and status text.
- -
- -
- - Do we really need some sort of isomorphic framework? I think that's
- - more work than just using a simple http lib server-side... tbqh
- -}
-
 data HttpMethod = GET | PUT | POST | DELETE | PATCH
     deriving Show
 
@@ -65,10 +40,10 @@ data HttpResult a
         , body        :: Maybe a
         }
 
-type HttpActionResult = (IO (), MVar (HttpResult Text)) -- (abort, result)
+type HttpActionResult a = (IO (), MVar (HttpResult a)) -- (abort, result)
 
 
-mkResult :: XMLHttpRequest -> IO (HttpResult Text)
+mkResult :: (FromJSON a) => XMLHttpRequest -> IO (HttpResult a)
 mkResult xhr = do
         sc <- getStatus xhr
 
@@ -78,18 +53,31 @@ mkResult xhr = do
 
         mBody :: Maybe Text <- getResponseText xhr
 
-        return HttpResponse
+        let mBytes = mBody >>= Just . encodeUtf8
-            { status_code = status_code_int
+
-            , status_text = st
+        case mBytes of
-            , body = mBody
+            Nothing -> return HttpResponse
-            }
+                    { status_code = status_code_int
+                    , status_text = st
+                    , body = Nothing
+                    }
+            Just bs -> do
+                let parse_result = eitherDecodeStrict bs
+                case parse_result of
+                    Left _ -> return Error
+                    Right x -> return HttpResponse
+                        { status_code = status_code_int
+                        , status_text = st
+                        , body = Just x
+                        }
 
 
 http
-    :: String
+    :: (FromJSON a)
+    => String
     -> HttpMethod
     -> Maybe Text
-    -> IO HttpActionResult
+    -> IO (HttpActionResult a)
 http url method payload = do
     xhr <- newXMLHttpRequest