diff --git a/src/Action.hs b/src/Action.hs index 36b9d81..4feac96 100644 --- a/src/Action.hs +++ b/src/Action.hs @@ -34,4 +34,5 @@ data Action | SearchAction Search.Action | GoToTime UTCTime | ChangeURI URI + | SearchResults [ CatalogPost ] | NoAction diff --git a/src/Component/Search.hs b/src/Component/Search.hs index 224ac8e..f75f9cb 100644 --- a/src/Component/Search.hs +++ b/src/Component/Search.hs @@ -33,22 +33,28 @@ import Component.Search.SearchTypes update :: Interface a -> Action -> Model -> Effect a Model update iface (SearchChange q) model = model { searchTerm = q } <# do - consoleLog q - return $ (passAction iface) NoAction + consoleLog q + return $ (passAction iface) NoAction update iface OnSubmit model = model <# do - consoleLog $ "Submit! " <> searchTerm model - Client.search (clientModel model) (searchTerm model) (clientIface iface) + consoleLog $ "Submit! " <> searchTerm model + Client.search (clientModel model) (searchTerm model) (clientIface iface) update iface (SearchResult result) model = model <# do - consoleLog $ "Search result" - case result of - Error -> consoleLog $ "Error!" - HttpResponse {..} -> do - consoleLog $ (pack $ show $ status_code) <> " " <> (pack $ status_text) - consoleLog $ (pack $ show $ body) + consoleLog $ "Received search results!" - return $ (passAction iface) NoAction + case result of + Error -> do + consoleLog $ "Error!" + return $ (passAction iface) NoAction + + HttpResponse {..} -> do + consoleLog $ (pack $ show $ status_code) <> " " <> (pack $ status_text) + consoleLog $ (pack $ show $ body) + + case body of + Just b -> return $ (searchResults iface) b + Nothing -> return $ (searchResults iface) [] update _ NoAction m = noEff m diff --git a/src/Component/Search/SearchTypes.hs b/src/Component/Search/SearchTypes.hs index adf342f..5ea6000 100644 --- a/src/Component/Search/SearchTypes.hs +++ b/src/Component/Search/SearchTypes.hs @@ -7,19 +7,19 @@ import qualified Network.ClientTypes as Client import Network.CatalogPostType (CatalogPost) data Action - = SearchChange JSString - | OnSubmit - | SearchResult (HttpResult [ CatalogPost ]) - | NoAction + = SearchChange JSString + | OnSubmit + | SearchResult (HttpResult [ CatalogPost ]) + | DisplayResults [ CatalogPost ] + | NoAction data Model = Model - { searchTerm :: JSString - , clientModel :: Client.Model - } deriving Eq + { searchTerm :: JSString + , clientModel :: Client.Model + } deriving Eq data Interface a = Interface - { passAction :: Action -> a - , clientIface :: Client.Interface a [ CatalogPost ] - } - - + { passAction :: Action -> a + , clientIface :: Client.Interface a [ CatalogPost ] + , searchResults :: [ CatalogPost ] -> a + } diff --git a/src/Main.hs b/src/Main.hs index f18fd8d..e5f4757 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -62,6 +62,15 @@ data Model = Model , 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 @@ -221,8 +230,6 @@ mainUpdate (HaveThread (Client.HttpResponse {..})) m = new_model <# do mainUpdate (GoToTime t) m = m { current_time = t } <# do Client.fetchLatest (client_model m) t (iClient HaveLatest) --- mainUpdate GetThread {..} m = noEff m - mainUpdate (GetThread GetThreadArgs {..}) m = m <# do consoleLog $ "Thread " `append` (pack $ show $ board_thread_id) pushURI new_current_uri @@ -263,6 +270,8 @@ mainUpdate (SearchAction sa) m = Search.update iSearch sa (search_model m) >>= \sm -> noEff m { search_model = sm } +-- mainUpdate (SearchResults result_posts) m = -- TODO + iGrid :: Grid.Interface Action iGrid = Grid.Interface { Grid.passAction = GridAction @@ -297,4 +306,5 @@ iSearch = Search.Interface { passAction = SearchAction , clientIface = iClient (SearchAction . Search.SearchResult) + , searchResults = SearchResults }