re-add Search component back

This commit is contained in:
towards-a-new-leftypol 2024-03-24 21:46:28 -04:00
parent 2cac270545
commit b5f086372e
4 changed files with 74 additions and 5 deletions

View File

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

@ -1 +1 @@
Subproject commit cff3dd9e9fd013a0eedaa17df52e8f9eb5ef73c6 Subproject commit 172323f730e86c776c5ecd8091149b4c7244e363

66
src/Component/Search.hs Normal file
View File

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

View File

@ -43,10 +43,12 @@ import qualified Network.Client as Client
import qualified Common.Component.CatalogGrid as Grid import qualified Common.Component.CatalogGrid as Grid
import qualified Common.Component.ThreadView as Thread import qualified Common.Component.ThreadView as Thread
import qualified Common.Component.TimeControl as TC 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.FrontEnd.Views import Common.FrontEnd.Views
import Common.FrontEnd.Model import Common.FrontEnd.Model
import Common.FrontEnd.Interfaces import Common.FrontEnd.Interfaces
import qualified Common.Network.ClientTypes as Client
initialActionFromRoute :: Model -> URI -> Action initialActionFromRoute :: Model -> URI -> Action
initialActionFromRoute model uri = either (const NoAction) id routing_result initialActionFromRoute model uri = either (const NoAction) id routing_result
@ -155,7 +157,6 @@ main = do
, logLevel = Off , logLevel = Off
} }
mainView :: Model -> View Action mainView :: Model -> View Action
mainView model = view mainView model = view
where where