Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 6 additions & 0 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -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.
2 changes: 1 addition & 1 deletion packages.dhall
Original file line number Diff line number Diff line change
Expand Up @@ -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" ]
Expand Down
72 changes: 60 additions & 12 deletions src/Docs/Search/App/SearchField.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down