Get thread view partially working

- need to call parse bodies

app/Common

@@ -1 +1 @@
-Subproject commit 9c66974547de307fb97886449cf63ffa46f83b4c
+Subproject commit 6b210bf185141b4716e06937c1b93a233bac1fcd

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) =

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" }