diff --git a/src/Component/Search.hs b/src/Component/Search.hs index 9db06dd..ab1575f 100644 --- a/src/Component/Search.hs +++ b/src/Component/Search.hs @@ -37,9 +37,9 @@ update iface (SearchChange q) model = model { searchTerm = q } <# do consoleLog q return $ (passAction iface) NoAction -update iface OnSubmit model = model <# do - consoleLog $ "Submit! " <> searchTerm model - Client.search (clientModel model) (searchTerm model) (clientIface iface) +update iface (OnSubmit search_query) model = model { searchTerm = search_query } <# do + consoleLog $ "Submit! " <> search_query + Client.search (clientModel model) search_query (clientIface iface) update iface (SearchResult result) model = model <# do consoleLog $ "Received search results!" @@ -62,12 +62,12 @@ update iface (PassPostsToSelf search_results) model = model { displayResults = s update _ NoAction m = noEff m -view :: Interface a -> View a -view iface = form_ +view :: Interface a -> Model -> View a +view iface m = form_ [ class_ "search_form" , action_ "/search" , method_ "GET" - , onSubmit $ pass OnSubmit + , onSubmit $ pass $ OnSubmit $ searchTerm m ] [ input_ [ type_ "submit" diff --git a/src/Component/Search/SearchTypes.hs b/src/Component/Search/SearchTypes.hs index ace529e..6b6836f 100644 --- a/src/Component/Search/SearchTypes.hs +++ b/src/Component/Search/SearchTypes.hs @@ -8,7 +8,7 @@ import Network.CatalogPostType (CatalogPost) data Action = SearchChange JSString - | OnSubmit + | OnSubmit JSString | SearchResult (HttpResult [ CatalogPost ]) | PassPostsToSelf [ CatalogPost ] -- I think I don't understand something about the update type but I had to add this... | NoAction diff --git a/src/Main.hs b/src/Main.hs index 11af913..af5f3ce 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -9,7 +9,7 @@ import Data.Proxy import Data.Maybe (maybe, fromJust) import Data.Text (Text) import qualified Data.Text as T -import Network.URI (uriPath, uriQuery, escapeURIString, isAllowedInURI) +import Network.URI (uriPath, uriQuery, escapeURIString, unEscapeString, isAllowedInURI) import System.FilePath (()) import Data.Time.Clock (UTCTime, getCurrentTime) @@ -51,6 +51,7 @@ import qualified Component.CatalogGrid as Grid import qualified Component.ThreadView as Thread import qualified Component.TimeControl as TC import qualified Component.Search as Search +import qualified Component.Search.SearchTypes as Search data Model = Model @@ -79,7 +80,7 @@ initialActionFromRoute model uri = either (const NoAction) id routing_result where routing_result = runRoute (Proxy :: Proxy Route) handlers (const uri) model - handlers = h_latest :<|> h_thread + handlers = h_latest :<|> h_thread :<|> h_search h_latest :: Model -> Action h_latest = const $ GoToTime $ current_time model @@ -87,6 +88,15 @@ initialActionFromRoute model uri = either (const NoAction) id routing_result h_thread :: Text -> Text -> BoardThreadId -> Model -> Action h_thread website board_pathpart board_thread_id _ = GetThread GetThreadArgs {..} + h_search :: Maybe Text -> Model -> Action + h_search Nothing model = GoToTime $ current_time model + h_search (Just search_query) model + | Search.searchTerm (search_model model) == unescaped_search_query = SearchResults unescaped_search_query + | otherwise = (Search.passAction iSearch) $ Search.OnSubmit $ toJSString $ T.unpack search_query + + where + unescaped_search_query = toJSString $ unEscapeString $ T.unpack search_query + initialModel :: JSString @@ -175,7 +185,7 @@ mainView model = view either (const page404) id $ runRoute (Proxy :: Proxy Route) handlers current_uri model - handlers = catalog_view :<|> thread_view + handlers = catalog_view :<|> thread_view :<|> search_view catalog_view :: Model -> View Action catalog_view m = div_ [] @@ -185,7 +195,7 @@ mainView model = view , time_ [] [ text $ pack $ show $ current_time model ] ] , TC.view iTime (tc_model m) - , Search.view iSearch + , Search.view iSearch (search_model m) , Grid.view iGrid (grid_model model) ] @@ -195,6 +205,9 @@ mainView model = view Thread.view (thread_model m) + search_view :: Maybe Text -> Model -> View Action + search_view _ _ = div_ [] [ text "Search results" ] + page404 :: View Action page404 = h1_ [] [ text "404 Not Found" ] diff --git a/src/Routes.hs b/src/Routes.hs index a5f2418..996cdda 100644 --- a/src/Routes.hs +++ b/src/Routes.hs @@ -15,6 +15,7 @@ import Action type Route = R_Latest :<|> R_Thread + :<|> R_SearchResults type R_Latest = View Action @@ -26,4 +27,9 @@ type R_Thread :> Capture "board_thread_id" BoardThreadId :> View Action +type R_SearchResults + = "search" + :> QueryParam "search" Text + :> View Action + type BoardThreadId = Int64