chandlr.cabal

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

src/Common

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

src/Component/Search.hs

@@ -1,66 +0,0 @@
-{-# 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,17 +8,16 @@ 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
-    , miso
+    , startApp
     , App (..)
     , Effect
     , (<#)
@@ -27,17 +26,16 @@ 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
@@ -45,38 +43,10 @@ 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.SearchTypes as Search
+import qualified Common.Component.Search 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
@@ -132,13 +102,13 @@ initialModel pgroot client_fetch_count media_root u t smv = Model
         }
 
 
-getMetadata :: JSString -> IO (Maybe JSString)
+getMetadata :: String -> 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
@@ -149,8 +119,12 @@ main :: IO ()
 main = do
     consoleLog "Hello World!"
 
+    uri <- getCurrentURI
+
+    consoleLog $ toJSString $ show uri
+
     pg_api_root <- getMetadata "postgrest-root" >>=
-        return . maybe "http://localhost:3000" id
+        return . maybe "http://localhost:2000" id
     consoleLog pg_api_root
 
     pg_fetch_count <- getMetadata "postgrest-fetch-count" >>=
@@ -161,47 +135,26 @@ 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
+          media_root uri
-                  uri
           now
           search_var
-            in
+
-                App
+    startApp App
-                    { model         = parseInitialData initial_model uri initial_data
+        { model         = initial_model
         , update        = mainUpdate
         , view          = mainView
         , subs          = [ uriSub ChangeURI ]
         , events        = defaultEvents
-                    , initialAction = NoAction --initialActionFromRoute initial_model uri
+        , initialAction = 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,6 +17,7 @@ module Network.Client
     , search
     ) where
 
+import GHC.Generics
 import Control.Monad (void)
 import Control.Concurrent (forkIO)
 import Control.Concurrent.MVar (takeMVar)