Move Search, Interfaces, and top-level Views into Common sub-repo

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
 
 

src/Common

@@ -1 +1 @@
-Subproject commit 7d521a921990b5a05d98782babc85cc6ee54eb0c
+Subproject commit 491616d096e0ded61bd341487f2487d9082d9b5c

src/Component/Search.hs

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

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

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