From b5f086372eb8eeaafce5ce2faaaa681f7f6e11ec Mon Sep 17 00:00:00 2001
From: towards-a-new-leftypol <paul_cockshott@protonmail.com>
Date: Sun, 24 Mar 2024 21:46:28 -0400
Subject: [PATCH] re-add Search component back

---
 chandlr.cabal           |  6 ++--
 src/Common              |  2 +-
 src/Component/Search.hs | 66 +++++++++++++++++++++++++++++++++++++++++
 src/Main.hs             |  5 ++--
 4 files changed, 74 insertions(+), 5 deletions(-)
 create mode 100644 src/Component/Search.hs

diff --git a/chandlr.cabal b/chandlr.cabal
index a28da58..8f320d6 100644
--- a/chandlr.cabal
+++ b/chandlr.cabal
@@ -62,7 +62,8 @@ executable chandlr
     ghcjs-options:    -dedupe
 
     -- Modules included in this executable, other than Main.
-    other-modules:    Common.Component.CatalogGrid
+    other-modules:    
+                      Common.Component.CatalogGrid
                       Common.FrontEnd.Action
                       Network.Http
                       Common.Network.HttpTypes
@@ -87,8 +88,9 @@ executable chandlr
                       Common.Parsing.EmbedParser
                       Common.Parsing.PostPartType
                       Common.Component.TimeControl
-                      Common.Component.Search
+                      Component.Search
                       Common.Component.Search.SearchTypes
+                      Common.Component.Search.View
 
 
     -- LANGUAGE extensions used by modules in this package.
diff --git a/src/Common b/src/Common
index cff3dd9..172323f 160000
--- a/src/Common
+++ b/src/Common
@@ -1 +1 @@
-Subproject commit cff3dd9e9fd013a0eedaa17df52e8f9eb5ef73c6
+Subproject commit 172323f730e86c776c5ecd8091149b4c7244e363
diff --git a/src/Component/Search.hs b/src/Component/Search.hs
new file mode 100644
index 0000000..661fcf1
--- /dev/null
+++ b/src/Component/Search.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Component.Search
+( view
+, Interface (..)
+, update
+, Model (..)
+, Action (..)
+) where
+
+import Miso
+  ( Effect
+  , (<#)
+  , consoleLog
+  , noEff
+  )
+import Miso.String (toMisoString)
+
+import Control.Concurrent.MVar (tryTakeMVar, takeMVar, putMVar, swapMVar)
+
+import Common.Network.HttpTypes (HttpResult (..))
+import Common.Component.Search.SearchTypes
+import Common.Component.Search.View
+import qualified Network.Client as Client
+
+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 $ (toMisoString $ show $ status_code) <> " " <> (toMisoString $ status_text)
+            consoleLog $ (toMisoString $ 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
diff --git a/src/Main.hs b/src/Main.hs
index e044d42..bf58c4d 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -43,10 +43,12 @@ import qualified Network.Client as Client
 import qualified Common.Component.CatalogGrid as Grid
 import qualified Common.Component.ThreadView as Thread
 import qualified Common.Component.TimeControl as TC
-import qualified Common.Component.Search as Search
+import qualified Common.Component.Search.SearchTypes as Search
+import qualified Component.Search as Search
 import Common.FrontEnd.Views
 import Common.FrontEnd.Model
 import Common.FrontEnd.Interfaces
+import qualified Common.Network.ClientTypes as Client
 
 initialActionFromRoute :: Model -> URI -> Action
 initialActionFromRoute model uri = either (const NoAction) id routing_result
@@ -155,7 +157,6 @@ main = do
         , logLevel      = Off
         }
 
-
 mainView :: Model -> View Action
 mainView model = view
     where