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..a70c190 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.removeHash + 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..bc61d56 --- /dev/null +++ b/src/Docs/Search/URIHash.js @@ -0,0 +1,17 @@ +/* global exports history */ + +// https://stackoverflow.com/questions/1397329 +exports.removeHash = function () { + 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; + } +} diff --git a/src/Docs/Search/URIHash.purs b/src/Docs/Search/URIHash.purs new file mode 100644 index 0000000..64a2fdc --- /dev/null +++ b/src/Docs/Search/URIHash.purs @@ -0,0 +1,38 @@ +module Docs.Search.URIHash + ( getInput + , setInput + , 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 + +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 ""