From 644011dd237c0d092e1902f73a43bb96708cc0a8 Mon Sep 17 00:00:00 2001
From: towards-a-new-leftypol <paul_cockshott@protonmail.com>
Date: Wed, 27 Mar 2024 16:58:06 -0400
Subject: [PATCH] Get thread view partially working

- need to call parse bodies
---
 app/Common        |  2 +-
 app/DataClient.hs | 19 +++++++++++++++++
 app/Main.hs       | 52 ++++++++++++++++++++++++++++++++++++++++++++---
 3 files changed, 69 insertions(+), 4 deletions(-)

diff --git a/app/Common b/app/Common
index 9c66974..6b210bf 160000
--- a/app/Common
+++ b/app/Common
@@ -1 +1 @@
-Subproject commit 9c66974547de307fb97886449cf63ffa46f83b4c
+Subproject commit 6b210bf185141b4716e06937c1b93a233bac1fcd
diff --git a/app/DataClient.hs b/app/DataClient.hs
index e78a13d..4369fda 100644
--- a/app/DataClient.hs
+++ b/app/DataClient.hs
@@ -1,20 +1,27 @@
+{-# LANGUAGE RecordWildCards #-}
+
 module DataClient
     ( fetchLatest
+    , getThread
     )
     where
 
 import Data.Time.Clock (UTCTime)
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.ByteString.Lazy.Char8 as LC8
+import qualified Data.Text as Text
 
 import Common.Network.CatalogPostType (CatalogPost)
 import Common.Network.ClientTypes (Model (..), FetchCatalogArgs (..))
 import Common.Network.HttpClient
     ( post
+    , get
     , HttpError (..)
     )
 import Data.Aeson (eitherDecode, encode, FromJSON)
+import qualified Common.FrontEnd.Action as A
 import Common.Server.JSONSettings (JSONSettings)
+import Common.Network.SiteType (Site)
 
 fetchLatest :: JSONSettings -> Model -> UTCTime -> IO (Either HttpError [ CatalogPost ])
 fetchLatest settings m t = do
@@ -26,6 +33,18 @@ fetchLatest settings m t = do
             , max_row_read = fetchCount m
             }
 
+getThread :: JSONSettings -> Model -> A.GetThreadArgs -> IO (Either HttpError [ Site ])
+getThread settings m A.GetThreadArgs {..} =
+    get settings path >>= return . eitherDecodeResponse
+
+    where
+        path = "/sites?"
+            <> "select=*,boards(*,threads(*,posts(*,attachments(*))))"
+            <> "&name=eq." <> Text.unpack website
+            <> "&boards.pathpart=eq." <> Text.unpack board_pathpart
+            <> "&boards.threads.board_thread_id=eq." <> (show board_thread_id)
+            <> "&boards.threads.posts.order=board_post_id.asc"
+
 eitherDecodeResponse :: (FromJSON a) => Either HttpError LBS.ByteString -> Either HttpError a
 eitherDecodeResponse (Left err) = Left err
 eitherDecodeResponse (Right bs) =
diff --git a/app/Main.hs b/app/Main.hs
index d46065a..ca1e7d3 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -47,6 +47,9 @@ import qualified Common.Server.JSONSettings as S
 import Common.Network.CatalogPostType (CatalogPost)
 import qualified Common.Component.CatalogGrid as Grid
 import qualified Common.Component.TimeControl as TC
+import Common.FrontEnd.Action (GetThreadArgs (..))
+import qualified Common.Component.Thread.Model as Thread
+import Common.Network.SiteType (Site)
 
 data HtmlPage a = forall b. (ToJSON b) => HtmlPage (JSONSettings, b, a)
 
@@ -100,7 +103,10 @@ type StaticRoute = "static" :> Servant.Raw
 type API = StaticRoute :<|> FrontEndRoutes
 
 handlers :: JSONSettings -> Server FrontEndRoutes
-handlers settings = (catalogView settings) :<|> threadView :<|> searchView
+handlers settings
+    =    (catalogView settings)
+    :<|> (threadView settings)
+    :<|> searchView
 
 clientSettings :: JSONSettings -> S.JSONSettings
 clientSettings (JSONSettings {..}) = S.JSONSettings
@@ -155,8 +161,48 @@ catalogView settings = do
 
                 tc_model = TC.Model 0
 
-threadView :: Text -> Text -> FE.BoardThreadId -> Handler (HtmlPage (View FE.Action))
-threadView _ _ _ = throwError $ err404 { errBody = "404 - Not Implemented" }
+threadView :: JSONSettings -> Text -> Text -> FE.BoardThreadId -> Handler (HtmlPage (View FE.Action))
+threadView settings website board_pathpart board_thread_id = do
+    thread_results <- liftIO $ do
+
+        Client.getThread
+            (clientSettings settings)
+            (clientModel settings)
+            (GetThreadArgs {..})
+
+    now <- liftIO getCurrentTime
+
+    case thread_results of
+        Left err -> throwError $ err500 { errBody = fromString $ show err }
+        Right site -> pure $ render now $ head site
+
+    where
+        render :: UTCTime -> Site -> HtmlPage (View FE.Action)
+        render t site =
+            HtmlPage
+                ( settings
+                , site
+                , FE.threadView website board_pathpart board_thread_id model
+                )
+
+            where
+                model = FE.Model
+                    { FE.grid_model = undefined
+                    , FE.client_model = undefined
+                    , FE.thread_model = Just thread_model
+                    , FE.current_uri = undefined
+                    , FE.media_root_ = undefined
+                    , FE.current_time = t
+                    , FE.tc_model = undefined
+                    , FE.search_model = undefined
+                    }
+
+                thread_model = Thread.Model
+                    { Thread.site = site
+                    , Thread.media_root = pack $ media_root settings
+                    , Thread.post_bodies = []
+                    , Thread.current_time = t
+                    }
 
 searchView :: Maybe Text -> Handler (HtmlPage (View FE.Action))
 searchView _ = throwError $ err404 { errBody = "404 - Not Implemented" }