Add search

src/JS.hs

@@ -34,6 +34,8 @@ allJSFunctions = JS . T.unlines . map fromJS $ [
   -- Utilities
   replaceWithData, appendData,
   moveNodeUp, moveNodeDown,
+  -- Search
+  search,
   -- Add methods
   addLibrary, addCategory,
   addPro, addCon,
@@ -147,6 +149,16 @@ moveNodeDown =
       el.next().after(el);
   |]
 
+search :: JSFunction a => a
+search =
+  makeJSFunction "search" ["node", "s"]
+  -- TODO: set address bar to “/?query=...” so that the user would be able to
+  -- see/share the search URL
+  [text|
+    $.post("/search", {query: s})
+     .done(replaceWithData(node));
+  |]
+
 -- | Create a new category.
 addCategory :: JSFunction a => a
 addCategory =

src/Main.hs

@@ -3,6 +3,7 @@ OverloadedStrings,
 TemplateHaskell,
 RankNTypes,
 FlexibleInstances,
+FlexibleContexts,
 QuasiQuotes,
 ScopedTypeVariables,
 FunctionalDependencies,
@@ -263,6 +264,21 @@ addMethods = Spock.subcomponent "add" $ do
 
 otherMethods :: SpockM () () (IORef GlobalState) ()
 otherMethods = do
+  -- Search
+  Spock.post "search" $ do
+    query <- param' "query"
+    let queryWords = T.words query
+    let rank :: Category -> Int
+        rank cat = sum [
+          length (queryWords `intersect` (cat^..items.each.name)),
+          length (queryWords `intersect` T.words (cat^.title)) ]
+    cats <- withGlobal (use categories)
+    let rankedCats
+          | null queryWords = cats
+          | otherwise       = filter ((/= 0) . rank) .
+                              reverse . sortOn rank $ cats
+    lucid $ renderCategoryList rankedCats
+
   -- Moving things
   Spock.subcomponent "move" $ do
     -- Move trait
@@ -323,11 +339,18 @@ renderRoot globalState = do
     write anything here. Also, Markdown is supported, so use
     bold/italics/code if you need to.
     |]
-  categoriesNode <- div_ [id_ "categories"] $ do
+  let searchHandler s = JS.search ("#categories" :: Text, s)
-    mapM_ renderCategory (globalState ^. categories)
+  input_ [type_ "text", placeholder_ "search",
-    thisNode
+          onInputSubmit searchHandler]
-  let handler s = JS.addCategory (categoriesNode, s)
+  renderCategoryList (globalState^.categories)
-  input_ [type_ "text", placeholder_ "new category", onInputSubmit handler]
+  let addCategoryHandler s = JS.addCategory ("#categories" :: Text, s)
+  input_ [type_ "text", placeholder_ "new category",
+          onInputSubmit addCategoryHandler]
+
+renderCategoryList :: [Category] -> HtmlT IO ()
+renderCategoryList cats =
+  div_ [id_ "categories"] $
+    mapM_ renderCategory cats
 
 renderCategoryTitle :: Editable -> Category -> HtmlT IO ()
 renderCategoryTitle editable category =