Hook into push/sub uri to change pages

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

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

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

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

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

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
 --  - <website>/<board>/res/<thread_id>
 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