Search WiP: hook Search into Client API, but don't call it yet

TODO.txt

@@ -1,7 +1,7 @@
-- get embeds working
+- get embeds working ✓
 - need to implement search
 - change urls / history when time-travelling
-- remove duplicate threads from view (duplicate because the OP has multiple pictures)
+- remove duplicate threads from view (duplicate because the OP has multiple pictures) ✓
 - server-side rendering
 - control to manually put in the datetime instead of using the slider
   for fine-grained control

src/Component/Search.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Component.Search
 ( view
@@ -25,26 +26,45 @@ import Miso
   , consoleLog
   , noEff
   )
-import GHCJS.DOM.Types (JSString)
+import Data.JSString (JSString, pack)
+import qualified Network.ClientTypes as Client
+import Network.CatalogPostType (CatalogPost)
+import Network.Http (HttpResult (..))
 
-data Action = SearchChange JSString | OnSubmit | NoAction
+data Action
+  = SearchChange JSString
+  | OnSubmit
+  | SearchResult (HttpResult [ CatalogPost ])
+  | NoAction
 
 data Model = Model
-  { search_term :: JSString
+  { searchTerm :: JSString
+  , clientModel :: Client.Model
   } deriving Eq
 
 data Interface a = Interface
   { passAction :: Action -> a
+  , clientIface :: Client.Interface a [ CatalogPost ]
   }
 
 
 update :: Interface a -> Action -> Model -> Effect a Model
-update iface (SearchChange q) model = model { search_term = q } <# do
+update iface (SearchChange q) model = model { searchTerm = q } <# do
   consoleLog q
   return $ (passAction iface) NoAction
 
 update iface OnSubmit model = model <# do
-  consoleLog $ "Submit!" <> search_term model
+  consoleLog $ "Submit!" <> searchTerm model
+  return $ (passAction iface) NoAction
+
+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)
+
   return $ (passAction iface) NoAction
 
 update _ NoAction m = noEff m

src/Main.hs

@@ -88,18 +88,25 @@ initialModel
     -> Model
 initialModel pgroot client_fetch_count media_root u t = Model
     { grid_model = Grid.initialModel media_root
-    , client_model = Client.Model
+    , client_model = client_model_
-        { Client.pgApiRoot = pgroot
-        , Client.fetchCount = client_fetch_count
-        }
     , thread_model = Nothing
     , current_uri = u
     , media_root_ = media_root
     , current_time = t
     , tc_model = TC.initialModel 0
-    , search_model = Search.Model { Search.search_term = "" }
+    , search_model = Search.Model
+        { Search.searchTerm = ""
+        , Search.clientModel = client_model_
+        }
     }
 
+    where
+      client_model_ = Client.Model
+        { Client.pgApiRoot = pgroot
+        , Client.fetchCount = client_fetch_count
+        }
+
+
 getMetadata :: String -> IO (Maybe JSString)
 getMetadata key = do
     doc <- currentDocument
@@ -112,6 +119,7 @@ getMetadata key = do
         Nothing -> return Nothing
         Just el -> getAttribute el ("content" :: JSString)
 
+
 main :: IO ()
 main = do
     consoleLog "Hello World!"
@@ -285,4 +293,8 @@ iTime = TC.Interface
   }
 
 iSearch :: Search.Interface Action
-iSearch = Search.Interface { passAction = SearchAction }
+iSearch =
+  Search.Interface
+    { passAction = SearchAction
+    , clientIface = iClient (SearchAction . Search.SearchResult)
+    }

src/Network/Client.hs

@@ -14,6 +14,7 @@ module Network.Client
     , getThread
     , Model (..)
     , update
+    , search
     ) where
 
 import GHC.Generics
@@ -21,7 +22,6 @@ import Control.Monad (void)
 import Control.Concurrent (forkIO)
 import Control.Concurrent.MVar (takeMVar)
 import Data.Aeson (ToJSON, FromJSON)
-import Data.Time (getCurrentTime)
 import Data.Time.Clock (UTCTime)
 
 import GHCJS.DOM.Types (JSString)
@@ -51,6 +51,10 @@ data FetchCatalogArgs = FetchCatalogArgs
   } deriving (Generic, ToJSON)
 
 
+data SearchPostsArgs = SearchPostsArgs { search_text :: JSString }
+    deriving (Generic, ToJSON)
+
+
 http_
     :: (ToJSON c, FromJSON b)
     => Model
@@ -89,3 +93,14 @@ getThread m iface A.GetThreadArgs {..} =
             <> "&boards.pathpart=eq." <> toMisoString board_pathpart
             <> "&boards.threads.board_thread_id=eq." <> toMisoString (show board_thread_id)
             <> "&boards.threads.posts.order=board_post_id.asc"
+
+
+search :: Model -> JSString -> Interface a [ CatalogPost ] -> IO a
+search m query iface =
+    http_ m iface "/rpc/search_posts" Http.POST payload
+
+    where
+        payload = Just $ SearchPostsArgs
+            { search_text = query
+            }
+

src/Network/Http.hs

@@ -73,11 +73,13 @@ mkResult xhr = do
                     Left err -> do
                       consoleLog $ toJSString $ show err
                       return Error
-                    Right x -> return HttpResponse
+                    Right x -> do
-                        { status_code = status_code_int
+                        consoleLog $ toJSString "Decoding Successful"
-                        , status_text = st
+                        return HttpResponse
-                        , body = Just x
+                            { status_code = status_code_int
-                        }
+                            , status_text = st
+                            , body = Just x
+                            }
 
 
 http