Miso - load initial data for model from page (decode json)

chandlr.cabal

@@ -62,7 +62,8 @@ executable chandlr
     ghcjs-options:    -dedupe
 
     -- Modules included in this executable, other than Main.
-    other-modules:    Common.Component.CatalogGrid
+    other-modules:    
+                      Common.Component.CatalogGrid
                       Common.FrontEnd.Action
                       Network.Http
                       Common.Network.HttpTypes
@@ -87,8 +88,9 @@ executable chandlr
                       Common.Parsing.EmbedParser
                       Common.Parsing.PostPartType
                       Common.Component.TimeControl
-                      Common.Component.Search
+                      Component.Search
                       Common.Component.Search.SearchTypes
+                      Common.Component.Search.View
 
 
     -- LANGUAGE extensions used by modules in this package.

src/Common

@@ -1 +1 @@
-Subproject commit cff3dd9e9fd013a0eedaa17df52e8f9eb5ef73c6
+Subproject commit 9c66974547de307fb97886449cf63ffa46f83b4c

src/Component/Search.hs

@@ -0,0 +1,66 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Component.Search
+( view
+, Interface (..)
+, update
+, Model (..)
+, Action (..)
+) where
+
+import Miso
+  ( Effect
+  , (<#)
+  , consoleLog
+  , noEff
+  )
+import Miso.String (toMisoString)
+
+import Control.Concurrent.MVar (tryTakeMVar, takeMVar, putMVar, swapMVar)
+
+import Common.Network.HttpTypes (HttpResult (..))
+import Common.Component.Search.SearchTypes
+import Common.Component.Search.View
+import qualified Network.Client as Client
+
+update :: Interface a -> Action -> Model -> Effect a Model
+update iface (SearchChange q) model = model { searchTerm = q } <# do
+    consoleLog $ "SearchChange " <> q
+    m_search_query <- tryTakeMVar (searchVar model)
+
+    case m_search_query of
+        Nothing -> putMVar (searchVar model) q
+        Just _ -> swapMVar (searchVar model) q >> return ()
+
+    return $ (passAction iface) NoAction
+
+update iface OnSubmit model = model <# do
+    search_query <- takeMVar (searchVar model)
+    consoleLog $ "Submit! " <> search_query
+    Client.search (clientModel model) search_query (clientIface iface)
+
+update iface (ChangeAndSubmit search_query) model = model { searchTerm = search_query } <# do
+    _ <- swapMVar (searchVar model) search_query
+    return $ (passAction iface) OnSubmit
+
+update iface (SearchResult result) model = model <# do
+    consoleLog $ "Received search results!"
+
+    case result of
+        Error -> do
+            consoleLog $ "Error!"
+            return $ passAction iface $ PassPostsToSelf []
+
+        HttpResponse {..} -> do
+            consoleLog $ (toMisoString $ show $ status_code) <> " " <> (toMisoString $ status_text)
+            consoleLog $ (toMisoString $ show $ body)
+
+            case body of
+                Just catlg_posts -> return $ passAction iface $ PassPostsToSelf catlg_posts
+                Nothing -> return $ passAction iface $ PassPostsToSelf []
+
+update iface (PassPostsToSelf search_results) model = model { displayResults = search_results } <#
+    (return $ (searchResults iface) (searchTerm model))
+
+update _ NoAction m = noEff m

src/Main.hs

@@ -8,16 +8,17 @@ module Main where
 import Data.Proxy
 import Data.Maybe (maybe, fromJust)
 import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
 import qualified Data.Text as T
 import Network.URI (uriPath, uriQuery, escapeURIString, unEscapeString, isAllowedInURI)
 import System.FilePath ((</>))
 import Data.Time.Clock (UTCTime, getCurrentTime)
 import Control.Concurrent.MVar (MVar, newEmptyMVar)
-
 import Data.JSString (pack, append, unpack)
+import Data.JSString.Text (textFromJSString)
 import Miso
     ( View
-    , startApp
+    , miso
     , App (..)
     , Effect
     , (<#)
@@ -26,16 +27,17 @@ import Miso
     , LogLevel (Off)
     , URI
     , runRoute
-    , getCurrentURI
     , consoleLog
     , pushURI
     , uriSub
+    --, getCurrentURI
     )
 import GHCJS.DOM (currentDocument)
 import GHCJS.DOM.Types (toJSString, fromJSString, Element, JSString)
 import GHCJS.DOM.ParentNode (querySelector)
 import GHCJS.DOM.Element (getAttribute)
 import Servant.API
+import Data.Aeson (decodeStrict, FromJSON)
 
 import Common.FrontEnd.Action
 import Common.FrontEnd.Routes
@@ -43,10 +45,38 @@ import qualified Network.Client as Client
 import qualified Common.Component.CatalogGrid as Grid
 import qualified Common.Component.ThreadView as Thread
 import qualified Common.Component.TimeControl as TC
-import qualified Common.Component.Search as Search
+import qualified Common.Component.Search.SearchTypes as Search
+import qualified Component.Search as Search
+import Common.Network.SiteType (Site)
 import Common.FrontEnd.Views
 import Common.FrontEnd.Model
 import Common.FrontEnd.Interfaces
+import Common.Network.CatalogPostType (CatalogPost)
+
+data InitialData
+    = CatalogData [ CatalogPost ]
+    | SearchData [ CatalogPost ]
+    | ThreadData Site
+    | Nil
+
+parseInitialDataUsingRoute :: Model -> URI -> JSString -> InitialData
+parseInitialDataUsingRoute model uri raw_json = either (const Nil) id routing_result
+    where
+        decoded_thing :: (FromJSON a) => Maybe a
+        decoded_thing = decodeStrict $ encodeUtf8 $ textFromJSString raw_json
+
+        routing_result = runRoute (Proxy :: Proxy Route) handlers (const uri) model
+
+        handlers = h_latest :<|> h_thread :<|> h_search
+
+        h_latest :: Model -> InitialData
+        h_latest _ = CatalogData $ maybe ([]) id $ decoded_thing
+
+        h_thread :: Text -> Text -> BoardThreadId -> Model -> InitialData
+        h_thread _ _ _ _ = undefined
+
+        h_search :: Maybe Text -> Model -> InitialData
+        h_search _ _ = undefined
 
 initialActionFromRoute :: Model -> URI -> Action
 initialActionFromRoute model uri = either (const NoAction) id routing_result
@@ -102,13 +132,13 @@ initialModel pgroot client_fetch_count media_root u t smv = Model
         }
 
 
-getMetadata :: String -> IO (Maybe JSString)
+getMetadata :: JSString -> IO (Maybe JSString)
 getMetadata key = do
     doc <- currentDocument
 
     mElem :: Maybe Element <- case doc of
         Nothing -> return Nothing
-        Just d -> querySelector d $ "meta[name='" ++ key ++ "']"
+        Just d -> querySelector d $ "meta[name='" <> key <> "']"
 
     case mElem of
         Nothing -> return Nothing
@@ -119,12 +149,8 @@ main :: IO ()
 main = do
     consoleLog "Hello World!"
 
-    uri <- getCurrentURI
-
-    consoleLog $ toJSString $ show uri
-
     pg_api_root <- getMetadata "postgrest-root" >>=
-        return . maybe "http://localhost:2000" id
+        return . maybe "http://localhost:3000" id
     consoleLog pg_api_root
 
     pg_fetch_count <- getMetadata "postgrest-fetch-count" >>=
@@ -135,26 +161,47 @@ main = do
 
     now <- getCurrentTime
 
+    -- uri <- getCurrentURI
+
+    initial_data <- getMetadata "initial-data" >>= return . maybe "" id
+
+    -- how to decode initial_data:
+    --      - need to use runRoute but return some kind of new data type that wraps
+    --      our data for each view, with constructors like InitialCatalog [ CatalogPost ] etc
+    --
+    --      - to use this, need to pass in a Model
+
     search_var <- newEmptyMVar
 
+    miso $ \uri ->
             let initial_model = initialModel
                   pg_api_root
                   pg_fetch_count
-          media_root uri
+                  media_root
+                  uri
                   now
                   search_var
-
+            in
-    startApp App
+                App
-        { model         = initial_model
+                    { model         = parseInitialData initial_model uri initial_data
                     , update        = mainUpdate
                     , view          = mainView
                     , subs          = [ uriSub ChangeURI ]
                     , events        = defaultEvents
-        , initialAction = initialActionFromRoute initial_model uri
+                    , initialAction = NoAction --initialActionFromRoute initial_model uri
                     , mountPoint    = Nothing
                     , logLevel      = Off
                     }
 
+    where
+        parseInitialData :: Model -> URI -> JSString -> Model
+        parseInitialData m uri json_str = applyInitialData m initial_data
+            where
+                applyInitialData :: Model -> InitialData -> Model
+                applyInitialData model (CatalogData posts) =
+                    model { grid_model = Grid.Model posts (media_root_ model) }
+
+                initial_data = parseInitialDataUsingRoute m uri json_str
 
 mainView :: Model -> View Action
 mainView model = view

src/Network/Client.hs

@@ -17,7 +17,6 @@ module Network.Client
     , search
     ) where
 
-import GHC.Generics
 import Control.Monad (void)
 import Control.Concurrent (forkIO)
 import Control.Concurrent.MVar (takeMVar)