Allow using the app as a search engine (show search term in URI h…

src/Docs/Search/App.purs

@@ -41,13 +41,24 @@ main = do
     HA.runHalogenAff do
       packageIndex <- PackageIndex.loadPackageIndex
 
-      let initialSearchEngineState = { packageIndex: packageIndex, index: mempty, typeIndex: mempty }
+      let initialSearchEngineState = { packageIndex: packageIndex
+                                     , index: mempty
+                                     , typeIndex: mempty
+                                     }
+
+          resultsComponent =
+            SearchResults.mkComponent initialSearchEngineState pageContents markdownIt
 
       sfio <- runUI SearchField.component unit searchField
-      srio <- runUI (SearchResults.mkComponent initialSearchEngineState pageContents markdownIt) unit searchResults
+      srio <- runUI resultsComponent unit searchResults
+
       sfio.subscribe $
         Coroutine.consumer (srio.query <<< H.tell <<< SearchResults.MessageFromSearchField)
 
+      -- We need to read the URI hash only when both components are initialized and
+      -- the search field is subscribed to the main component.
+      sfio.query (SearchField.ReadURIHash unit)
+
 insertStyle :: Document.Document -> Effect Unit
 insertStyle doc = do
   let styleContents = """

src/Docs/Search/App/SearchField.purs

@@ -7,6 +7,7 @@ import Prelude
 import CSS (border, borderRadius, color, em, float, floatLeft, fontWeight, lineHeight, marginBottom, marginLeft, paddingBottom, paddingLeft, paddingRight, paddingTop, pct, px, rgb, solid, weight, width)
 import Data.Maybe (Maybe(..), maybe)
 import Data.Newtype (wrap)
+import Docs.Search.URIHash as URIHash
 import Effect (Effect)
 import Effect.Aff (Aff)
 import Halogen as H
@@ -38,28 +39,45 @@ data Action
   | InitKeyboardListener
   | HandleKey H.SubscriptionId KeyboardEvent
 
+data Query a
+  = ReadURIHash a
+
 data SearchFieldMessage
   = InputUpdated String
   | InputCleared
   | Focused
   | LostFocus
 
-component :: forall q i. H.Component HH.HTML q i SearchFieldMessage Aff
+component :: forall i. H.Component HH.HTML Query i SearchFieldMessage Aff
 component =
   H.mkComponent
     { initialState
     , render
     , eval: H.mkEval $ H.defaultEval { handleAction = handleAction
+                                     , handleQuery = handleQuery
                                      , initialize = Just InitKeyboardListener }
     }
 
+handleQuery
+  :: forall a
+  .  Query a
+  -> H.HalogenM State Action () SearchFieldMessage Aff (Maybe a)
+handleQuery (ReadURIHash next) = do
+  state <- H.get
+  H.raise (InputUpdated state.input)
+  pure Nothing
+
 initialState :: forall i. i -> State
 initialState _ = { input: "", focused: false }
 
 handleAction :: Action -> H.HalogenM State Action () SearchFieldMessage Aff Unit
 handleAction = case _ of
 
   InitKeyboardListener -> do
+
+    input <- H.liftEffect URIHash.getInput
+    H.modify_ (_ { input = input })
+
     document <- H.liftEffect $ Web.document =<< Web.window
     H.subscribe' \sid ->
       ES.eventListenerEventSource
@@ -82,9 +100,7 @@ handleAction = case _ of
       then do
         H.liftEffect do
           withSearchField (HTMLInputElement.toHTMLElement >>> Web.blur)
-      else do
-        H.modify_ (_ { input = "" })
-        H.raise $ InputCleared
+      else clearInput
 
   InputAction input -> do
     H.modify_ $ (_ { input = input })
@@ -93,6 +109,7 @@ handleAction = case _ of
     state <- H.get
     H.liftEffect do
       withSearchField (HTMLInputElement.toHTMLElement >>> Web.blur)
+    H.liftEffect (URIHash.setInput state.input)
     H.raise $ InputUpdated state.input
 
   FocusChanged status -> do
@@ -102,6 +119,12 @@ handleAction = case _ of
       then Focused
       else LostFocus
 
+clearInput :: H.HalogenM State Action () SearchFieldMessage Aff Unit
+clearInput = do
+  H.modify_ (_ { input = "" })
+  H.liftEffect URIHash.removeHash
+  H.raise InputCleared
+
 withSearchField :: (HTML.HTMLInputElement -> Effect Unit) -> Effect Unit
 withSearchField cont = do
   doc <- Document.toParentNode <$>

src/Docs/Search/URIHash.js

@@ -0,0 +1,17 @@
+/* global exports history */
+
+// https://stackoverflow.com/questions/1397329
+exports.removeHash = function () {
+    var scrollV, scrollH, loc = window.location;
+    if ("pushState" in history)
+        history.pushState("", document.title, loc.pathname + loc.search);
+    else {
+        scrollV = document.body.scrollTop;
+        scrollH = document.body.scrollLeft;
+
+        loc.hash = "";
+
+        document.body.scrollTop = scrollV;
+        document.body.scrollLeft = scrollH;
+    }
+}

src/Docs/Search/URIHash.purs

@@ -0,0 +1,38 @@
+module Docs.Search.URIHash
+       ( getInput
+       , setInput
+       , removeHash
+       )
+where
+
+import Prelude
+
+import Data.Maybe (Maybe(Just), fromMaybe)
+import Data.String.CodeUnits as String
+import Effect (Effect)
+import Global (decodeURIComponent, encodeURIComponent)
+import Web.HTML as HTML
+import Web.HTML.Location as Location
+import Web.HTML.Window as Window
+
+foreign import removeHash :: Effect Unit
+
+setInput :: String -> Effect Unit
+setInput "" = removeHash
+setInput input = do
+  window <- HTML.window
+  location <- Window.location window
+  let hash = "search:" <> fromMaybe "" (encodeURIComponent input)
+  Location.setHash hash location
+
+getInput :: Effect String
+getInput = do
+  window <- HTML.window
+  location <- Window.location window
+  hash <- Location.hash location
+  pure $
+    if String.slice 0 8 hash == Just "#search:"
+    then fromMaybe "" $
+         decodeURIComponent $
+         String.drop 8 hash
+    else ""