From fc2742d8909ac2e5c5e654cd07a3ce2780039d0e Mon Sep 17 00:00:00 2001 From: towards-a-new-leftypol Date: Tue, 12 Mar 2024 17:36:15 -0400 Subject: [PATCH] Move Search, Interfaces, and top-level Views into Common sub-repo --- chandlr.cabal | 2 +- src/Common | 2 +- src/Component/Search.hs | 106 ---------------------------------------- src/Main.hs | 101 ++------------------------------------ src/Network/Client.hs | 5 -- 5 files changed, 7 insertions(+), 209 deletions(-) delete mode 100644 src/Component/Search.hs diff --git a/chandlr.cabal b/chandlr.cabal index 29cc758..a28da58 100644 --- a/chandlr.cabal +++ b/chandlr.cabal @@ -87,7 +87,7 @@ executable chandlr Common.Parsing.EmbedParser Common.Parsing.PostPartType Common.Component.TimeControl - Component.Search + Common.Component.Search Common.Component.Search.SearchTypes diff --git a/src/Common b/src/Common index 7d521a9..491616d 160000 --- a/src/Common +++ b/src/Common @@ -1 +1 @@ -Subproject commit 7d521a921990b5a05d98782babc85cc6ee54eb0c +Subproject commit 491616d096e0ded61bd341487f2487d9082d9b5c diff --git a/src/Component/Search.hs b/src/Component/Search.hs deleted file mode 100644 index e29e69b..0000000 --- a/src/Component/Search.hs +++ /dev/null @@ -1,106 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - -module Component.Search -( view -, Interface (..) -, update -, Model (..) -, Action (..) -) where - -import Miso - ( View - , class_ - , action_ - , method_ - , input_ - , type_ - , value_ - , name_ - , form_ - , onChange - , onSubmit - , Effect - , (<#) - , consoleLog - , noEff - ) -import Data.JSString (JSString, pack) -import qualified Network.Client as Client -import Network.Http (HttpResult (..)) -import Control.Concurrent.MVar (tryTakeMVar, takeMVar, putMVar, swapMVar) - -import Common.Network.CatalogPostType (CatalogPost) -import Common.Component.Search.SearchTypes - - -data Interface a = Interface - { passAction :: Action -> a - , clientIface :: Client.Interface a [ CatalogPost ] - , searchResults :: JSString -> a - } - - -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 $ (pack $ show $ status_code) <> " " <> (pack $ status_text) - consoleLog $ (pack $ 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 :: Interface a -> Model -> View a -view iface m = form_ - [ class_ "search_form" - , action_ "/search" - , method_ "GET" - , onSubmit $ pass $ OnSubmit - ] - [ input_ - [ type_ "submit" - , value_ "🔍" - ] - , input_ - [ type_ "text" - , name_ "search" - , onChange $ pass . SearchChange - ] - ] - - where - pass = passAction iface diff --git a/src/Main.hs b/src/Main.hs index c1f97c1..667e5d1 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -51,29 +51,10 @@ import qualified Common.Network.CatalogPostType as CatalogPost import qualified Common.Component.CatalogGrid as Grid import qualified Common.Component.ThreadView as Thread import qualified Common.Component.TimeControl as TC -import qualified Component.Search as Search - - -data Model = Model - { grid_model :: Grid.Model - , client_model :: Client.Model - , thread_model :: Maybe Thread.Model - , current_uri :: URI - , media_root_ :: JSString - , current_time :: UTCTime - , tc_model :: TC.Model - , search_model :: Search.Model - {- - - Goal: - - handle search results - - - which means displaying them in a catalog - - - which means having STATE that says we should be displaying - - search results. - - - so we need the results somewhere - - - also need to change the url to show results - -} - } deriving Eq - +import qualified Common.Component.Search as Search +import Common.FrontEnd.Views +import Common.FrontEnd.Model +import Common.FrontEnd.Interfaces initialActionFromRoute :: Model -> URI -> Action initialActionFromRoute model uri = either (const NoAction) id routing_result @@ -190,42 +171,7 @@ mainView model = view either (const page404) id $ runRoute (Proxy :: Proxy Route) handlers current_uri model - handlers = catalog_view :<|> thread_view :<|> search_view - - catalog_view :: Model -> View Action - catalog_view m = div_ [] - [ div_ - [ class_ "page_heading" ] - [ h1_ [] [ text "Overboard Catalog" ] - , time_ [] [ text $ pack $ show $ current_time model ] - ] - , TC.view iTime (tc_model m) - , Search.view iSearch (search_model m) - , Grid.view iGrid (grid_model model) - ] - - thread_view :: Text -> Text -> BoardThreadId -> Model -> View Action - thread_view site_name board_pathpart board_thread_id m = maybe - (h1_ [] [ text "Thread View" ]) - Thread.view - (thread_model m) - - search_view :: Maybe Text -> Model -> View Action - search_view _ m = div_ [] - [ div_ - [ class_ "page_heading" ] - [ h1_ [] [ text "Search" ] - , time_ [] [ text $ Search.searchTerm $ search_model m ] - ] - , Search.view iSearch (search_model m) - , Grid.view iGrid $ (grid_model model) - { Grid.display_items = (Search.displayResults (search_model m)) - } - ] - - page404 :: View Action - page404 = h1_ [] [ text "404 Not Found" ] - + handlers = catalogView :<|> threadView :<|> searchView mainUpdate :: Action -> Model -> Effect Action Model mainUpdate NoAction m = noEff m @@ -311,40 +257,3 @@ mainUpdate (SearchResults query) m = m { current_uri = new_current_uri } <# do { uriPath = "/search" , uriQuery = "?search=" ++ (escapeURIString isAllowedInURI $ unpack query) } - -iGrid :: Grid.Interface Action -iGrid = Grid.Interface - { Grid.passAction = GridAction - , Grid.threadSelected = mkGetThread - } - - where - mkGetThread :: CatalogPost -> Action - mkGetThread post = GetThread GetThreadArgs - { website = CatalogPost.site_name post - , board_pathpart = CatalogPost.pathpart post - , board_thread_id = CatalogPost.board_thread_id post - } - -iClient :: (FromJSON a) => (Client.HttpResult a -> Action) -> Client.Interface Action a -iClient action = Client.Interface - { Client.passAction = ClientAction action - , Client.returnResult = action - } - -iThread :: Thread.Interface Action -iThread = Thread.Interface { Thread.passAction = ThreadAction } - -iTime :: TC.Interface Action -iTime = TC.Interface - { TC.passAction = TimeAction - , TC.goTo = GoToTime - } - -iSearch :: Search.Interface Action -iSearch = - Search.Interface - { passAction = SearchAction - , clientIface = iClient $ SearchAction . Search.SearchResult - , searchResults = SearchResults - } diff --git a/src/Network/Client.hs b/src/Network/Client.hs index 659f1a3..780ae27 100644 --- a/src/Network/Client.hs +++ b/src/Network/Client.hs @@ -34,11 +34,6 @@ import Common.Network.SiteType (Site) import qualified Common.FrontEnd.Action as A import Common.Network.ClientTypes -data Interface a b = Interface - { passAction :: Action b -> a - , returnResult :: Http.HttpResult b -> a - } - update :: Interface a b -> Action b