re-add Search component back
This commit is contained in:
parent
2cac270545
commit
b5f086372e
|
@ -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
|
|
@ -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
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue