From cd3bb2064fcbc1ebf9fd8c1bf9e2db8c3036cb2a Mon Sep 17 00:00:00 2001 From: towards-a-new-leftypol Date: Wed, 31 Jan 2024 20:36:50 -0500 Subject: [PATCH] WIP Client.getThread --- closure_example.sh | 1 + src/Action.hs | 19 +++++++++------- src/Main.hs | 12 +++++------ src/Network/Client.hs | 44 ++++++++++++++++++++++++++------------ src/Network/ClientTypes.hs | 19 ++++++++++++++++ src/Network/Http.hs | 2 +- 6 files changed, 68 insertions(+), 29 deletions(-) create mode 100644 closure_example.sh create mode 100644 src/Network/ClientTypes.hs diff --git a/closure_example.sh b/closure_example.sh new file mode 100644 index 0000000..d5aaeaf --- /dev/null +++ b/closure_example.sh @@ -0,0 +1 @@ +closure-compiler --js lib.js --js_output_file lib.min.js --compilation_level SIMPLE_OPTIMIZATIONS diff --git a/src/Action.hs b/src/Action.hs index e60cd59..3fc4c20 100644 --- a/src/Action.hs +++ b/src/Action.hs @@ -2,21 +2,24 @@ module Action where import Data.Text (Text) import Component.CatalogGrid as Grid -import Network.Client as Client import Data.Int (Int64) import Miso (URI) +import Network.ClientTypes as C import Network.CatalogPostType (CatalogPost) +import Network.Http (HttpResult) + +data GetThreadArgs = GetThreadArgs + { website :: Text + , board_pathpart :: Text + , board_thread_id :: Int64 + } data Action = GridAction Grid.Action | GetLatest - | GetThread - { website :: Text - , board_pathpart :: Text - , board_thread_id :: Int64 - } - | HaveLatest (Client.HttpResult [CatalogPost]) - | ClientAction Client.Action + | GetThread GetThreadArgs + | HaveLatest (HttpResult [CatalogPost]) + | ClientAction C.Action | ChangeURI URI | NoAction diff --git a/src/Main.hs b/src/Main.hs index 3f37d94..f27c416 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -67,7 +67,7 @@ initialActionFromRoute model uri = either (const NoAction) id routing_result h_latest = const GetLatest h_thread :: Text -> Text -> BoardThreadId -> Model -> Action - h_thread website board_pathpart board_thread_id _ = GetThread {..} + h_thread website board_pathpart board_thread_id _ = GetThread GetThreadArgs {..} initialModel @@ -141,7 +141,7 @@ mainView model = view catalog_view :: Model -> View Action catalog_view _ = div_ [] - [ h1_ [] [ text "Hello World" ] + [ h1_ [] [ text "Overboard Catalog" ] , Grid.view iGrid (gridModel model) ] @@ -172,7 +172,7 @@ mainUpdate GetLatest m = m <# Client.fetchLatest (clientModel m) iClient -- mainUpdate GetThread {..} m = noEff m -mainUpdate GetThread {..} 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 @@ -207,7 +207,7 @@ iGrid = Grid.Interface where mkGetThread :: CatalogPost -> Action - mkGetThread post = GetThread + mkGetThread post = GetThread GetThreadArgs { website = CatalogPost.site_name post , board_pathpart = CatalogPost.pathpart post , board_thread_id = CatalogPost.board_thread_id post @@ -224,9 +224,9 @@ iClient = Client.Interface - - Create the thread view - - add routing so when you click in the catalog it goes to the thread - - register onClick ✓ - - - pevent default and consoleLog the event + - - pevent default and consoleLog the event ✓ - - display page - - - history api / navigation for browser history + - - history api / navigation for browser history ✓ - - create component ✓ - - diff --git a/src/Network/Client.hs b/src/Network/Client.hs index df7017f..18f6147 100644 --- a/src/Network/Client.hs +++ b/src/Network/Client.hs @@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE RecordWildCards #-} module Network.Client ( Http.HttpActionResult @@ -27,20 +28,8 @@ import Miso (effectSub, Effect) import qualified Network.Http as Http import Network.CatalogPostType (CatalogPost) - - -data Action = Connect (Http.HttpActionResult [CatalogPost]) - - -data Interface a = Interface - { passAction :: Action -> a - , returnResult :: Http.HttpResult [CatalogPost] -> a - } - -data Model = Model - { pgApiRoot :: JSString - , fetchCount :: Int - } deriving Eq +import qualified Action as A +import Network.ClientTypes update @@ -58,6 +47,24 @@ data FetchCatalogArgs = FetchCatalogArgs , max_row_read :: Int } deriving (Generic, ToJSON) + +http_ + :: (ToJSON b) + => Model + -> Interface a + -> JSString + -> Http.HttpMethod + -> Maybe b + -> IO a +http_ m iface api_path method payload = do + Http.http + (pgApiRoot m <> api_path) + method + [("Content-Type", "application/json")] + payload + >>= return . (passAction iface) . Connect + + fetchLatest :: Model -> Interface a -> IO a fetchLatest m iface = do ct <- getCurrentTime @@ -72,3 +79,12 @@ fetchLatest m iface = do } ) >>= return . (passAction iface) . Connect + + +getThread :: A.GetThreadArgs -> IO a +getThread A.GetThreadArgs {..} = undefined + + +-- TODO: Action.GetLatest needs to be refactored out into a shared +-- data structure that we can pass as the argument for this getThread +-- function diff --git a/src/Network/ClientTypes.hs b/src/Network/ClientTypes.hs new file mode 100644 index 0000000..f0d02be --- /dev/null +++ b/src/Network/ClientTypes.hs @@ -0,0 +1,19 @@ +module Network.ClientTypes where + +import qualified Network.Http as Http +import Network.CatalogPostType (CatalogPost) +import GHCJS.DOM.Types (JSString) + +data Action = Connect (Http.HttpActionResult [CatalogPost]) + +data Interface a = Interface + { passAction :: Action -> a + , returnResult :: Http.HttpResult [CatalogPost] -> a + } + +data Model = Model + { pgApiRoot :: JSString + , fetchCount :: Int + } deriving Eq + + diff --git a/src/Network/Http.hs b/src/Network/Http.hs index b6d14ec..c46d513 100644 --- a/src/Network/Http.hs +++ b/src/Network/Http.hs @@ -36,6 +36,7 @@ import Miso (consoleLog) data HttpMethod = GET | PUT | POST | DELETE | PATCH deriving Show + data HttpResult a = Error | HttpResponse @@ -46,7 +47,6 @@ data HttpResult a type HttpActionResult a = (IO (), MVar (HttpResult a)) -- (abort, result) - type Header = (JSString, JSString) mkResult :: (FromJSON a) => XMLHttpRequest -> IO (HttpResult a)