From 37b576b96b1b98cef531df0e1af33c99443e3aeb Mon Sep 17 00:00:00 2001
From: towards-a-new-leftypol <paul_cockshott@protonmail.com>
Date: Thu, 1 Feb 2024 02:55:26 -0500
Subject: [PATCH] implement getting thread in Client

---
 chandlr.cabal         |  2 ++
 query_postgrest.sh    |  2 +-
 src/Action.hs         |  1 +
 src/Main.hs           | 13 ++++++++++---
 src/Network/Client.hs | 17 +++++++++++------
 5 files changed, 25 insertions(+), 10 deletions(-)

diff --git a/chandlr.cabal b/chandlr.cabal
index b60dfc5..c2a677f 100644
--- a/chandlr.cabal
+++ b/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:
 
diff --git a/query_postgrest.sh b/query_postgrest.sh
index fb31b0d..dec35e6 100755
--- a/query_postgrest.sh
+++ b/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"
diff --git a/src/Action.hs b/src/Action.hs
index e3c897a..fd6c9e3 100644
--- a/src/Action.hs
+++ b/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
diff --git a/src/Main.hs b/src/Main.hs
index 0ec8dd8..56cdd72 100644
--- a/src/Main.hs
+++ b/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
diff --git a/src/Network/Client.hs b/src/Network/Client.hs
index dd2de9d..90dfdaf 100644
--- a/src/Network/Client.hs
+++ b/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)