implement getting thread in Client

This commit is contained in:
towards-a-new-leftypol 2024-02-01 02:55:26 -05:00
parent 840edb86ab
commit 37b576b96b
5 changed files with 25 additions and 10 deletions

View File

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

View File

@ -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" -H "Content-Type: application/json"

View File

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

View File

@ -168,15 +168,22 @@ mainUpdate (HaveLatest (Client.HttpResponse {..})) m = m <#
-- mapM_ (consoleLog . toJSString . show) posts -- mapM_ (consoleLog . toJSString . show) posts
return $ GridAction $ Grid.DisplayItems 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 GetLatest m = m <# Client.fetchLatest (clientModel m) (iClient HaveLatest)
-- mainUpdate GetThread {..} m = noEff m -- 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) consoleLog $ "Thread " `append` (pack $ show $ board_thread_id)
pushURI new_current_uri pushURI new_current_uri
-- TODO: Need to return a Client action here to get the thread data Client.getThread (clientModel m) (iClient HaveThread) GetThreadArgs {..}
return NoAction
where where
new_current_uri :: URI new_current_uri :: URI

View File

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