WIP Client.getThread

closure_example.sh

@@ -0,0 +1 @@
+closure-compiler --js lib.js --js_output_file lib.min.js --compilation_level SIMPLE_OPTIMIZATIONS

src/Action.hs

@@ -2,21 +2,24 @@ module Action where
 
 import Data.Text (Text)
 import Component.CatalogGrid as Grid
-import Network.Client as Client
 import Data.Int (Int64)
 import Miso (URI)
 
+import Network.ClientTypes as C
 import Network.CatalogPostType (CatalogPost)
+import Network.Http (HttpResult)
 
-data Action
-    = GridAction Grid.Action
-    | GetLatest
-    | GetThread
+data GetThreadArgs = GetThreadArgs
     { website         :: Text
     , board_pathpart  :: Text
     , board_thread_id :: Int64
     }
-    | HaveLatest (Client.HttpResult [CatalogPost])
-    | ClientAction Client.Action
+
+data Action
+    = GridAction Grid.Action
+    | GetLatest
+    | GetThread GetThreadArgs
+    | HaveLatest (HttpResult [CatalogPost])
+    | ClientAction C.Action
     | ChangeURI URI
     | NoAction

src/Main.hs

@@ -67,7 +67,7 @@ initialActionFromRoute model uri = either (const NoAction) id routing_result
         h_latest = const GetLatest
 
         h_thread :: Text -> Text -> BoardThreadId -> Model -> Action
-        h_thread website board_pathpart board_thread_id _ = GetThread {..}
+        h_thread website board_pathpart board_thread_id _ = GetThread GetThreadArgs {..}
 
 
 initialModel
@@ -141,7 +141,7 @@ mainView model = view
 
         catalog_view :: Model -> View Action
         catalog_view _ = div_ []
-            [ h1_ [] [ text "Hello World" ]
+            [ h1_ [] [ text "Overboard Catalog" ]
             , Grid.view iGrid (gridModel model)
             ]
 
@@ -172,7 +172,7 @@ mainUpdate GetLatest m = m <# Client.fetchLatest (clientModel m) iClient
 
 -- mainUpdate GetThread {..} m = noEff m
 
-mainUpdate GetThread {..} m = m <# do
+mainUpdate (GetThread GetThreadArgs{..}) m = m <# do
     consoleLog $ "Thread " `append` (pack $ show $ board_thread_id)
     pushURI new_current_uri
     -- TODO: Need to return a Client action here to get the thread data
@@ -207,7 +207,7 @@ iGrid = Grid.Interface
 
     where
         mkGetThread :: CatalogPost -> Action
-        mkGetThread post = GetThread
+        mkGetThread post = GetThread GetThreadArgs
             { website = CatalogPost.site_name post
             , board_pathpart = CatalogPost.pathpart post
             , board_thread_id = CatalogPost.board_thread_id post
@@ -224,9 +224,9 @@ iClient = Client.Interface
  -  - Create the thread view
  -      - add routing so when you click in the catalog it goes to the thread
  -          - register onClick ✓
- -          - pevent default and consoleLog the event
+ -          - pevent default and consoleLog the event ✓
  -          - display page
- -          - history api / navigation for browser history
+ -          - history api / navigation for browser history ✓
  -      - create component ✓
  -
  -

src/Network/Client.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Network.Client
     ( Http.HttpActionResult
@@ -27,20 +28,8 @@ import Miso (effectSub, Effect)
 
 import qualified Network.Http as Http
 import Network.CatalogPostType (CatalogPost)
-
-
-data Action = Connect (Http.HttpActionResult [CatalogPost])
-
-
-data Interface a = Interface
-    { passAction :: Action -> a
-    , returnResult :: Http.HttpResult [CatalogPost] -> a
-    }
-
-data Model = Model
-  { pgApiRoot :: JSString
-  , fetchCount :: Int
-  } deriving Eq
+import qualified Action as A
+import Network.ClientTypes
 
 
 update
@@ -58,6 +47,24 @@ data FetchCatalogArgs = FetchCatalogArgs
   , max_row_read :: Int
   } deriving (Generic, ToJSON)
 
+
+http_
+    :: (ToJSON b)
+    => Model
+    -> Interface a
+    -> JSString
+    -> Http.HttpMethod
+    -> Maybe b
+    -> IO a
+http_ m iface api_path method payload = do
+    Http.http
+        (pgApiRoot m <> api_path)
+        method
+        [("Content-Type", "application/json")]
+        payload
+    >>= return . (passAction iface) . Connect
+
+
 fetchLatest :: Model -> Interface a -> IO a
 fetchLatest m iface = do
     ct <- getCurrentTime
@@ -72,3 +79,12 @@ fetchLatest m iface = do
             }
         )
     >>= return . (passAction iface) . Connect
+
+
+getThread :: A.GetThreadArgs -> IO a
+getThread A.GetThreadArgs {..} = undefined
+
+
+-- TODO: Action.GetLatest needs to be refactored out into a shared
+--      data structure that we can pass as the argument for this getThread
+--      function

src/Network/ClientTypes.hs

@@ -0,0 +1,19 @@
+module Network.ClientTypes where
+
+import qualified Network.Http as Http
+import Network.CatalogPostType (CatalogPost)
+import GHCJS.DOM.Types (JSString)
+
+data Action = Connect (Http.HttpActionResult [CatalogPost])
+
+data Interface a = Interface
+    { passAction :: Action -> a
+    , returnResult :: Http.HttpResult [CatalogPost] -> a
+    }
+
+data Model = Model
+  { pgApiRoot :: JSString
+  , fetchCount :: Int
+  } deriving Eq
+
+

src/Network/Http.hs

@@ -36,6 +36,7 @@ import Miso (consoleLog)
 data HttpMethod = GET | PUT | POST | DELETE | PATCH
     deriving Show
 
+
 data HttpResult a
     = Error
     | HttpResponse
@@ -46,7 +47,6 @@ data HttpResult a
 
 type HttpActionResult a = (IO (), MVar (HttpResult a)) -- (abort, result)
 
-
 type Header = (JSString, JSString)
 
 mkResult :: (FromJSON a) => XMLHttpRequest -> IO (HttpResult a)