From 683e8555362808ff7eb640365ea2e8c18f216492 Mon Sep 17 00:00:00 2001 From: towards-a-new-leftypol Date: Mon, 29 Jan 2024 20:01:12 -0500 Subject: [PATCH] Hook into push/sub uri to change pages --- chandlr.cabal | 4 +- query_postgrest.sh | 5 ++ src/Action.hs | 10 ++-- src/Component/CatalogGrid.hs | 30 ++++++++---- src/Main.hs | 94 ++++++++++++++++++++++++++++-------- src/Routes.hs | 10 ++-- 6 files changed, 114 insertions(+), 39 deletions(-) create mode 100755 query_postgrest.sh diff --git a/chandlr.cabal b/chandlr.cabal index 8df84b7..b60dfc5 100644 --- a/chandlr.cabal +++ b/chandlr.cabal @@ -82,7 +82,9 @@ executable chandlr ghcjs-dom-jsffi, text, time, - bytestring + bytestring, + filepath, + network-uri -- Directories containing source files. hs-source-dirs: src diff --git a/query_postgrest.sh b/query_postgrest.sh new file mode 100755 index 0000000..4fbf5bf --- /dev/null +++ b/query_postgrest.sh @@ -0,0 +1,5 @@ +# curl -v 'http://localhost:3000/blocked_post_attachments?select=*,blocked_post(known_spam_attachments(hit_count,post_id))&blocked_post.known_spam_attachments.post_id=eq.1' \ +curl -v 'http://localhost:3000/posts?select=*,attachments(board_filename,file_extension,thumb_extension)&thread_id=eq.13106&order=board_post_id.asc' \ + -X GET \ + -H "Content-Type: application/json" + diff --git a/src/Action.hs b/src/Action.hs index ecbc81a..e60cd59 100644 --- a/src/Action.hs +++ b/src/Action.hs @@ -1,7 +1,10 @@ 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.CatalogPostType (CatalogPost) @@ -9,10 +12,11 @@ data Action = GridAction Grid.Action | GetLatest | GetThread - { website :: String - , board :: String - , board_thread_id :: Int + { website :: Text + , board_pathpart :: Text + , board_thread_id :: Int64 } | HaveLatest (Client.HttpResult [CatalogPost]) | ClientAction Client.Action + | ChangeURI URI | NoAction diff --git a/src/Component/CatalogGrid.hs b/src/Component/CatalogGrid.hs index 0bdac40..39bbd06 100644 --- a/src/Component/CatalogGrid.hs +++ b/src/Component/CatalogGrid.hs @@ -17,7 +17,9 @@ import Miso ( View, div_ , class_ , img_ , href_ , a_ , src_ , title_ , strong_ , span_ , p_ , id_ , Effect , noEff - , text, rawHtml + , text, rawHtml, onWithOptions + , defaultOptions, preventDefault + , Attribute, emptyDecoder ) import Miso.String (toMisoString, MisoString) @@ -30,18 +32,24 @@ data Model = Model } deriving Eq initialModel :: JSString -> Model -initialModel media_root = Model +initialModel media_root_ = Model { display_items = [] - , media_root = toMisoString media_root + , media_root = toMisoString media_root_ } -data Action = DisplayItems [ CatalogPost ] +data Action + = DisplayItems [ CatalogPost ] data Interface a = Interface - { passAction :: Action -> a - , selectThread :: () + { passAction :: Action -> a + , threadSelected :: CatalogPost -> a } + +-- Custom event handler with preventDefault set to True +onClick_ :: a -> Attribute a +onClick_ action = onWithOptions defaultOptions { preventDefault = True } "click" emptyDecoder (const action) + update :: Interface a -> Action @@ -58,18 +66,20 @@ view iface model = [ class_ "threads" ] [ div_ [ id_ "Grid" ] - (map (gridItem model) (display_items model)) + (map (gridItem iface model) (display_items model)) ] ] -gridItem :: Model -> CatalogPost -> View a -gridItem m post = +gridItem :: Interface a -> Model -> CatalogPost -> View a +gridItem iface m post = div_ [ class_ "mix" ] [ div_ [ class_ "thread grid-li grid-size-small" ] [ a_ - [ href_ thread_url ] + [ href_ thread_url + , onClick_ (threadSelected iface post) + ] [ img_ [ class_ "thread-image" , src_ thumb_url diff --git a/src/Main.hs b/src/Main.hs index 00c0a25..3f37d94 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -7,7 +7,12 @@ module Main where import Data.Proxy import Data.Maybe (maybe) +import Data.Text (Text) +import qualified Data.Text as T +import Network.URI (uriPath) +import System.FilePath (()) +import Data.JSString (pack, append) import Miso ( View , startApp @@ -25,6 +30,8 @@ import Miso , runRoute , getCurrentURI , consoleLog + , pushURI + , uriSub --, MisoString (..) ) import GHCJS.DOM (currentDocument) @@ -36,6 +43,8 @@ import Servant.API import Action import Routes import qualified Network.Client as Client +import Network.CatalogPostType (CatalogPost) +import qualified Network.CatalogPostType as CatalogPost import qualified Component.CatalogGrid as Grid @@ -43,6 +52,7 @@ import qualified Component.CatalogGrid as Grid data Model = Model { gridModel :: Grid.Model , clientModel :: Client.Model + , current_uri :: URI } deriving Eq @@ -56,21 +66,23 @@ initialActionFromRoute model uri = either (const NoAction) id routing_result h_latest :: Model -> Action h_latest = const GetLatest - h_thread :: String -> String -> BoardThreadId -> Model -> Action - h_thread board website board_thread_id _ = GetThread {..} + h_thread :: Text -> Text -> BoardThreadId -> Model -> Action + h_thread website board_pathpart board_thread_id _ = GetThread {..} initialModel :: JSString -> Int -> JSString + -> URI -> Model -initialModel pgroot client_fetch_count media_root = Model +initialModel pgroot client_fetch_count media_root u = Model { gridModel = Grid.initialModel media_root , clientModel = Client.Model { Client.pgApiRoot = pgroot , Client.fetchCount = client_fetch_count } + , current_uri = u } getMetadata :: String -> IO (Maybe JSString) @@ -103,13 +115,13 @@ main = do media_root <- getMetadata "media-root" >>= return . maybe "undefined" id - let initial_model = initialModel pg_api_root pg_fetch_count media_root + let initial_model = initialModel pg_api_root pg_fetch_count media_root uri startApp App { model = initial_model , update = mainUpdate , view = mainView - , subs = [] + , subs = [ uriSub ChangeURI ] , events = defaultEvents , initialAction = initialActionFromRoute initial_model uri , mountPoint = Nothing @@ -118,11 +130,27 @@ main = do mainView :: Model -> View Action -mainView model = - div_ [] - [ h1_ [] [ text "Hello World" ] - , Grid.view iGrid (gridModel model) - ] +mainView model = view + + where + view = + either (const page404) id + $ runRoute (Proxy :: Proxy Route) handlers current_uri model + + handlers = catalog_view :<|> thread_view + + catalog_view :: Model -> View Action + catalog_view _ = div_ [] + [ h1_ [] [ text "Hello World" ] + , Grid.view iGrid (gridModel model) + ] + + thread_view :: Text -> Text -> BoardThreadId -> Model -> View Action + thread_view site_name board_pathpart board_thread_id m = + h1_ [] [ text "Thread View" ] + + page404 :: View Action + page404 = h1_ [] [ text "404 Not Found" ] mainUpdate :: Action -> Model -> Effect Action Model @@ -142,7 +170,25 @@ mainUpdate (HaveLatest (Client.HttpResponse {..})) m = m <# mainUpdate GetLatest m = m <# Client.fetchLatest (clientModel m) iClient -mainUpdate GetThread {..} m = noEff m +-- mainUpdate GetThread {..} m = noEff m + +mainUpdate GetThread {..} 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 + + where + new_current_uri :: URI + new_current_uri = (current_uri m) { + uriPath = T.unpack website + T.unpack board_pathpart + show board_thread_id + } + +mainUpdate (ChangeURI old_uri) m = m { current_uri = old_uri } <# do + consoleLog $ "ChangeURI! " `append` (pack $ show $ old_uri) + return NoAction mainUpdate (GridAction ga) m = Grid.update iGrid ga (gridModel m) @@ -156,9 +202,17 @@ mainUpdate (ClientAction ca) m = iGrid :: Grid.Interface Action iGrid = Grid.Interface { Grid.passAction = GridAction - , Grid.selectThread = () + , Grid.threadSelected = mkGetThread } + where + mkGetThread :: CatalogPost -> Action + mkGetThread post = GetThread + { website = CatalogPost.site_name post + , board_pathpart = CatalogPost.pathpart post + , board_thread_id = CatalogPost.board_thread_id post + } + iClient :: Client.Interface Action iClient = Client.Interface { Client.passAction = ClientAction @@ -167,17 +221,15 @@ iClient = Client.Interface {- - TODO: - - - Create Hello World page render ✓ - - - Create CatalogGrid component (static at first) ✓ - - - Get postgrest url from page header and perform an initial xhr request ✓ + - - 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 + - - display page + - - history api / navigation for browser history + - - create component ✓ - - - - do I need to move out everything into another project called chandlr-common? - - - if I want to use the isomorphic feature of miso, then yes - - - - add a router first - - - go to the next page and do xhr for the content - - - before we do xhr we need the postgrest url, - - - how do we tackle a config? - - make it isomorphic - - move everything before or during this part into common lib -} diff --git a/src/Routes.hs b/src/Routes.hs index 041f028..a5f2418 100644 --- a/src/Routes.hs +++ b/src/Routes.hs @@ -3,6 +3,9 @@ module Routes where +import Data.Text (Text) +import Data.Int (Int64) + import Miso (View) import Servant.API @@ -18,10 +21,9 @@ type R_Latest = View Action -- Show selected thread -- - //res/ type R_Thread - = Capture "website" String - :> Capture "board" String - :> "res" + = Capture "website" Text + :> Capture "board" Text :> Capture "board_thread_id" BoardThreadId :> View Action -type BoardThreadId = Int +type BoardThreadId = Int64