@@ -2,23 +2,38 @@ module Docs.Search.App.SearchField where
22
33import Prelude
44
5−import CSS hiding (render, map)
6−import Data.Maybe (Maybe(..))
5+import CSS (border, borderRadius, color, em, float, floatLeft, fontWeight, lineHeight, marginBottom, marginLeft, paddingBottom, paddingLeft, paddingRight, paddingTop, pct, px, rgb, solid, weight, width)
6+import Data.Maybe (Maybe(..), maybe)
7+import Data.Newtype (wrap)
8+import Effect (Effect)
79import Effect.Aff (Aff)
810import Halogen as H
911import Halogen.HTML as HH
1012import Halogen.HTML.CSS as HS
1113import Halogen.HTML.Events as HE
1214import Halogen.HTML.Properties as HP
15+import Halogen.Query.EventSource as ES
16+import Web.DOM.Document as Document
17+import Web.DOM.ParentNode as ParentNode
18+import Web.HTML (window) as Web
19+import Web.HTML as HTML
20+import Web.HTML.HTMLDocument as HTMLDocument
21+import Web.HTML.HTMLElement (blur, focus, fromElement) as Web
22+import Web.HTML.Window (document) as Web
23+import Web.HTML.Window as Window
24+import Web.UIEvent.KeyboardEvent (KeyboardEvent)
25+import Web.UIEvent.KeyboardEvent as KE
1326import Web.UIEvent.KeyboardEvent as KeyboardEvent
27+import Web.UIEvent.KeyboardEvent.EventTypes as KET
1428
15−type State = { input :: String }
29+type State = { input :: String, focused :: Boolean }
1630
1731data Action
1832 = InputAction String
1933 | EnterPressed
20− | EscapePressed
2134 | FocusChanged Boolean
35+ | InitKeyboardListener
36+ | HandleKey H.SubscriptionId KeyboardEvent
2237
2338data SearchFieldMessage
2439 = InputUpdated String
@@ -31,28 +46,61 @@ component =
3146 H.mkComponent
3247 { initialState
3348 , render
34− , eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
49+ , eval: H.mkEval $ H.defaultEval { handleAction = handleAction
50+ , initialize = Just InitKeyboardListener }
3551 }
3652
3753initialState :: forall i. i -> State
38−initialState _ = { input: "" }
54+initialState _ = { input: "", focused: false }
3955
40−handleAction :: forall m. Action -> H.HalogenM State Action () SearchFieldMessage m Unit
56+handleAction :: Action -> H.HalogenM State Action () SearchFieldMessage Aff Unit
4157handleAction = case _ of
58+
59+ InitKeyboardListener -> do
60+ document <- H.liftEffect $ Web.document =<< Web.window
61+ H.subscribe' \sid ->
62+ ES.eventListenerEventSource
63+ KET.keyup
64+ (HTMLDocument.toEventTarget document)
65+ (map (HandleKey sid) <<< KE.fromEvent)
66+
67+ HandleKey sid ev -> do
68+ when (KE.code ev == "KeyS") do
69+ H.liftEffect $ withSearchField Web.focus
70+ when (KE.code ev == "Escape") do
71+ state <- H.get
72+ if state.focused
73+ then H.liftEffect $ withSearchField Web.blur
74+ else do
75+ H.modify_ (_ { input = "" })
76+ H.raise $ InputCleared
77+
4278 InputAction input -> do
43− H.modify_ $ const { input }
79+ H.modify_ $ (_ { input = input })
80+
4481 EnterPressed -> do
4582 state <- H.get
83+ H.liftEffect $ withSearchField Web.blur
4684 H.raise $ InputUpdated state.input
47− EscapePressed -> do
48− H.modify_ (_ { input = "" })
49− H.raise $ InputCleared
85+
5086 FocusChanged status -> do
87+ H.modify_ (_ { focused = status })
5188 H.raise
5289 if status
5390 then Focused
5491 else LostFocus
5592
93+withSearchField :: (HTML.HTMLElement -> Effect Unit) -> Effect Unit
94+withSearchField cont = do
95+ doc <- Document.toParentNode <$>
96+ HTMLDocument.toDocument <$>
97+ (Window.document =<< HTML.window)
98+
99+ let selector = wrap "#docs-search-query-field"
100+
101+ mbEl <- ParentNode.querySelector selector doc
102+ maybe mempty cont (mbEl >>= Web.fromElement)
103+
56104render :: forall m. State -> H.ComponentHTML Action () m
57105render state =
58106 HH.div
@@ -68,11 +116,11 @@ render state =
68116 [ HH.input
69117 [ HP.value state.input
70118 , HP.placeholder "Search for definitions"
119+ , HP.id_ "docs-search-query-field"
71120 , HP.type_ HP.InputText
72121 , HE.onKeyUp (\event ->
73122 case KeyboardEvent.code event of
74123 "Enter" -> Just EnterPressed
75− "Escape" -> Just EscapePressed
76124 _ -> Nothing)
77125 , HE.onValueInput (Just <<< InputAction)
78126 , HE.onFocusIn $ const $ Just $ FocusChanged true