From 2ef589d4c3075bad901dc1df44b37f8cc80c250b Mon Sep 17 00:00:00 2001
From: klntsky <klntsky@gmail.com>
Date: Mon, 15 Jul 2019 23:01:44 +0300
Subject: [PATCH] added: "S" hotkey to focus on search field

---
 README.md                            |  6 +++
 packages.dhall                       |  2 +-
 src/Docs/Search/App/SearchField.purs | 72 +++++++++++++++++++++++-----
 3 files changed, 67 insertions(+), 13 deletions(-)

diff --git a/README.md b/README.md
index d88f89f..226d2de 100644
--- a/README.md
+++ b/README.md
@@ -14,3 +14,9 @@ spago docs
 spago bundle-app -m Docs.Search.App --to generated-docs/docs-search-app.js
 spago run -m Docs.Search.IndexBuilder
 ```
+
+## UI
+
+The user interface of the app is optimised for keyboard-only use.
+
+**S** hotkey can be used to focus on the search field, **Escape** can be used to leave it. Pressing **Escape** twice will close the search results listing.
diff --git a/packages.dhall b/packages.dhall
index 9ec0cd2..c5188a1 100644
--- a/packages.dhall
+++ b/packages.dhall
@@ -41,7 +41,7 @@ let additions =
 		  , "web-uievents"
 		  ]
 		  "https://github.com/slamdata/purescript-halogen.git"
-		  "v5.0.0-rc.4"
+		  "v5.0.0-rc.5"
 	  , halogen-css =
 		  mkPackage
 		  [ "css", "halogen" ]
diff --git a/src/Docs/Search/App/SearchField.purs b/src/Docs/Search/App/SearchField.purs
index 31beb1c..5bb13c9 100644
--- a/src/Docs/Search/App/SearchField.purs
+++ b/src/Docs/Search/App/SearchField.purs
@@ -2,23 +2,38 @@ module Docs.Search.App.SearchField where
 
 import Prelude
 
-import CSS hiding (render, map)
-import Data.Maybe (Maybe(..))
+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 Effect (Effect)
 import Effect.Aff (Aff)
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.CSS as HS
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
+import Halogen.Query.EventSource as ES
+import Web.DOM.Document as Document
+import Web.DOM.ParentNode as ParentNode
+import Web.HTML (window) as Web
+import Web.HTML as HTML
+import Web.HTML.HTMLDocument as HTMLDocument
+import Web.HTML.HTMLElement (blur, focus, fromElement) as Web
+import Web.HTML.Window (document) as Web
+import Web.HTML.Window as Window
+import Web.UIEvent.KeyboardEvent (KeyboardEvent)
+import Web.UIEvent.KeyboardEvent as KE
 import Web.UIEvent.KeyboardEvent as KeyboardEvent
+import Web.UIEvent.KeyboardEvent.EventTypes as KET
 
-type State = { input :: String }
+type State = { input :: String, focused :: Boolean }
 
 data Action
   = InputAction String
   | EnterPressed
-  | EscapePressed
   | FocusChanged Boolean
+  | InitKeyboardListener
+  | HandleKey H.SubscriptionId KeyboardEvent
 
 data SearchFieldMessage
   = InputUpdated String
@@ -31,28 +46,61 @@ component =
   H.mkComponent
     { initialState
     , render
-    , eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
+    , eval: H.mkEval $ H.defaultEval { handleAction = handleAction
+                                     , initialize = Just InitKeyboardListener }
     }
 
 initialState :: forall i. i -> State
-initialState _ = { input: "" }
+initialState _ = { input: "", focused: false }
 
-handleAction :: forall m. Action -> H.HalogenM State Action () SearchFieldMessage m Unit
+handleAction :: Action -> H.HalogenM State Action () SearchFieldMessage Aff Unit
 handleAction = case _ of
+
+  InitKeyboardListener -> do
+    document <- H.liftEffect $ Web.document =<< Web.window
+    H.subscribe' \sid ->
+      ES.eventListenerEventSource
+        KET.keyup
+        (HTMLDocument.toEventTarget document)
+        (map (HandleKey sid) <<< KE.fromEvent)
+
+  HandleKey sid ev -> do
+    when (KE.code ev == "KeyS") do
+      H.liftEffect $ withSearchField Web.focus
+    when (KE.code ev == "Escape") do
+      state <- H.get
+      if state.focused
+      then H.liftEffect $ withSearchField Web.blur
+      else do
+        H.modify_ (_ { input = "" })
+        H.raise $ InputCleared
+
   InputAction input -> do
-    H.modify_ $ const { input }
+    H.modify_ $ (_ { input = input })
+
   EnterPressed -> do
     state <- H.get
+    H.liftEffect $ withSearchField Web.blur
     H.raise $ InputUpdated state.input
-  EscapePressed -> do
-    H.modify_ (_ { input = "" })
-    H.raise $ InputCleared
+
   FocusChanged status -> do
+    H.modify_ (_ { focused = status })
     H.raise
       if status
       then Focused
       else LostFocus
 
+withSearchField :: (HTML.HTMLElement -> Effect Unit) -> Effect Unit
+withSearchField cont = do
+  doc <- Document.toParentNode <$>
+         HTMLDocument.toDocument <$>
+         (Window.document =<< HTML.window)
+
+  let selector = wrap "#docs-search-query-field"
+
+  mbEl <- ParentNode.querySelector selector doc
+  maybe mempty cont (mbEl >>= Web.fromElement)
+
 render :: forall m. State -> H.ComponentHTML Action () m
 render state =
   HH.div
@@ -68,11 +116,11 @@ render state =
   [ HH.input
     [ HP.value state.input
     , HP.placeholder "Search for definitions"
+    , HP.id_ "docs-search-query-field"
     , HP.type_ HP.InputText
     , HE.onKeyUp (\event ->
                    case KeyboardEvent.code event of
                      "Enter"  -> Just EnterPressed
-                     "Escape" -> Just EscapePressed
                      _        -> Nothing)
     , HE.onValueInput (Just <<< InputAction)
     , HE.onFocusIn  $ const $ Just $ FocusChanged true