git.iko.soy/rowtype-yoga/purescript-docs-search
on master help sign in
Allow using the app as a search engine (show search term in URI h… (#26)
11426cdVladimir Kalnitsky
src/Docs/Search/App.purs+13−2
compare with master
unifiedsplit
@@ -41,13 +41,24 @@ main = do
41 HA.runHalogenAff do
41 HA.runHalogenAff do
42 packageIndex <- PackageIndex.loadPackageIndex
42 packageIndex <- PackageIndex.loadPackageIndex
43
43
44− let initialSearchEngineState = { packageIndex: packageIndex, index: mempty, typeIndex: mempty }
44+ let initialSearchEngineState = { packageIndex: packageIndex
45+ , index: mempty
46+ , typeIndex: mempty
47+ }
48+
49+ resultsComponent =
50+ SearchResults.mkComponent initialSearchEngineState pageContents markdownIt
45
51
46 sfio <- runUI SearchField.component unit searchField
52 sfio <- runUI SearchField.component unit searchField
47− srio <- runUI (SearchResults.mkComponent initialSearchEngineState pageContents markdownIt) unit searchResults
53+ srio <- runUI resultsComponent unit searchResults
54+
48 sfio.subscribe $
55 sfio.subscribe $
49 Coroutine.consumer (srio.query <<< H.tell <<< SearchResults.MessageFromSearchField)
56 Coroutine.consumer (srio.query <<< H.tell <<< SearchResults.MessageFromSearchField)
50
57
58+ -- We need to read the URI hash only when both components are initialized and
59+ -- the search field is subscribed to the main component.
60+ sfio.query (SearchField.ReadURIHash unit)
61+
51insertStyle :: Document.Document -> Effect Unit
62insertStyle :: Document.Document -> Effect Unit
52insertStyle doc = do
63insertStyle doc = do
53 let styleContents = """
64 let styleContents = """
src/Docs/Search/App/SearchField.purs+27−4
@@ -7,6 +7,7 @@ import Prelude
7import CSS (border, borderRadius, color, em, float, floatLeft, fontWeight, lineHeight, marginBottom, marginLeft, paddingBottom, paddingLeft, paddingRight, paddingTop, pct, px, rgb, solid, weight, width)
7import CSS (border, borderRadius, color, em, float, floatLeft, fontWeight, lineHeight, marginBottom, marginLeft, paddingBottom, paddingLeft, paddingRight, paddingTop, pct, px, rgb, solid, weight, width)
8import Data.Maybe (Maybe(..), maybe)
8import Data.Maybe (Maybe(..), maybe)
9import Data.Newtype (wrap)
9import Data.Newtype (wrap)
10+import Docs.Search.URIHash as URIHash
10import Effect (Effect)
11import Effect (Effect)
11import Effect.Aff (Aff)
12import Effect.Aff (Aff)
12import Halogen as H
13import Halogen as H
@@ -38,21 +39,34 @@ data Action
38 | InitKeyboardListener
39 | InitKeyboardListener
39 | HandleKey H.SubscriptionId KeyboardEvent
40 | HandleKey H.SubscriptionId KeyboardEvent
40
41
42+data Query a
43+ = ReadURIHash a
44+
41data SearchFieldMessage
45data SearchFieldMessage
42 = InputUpdated String
46 = InputUpdated String
43 | InputCleared
47 | InputCleared
44 | Focused
48 | Focused
45 | LostFocus
49 | LostFocus
46
50
47−component :: forall q i. H.Component HH.HTML q i SearchFieldMessage Aff
51+component :: forall i. H.Component HH.HTML Query i SearchFieldMessage Aff
48component =
52component =
49 H.mkComponent
53 H.mkComponent
50 { initialState
54 { initialState
51 , render
55 , render
52 , eval: H.mkEval $ H.defaultEval { handleAction = handleAction
56 , eval: H.mkEval $ H.defaultEval { handleAction = handleAction
57+ , handleQuery = handleQuery
53 , initialize = Just InitKeyboardListener }
58 , initialize = Just InitKeyboardListener }
54 }
59 }
55
60
61+handleQuery
62+ :: forall a
63+ . Query a
64+ -> H.HalogenM State Action () SearchFieldMessage Aff (Maybe a)
65+handleQuery (ReadURIHash next) = do
66+ state <- H.get
67+ H.raise (InputUpdated state.input)
68+ pure Nothing
69+
56initialState :: forall i. i -> State
70initialState :: forall i. i -> State
57initialState _ = { input: "", focused: false }
71initialState _ = { input: "", focused: false }
58
72
@@ -60,6 +74,10 @@ handleAction :: Action -> H.HalogenM State Action () SearchFieldMessage Aff Unit
60handleAction = case _ of
74handleAction = case _ of
61
75
62 InitKeyboardListener -> do
76 InitKeyboardListener -> do
77+
78+ input <- H.liftEffect URIHash.getInput
79+ H.modify_ (_ { input = input })
80+
63 document <- H.liftEffect $ Web.document =<< Web.window
81 document <- H.liftEffect $ Web.document =<< Web.window
64 H.subscribe' \sid ->
82 H.subscribe' \sid ->
65 ES.eventListenerEventSource
83 ES.eventListenerEventSource
@@ -82,9 +100,7 @@ handleAction = case _ of
82 then do
100 then do
83 H.liftEffect do
101 H.liftEffect do
84 withSearchField (HTMLInputElement.toHTMLElement >>> Web.blur)
102 withSearchField (HTMLInputElement.toHTMLElement >>> Web.blur)
85− else do
103+ else clearInput
86− H.modify_ (_ { input = "" })
87− H.raise $ InputCleared
88
104
89 InputAction input -> do
105 InputAction input -> do
90 H.modify_ $ (_ { input = input })
106 H.modify_ $ (_ { input = input })
@@ -93,6 +109,7 @@ handleAction = case _ of
93 state <- H.get
109 state <- H.get
94 H.liftEffect do
110 H.liftEffect do
95 withSearchField (HTMLInputElement.toHTMLElement >>> Web.blur)
111 withSearchField (HTMLInputElement.toHTMLElement >>> Web.blur)
112+ H.liftEffect (URIHash.setInput state.input)
96 H.raise $ InputUpdated state.input
113 H.raise $ InputUpdated state.input
97
114
98 FocusChanged status -> do
115 FocusChanged status -> do
@@ -102,6 +119,12 @@ handleAction = case _ of
102 then Focused
119 then Focused
103 else LostFocus
120 else LostFocus
104
121
122+clearInput :: H.HalogenM State Action () SearchFieldMessage Aff Unit
123+clearInput = do
124+ H.modify_ (_ { input = "" })
125+ H.liftEffect URIHash.removeHash
126+ H.raise InputCleared
127+
105withSearchField :: (HTML.HTMLInputElement -> Effect Unit) -> Effect Unit
128withSearchField :: (HTML.HTMLInputElement -> Effect Unit) -> Effect Unit
106withSearchField cont = do
129withSearchField cont = do
107 doc <- Document.toParentNode <$>
130 doc <- Document.toParentNode <$>
src/Docs/Search/URIHash.jsnew file+17
@@ -0,0 +1,17 @@
1+/* global exports history */
2+
3+// https://stackoverflow.com/questions/1397329
4+exports.removeHash = function () {
5+ var scrollV, scrollH, loc = window.location;
6+ if ("pushState" in history)
7+ history.pushState("", document.title, loc.pathname + loc.search);
8+ else {
9+ scrollV = document.body.scrollTop;
10+ scrollH = document.body.scrollLeft;
11+
12+ loc.hash = "";
13+
14+ document.body.scrollTop = scrollV;
15+ document.body.scrollLeft = scrollH;
16+ }
17+}
src/Docs/Search/URIHash.pursnew file+38
@@ -0,0 +1,38 @@
1+module Docs.Search.URIHash
2+ ( getInput
3+ , setInput
4+ , removeHash
5+ )
6+where
7+
8+import Prelude
9+
10+import Data.Maybe (Maybe(Just), fromMaybe)
11+import Data.String.CodeUnits as String
12+import Effect (Effect)
13+import Global (decodeURIComponent, encodeURIComponent)
14+import Web.HTML as HTML
15+import Web.HTML.Location as Location
16+import Web.HTML.Window as Window
17+
18+foreign import removeHash :: Effect Unit
19+
20+setInput :: String -> Effect Unit
21+setInput "" = removeHash
22+setInput input = do
23+ window <- HTML.window
24+ location <- Window.location window
25+ let hash = "search:" <> fromMaybe "" (encodeURIComponent input)
26+ Location.setHash hash location
27+
28+getInput :: Effect String
29+getInput = do
30+ window <- HTML.window
31+ location <- Window.location window
32+ hash <- Location.hash location
33+ pure $
34+ if String.slice 0 8 hash == Just "#search:"
35+ then fromMaybe "" $
36+ decodeURIComponent $
37+ String.drop 8 hash
38+ else ""