implement getting thread in Client

chandlr.cabal

@@ -66,9 +66,11 @@ executable chandlr
                       Action
                       Network.Http
                       Network.Client
+                      Network.ClientTypes
                       Network.CatalogPostType
                       Routes
 
+
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
 

query_postgrest.sh

@@ -1,2 +1,2 @@
-curl -v 'http://localhost:3000/threads?select=posts(*,attachments(*)),boards()&board_thread_id=eq.466060&posts.order=board_post_id.asc&boards.pathpart=eq.leftypol' \
+curl -v 'http://localhost:3000/sites?select=*,boards(*,threads(*,posts(*,attachments(*))))&name=eq.leftychan&boards.pathpart=eq.ga&boards.threads.board_thread_id=eq.11787' \
     -H "Content-Type: application/json"

src/Action.hs

@@ -23,6 +23,7 @@ data Action
     | GetLatest
     | GetThread GetThreadArgs
     | HaveLatest (HttpResult [CatalogPost])
+    | HaveThread (HttpResult ())
     | forall a. (FromJSON a) => ClientAction (HttpResult a -> Action) (C.Action a)
     | ChangeURI URI
     | NoAction

src/Main.hs

@@ -168,15 +168,22 @@ mainUpdate (HaveLatest (Client.HttpResponse {..})) m = m <#
             -- mapM_ (consoleLog . toJSString . show) posts
             return $ GridAction $ Grid.DisplayItems posts
 
+mainUpdate (HaveThread Client.Error) m = m <# do
+    consoleLog "Getting Thread failed!"
+    return NoAction
+
+mainUpdate (HaveThread (Client.HttpResponse {..})) m = m <# do
+    consoleLog "Have Thread!"
+    return NoAction
+
 mainUpdate GetLatest m = m <# Client.fetchLatest (clientModel m) (iClient HaveLatest)
 
 -- mainUpdate GetThread {..} m = noEff m
 
-mainUpdate (GetThread GetThreadArgs{..}) 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
-    return NoAction
+    Client.getThread (clientModel m) (iClient HaveThread) GetThreadArgs {..}
 
     where
         new_current_uri :: URI

src/Network/Client.hs

@@ -11,6 +11,7 @@ module Network.Client
     , Action (..)
     , Interface (..)
     , fetchLatest
+    , getThread
     , Model (..)
     , update
     ) where
@@ -25,6 +26,7 @@ import Data.Time.Clock (UTCTime)
 
 import GHCJS.DOM.Types (JSString)
 import Miso (effectSub, Effect)
+import Miso.String (toMisoString)
 
 import qualified Network.Http as Http
 import Network.CatalogPostType (CatalogPost)
@@ -77,10 +79,13 @@ fetchLatest m iface = do
     http_ m iface "/rpc/fetch_catalog" Http.POST payload
 
 
-getThread :: A.GetThreadArgs -> IO a
-getThread A.GetThreadArgs {..} = undefined
+getThread :: Model -> Interface a () -> A.GetThreadArgs -> IO a
+getThread m iface A.GetThreadArgs {..} =
+    http_ m iface path Http.GET (Nothing :: Maybe ())
 
-
--- TODO: Action.GetLatest needs to be refactored out into a shared
---      data structure that we can pass as the argument for this getThread
---      function
+    where
+        path = "/sites?"
+            <> "select=*,boards(*,threads(*,posts(*,attachments(*))))"
+            <> "&name=eq." <> toMisoString website
+            <> "&boards.pathpart=eq." <> toMisoString board_pathpart
+            <> "&boards.threads.board_thread_id=eq." <> toMisoString (show board_thread_id)