From 2e1d31498b171622fb9cb8879afcedcab035e367 Mon Sep 17 00:00:00 2001 From: klntsky Date: Sat, 23 Nov 2019 01:01:21 +0300 Subject: [PATCH 1/2] Allow using the app as a search engine (show search term in URI hash) --- src/Docs/Search/App.purs | 15 +++++++++-- src/Docs/Search/App/SearchField.purs | 31 ++++++++++++++++++++--- src/Docs/Search/URIHash.js | 38 ++++++++++++++++++++++++++++ src/Docs/Search/URIHash.purs | 13 ++++++++++ 4 files changed, 91 insertions(+), 6 deletions(-) create mode 100644 src/Docs/Search/URIHash.js create mode 100644 src/Docs/Search/URIHash.purs diff --git a/src/Docs/Search/App.purs b/src/Docs/Search/App.purs index dd5ded0..aaa057e 100644 --- a/src/Docs/Search/App.purs +++ b/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 = """ diff --git a/src/Docs/Search/App/SearchField.purs b/src/Docs/Search/App/SearchField.purs index 70433c2..8274c37 100644 --- a/src/Docs/Search/App/SearchField.purs +++ b/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,21 +39,34 @@ 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 } @@ -60,6 +74,10 @@ 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.clearInput + H.raise InputCleared + withSearchField :: (HTML.HTMLInputElement -> Effect Unit) -> Effect Unit withSearchField cont = do doc <- Document.toParentNode <$> diff --git a/src/Docs/Search/URIHash.js b/src/Docs/Search/URIHash.js new file mode 100644 index 0000000..fa72eb8 --- /dev/null +++ b/src/Docs/Search/URIHash.js @@ -0,0 +1,38 @@ +/* global exports history */ + +// https://stackoverflow.com/questions/1397329 +function removeHash () { + 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; + } +} + +exports.getInput = function () { + var hash = document.location.hash; + if (hash.slice(0, 8) == "#search:") { + return decodeURIComponent(hash.slice(8)); + } else { + return ""; + } +}; + +exports.setInput = function (input) { + return function () { + if (!input) { + removeHash(); + } else { + document.location.hash = "search:" + encodeURIComponent(input); + } + }; +}; + +exports.clearInput = removeHash; diff --git a/src/Docs/Search/URIHash.purs b/src/Docs/Search/URIHash.purs new file mode 100644 index 0000000..4abe137 --- /dev/null +++ b/src/Docs/Search/URIHash.purs @@ -0,0 +1,13 @@ +module Docs.Search.URIHash + ( getInput + , setInput + , clearInput + ) +where + +import Prelude +import Effect (Effect) + +foreign import getInput :: Effect String +foreign import setInput :: String -> Effect Unit +foreign import clearInput :: Effect Unit From 0cd5dd916c3f89109638b92ba8cbdd5b1bfc51b1 Mon Sep 17 00:00:00 2001 From: klntsky Date: Sat, 23 Nov 2019 01:21:10 +0300 Subject: [PATCH 2/2] Use less FFI --- src/Docs/Search/App/SearchField.purs | 2 +- src/Docs/Search/URIHash.js | 23 +------------------ src/Docs/Search/URIHash.purs | 33 ++++++++++++++++++++++++---- 3 files changed, 31 insertions(+), 27 deletions(-) diff --git a/src/Docs/Search/App/SearchField.purs b/src/Docs/Search/App/SearchField.purs index 8274c37..a70c190 100644 --- a/src/Docs/Search/App/SearchField.purs +++ b/src/Docs/Search/App/SearchField.purs @@ -122,7 +122,7 @@ handleAction = case _ of clearInput :: H.HalogenM State Action () SearchFieldMessage Aff Unit clearInput = do H.modify_ (_ { input = "" }) - H.liftEffect URIHash.clearInput + H.liftEffect URIHash.removeHash H.raise InputCleared withSearchField :: (HTML.HTMLInputElement -> Effect Unit) -> Effect Unit diff --git a/src/Docs/Search/URIHash.js b/src/Docs/Search/URIHash.js index fa72eb8..bc61d56 100644 --- a/src/Docs/Search/URIHash.js +++ b/src/Docs/Search/URIHash.js @@ -1,7 +1,7 @@ /* global exports history */ // https://stackoverflow.com/questions/1397329 -function removeHash () { +exports.removeHash = function () { var scrollV, scrollH, loc = window.location; if ("pushState" in history) history.pushState("", document.title, loc.pathname + loc.search); @@ -15,24 +15,3 @@ function removeHash () { document.body.scrollLeft = scrollH; } } - -exports.getInput = function () { - var hash = document.location.hash; - if (hash.slice(0, 8) == "#search:") { - return decodeURIComponent(hash.slice(8)); - } else { - return ""; - } -}; - -exports.setInput = function (input) { - return function () { - if (!input) { - removeHash(); - } else { - document.location.hash = "search:" + encodeURIComponent(input); - } - }; -}; - -exports.clearInput = removeHash; diff --git a/src/Docs/Search/URIHash.purs b/src/Docs/Search/URIHash.purs index 4abe137..64a2fdc 100644 --- a/src/Docs/Search/URIHash.purs +++ b/src/Docs/Search/URIHash.purs @@ -1,13 +1,38 @@ module Docs.Search.URIHash ( getInput , setInput - , clearInput + , 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 -foreign import getInput :: Effect String -foreign import setInput :: String -> Effect Unit -foreign import clearInput :: Effect Unit +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 ""