diff --git a/.gitignore b/.gitignore index 65f0706..073c92b 100644 --- a/.gitignore +++ b/.gitignore @@ -5,7 +5,8 @@ node_modules yarn.lock .psc-ide-port +.parcel-cache .psci_modules .spago output -docs \ No newline at end of file +docs diff --git a/.purs-repl b/.purs-repl new file mode 100644 index 0000000..6802fc7 --- /dev/null +++ b/.purs-repl @@ -0,0 +1 @@ +import Prelude diff --git a/bower.json b/bower.json index 29dda72..6f02825 100644 --- a/bower.json +++ b/bower.json @@ -12,14 +12,6 @@ "ignore": [ "**/.*", "node_modules", - "bower_components", "output" - ], - "dependencies": { - "purescript-halogen": "^5.0.0-rc.7" - }, - "devDependencies": { - "purescript-jest": "^0.2.0", - "purescript-psci-support": "^4.0.0" - } + ] } diff --git a/examples/index.html b/examples/index.html index 160a262..49f4831 100644 --- a/examples/index.html +++ b/examples/index.html @@ -13,7 +13,7 @@ - + diff --git a/examples/package.json b/examples/package.json index b845cb6..2babfa9 100644 --- a/examples/package.json +++ b/examples/package.json @@ -13,6 +13,7 @@ "highlight.js": "^9.18.1", "markdown-it-anchor": "^5.2.5", "markdown-it-table-of-contents": "^0.4.4", + "parcel": "^2.2.1", "tailwindcss": "^1.2.0" } } diff --git a/examples/packages.dhall b/examples/packages.dhall deleted file mode 100644 index bdff5ed..0000000 --- a/examples/packages.dhall +++ /dev/null @@ -1,15 +0,0 @@ -let upstream = - https://github.com/purescript/package-sets/releases/download/psc-0.13.6-20200127/packages.dhall sha256:06a623f48c49ea1c7675fdf47f81ddb02ae274558e29f511efae1df99ea92fb8 - -let overrides = {=} - -let additions = - { halogen-custom-element = - { dependencies = [ "prelude", "halogen", "effect", "aff" ] - , repo = - "https://github.com/nonbili/purescript-halogen-custom-element.git" - , version = "e4f5a39a865df775a3f047e8f6df4aee53431d6d" - } - } - -in upstream // overrides // additions diff --git a/examples/spago.dhall b/examples/spago.dhall index 2cd611e..4736eb3 100644 --- a/examples/spago.dhall +++ b/examples/spago.dhall @@ -1,5 +1,18 @@ { name = "purescript-halogen-nselect" -, dependencies = [ "console", "effect", "halogen", "halogen-custom-element" ] -, packages = ./packages.dhall -, sources = [ "../src/**/*.purs", "src/**/*.purs" ] +, dependencies = + [ "aff" + , "arrays" + , "control" + , "effect" + , "foldable-traversable" + , "halogen" + , "halogen-custom-element" + , "halogen-nselect" + , "prelude" + , "strings" + , "web-events" + , "web-uievents" + ] +, packages = ../packages.dhall +, sources = [ "src/**/*.purs" ] } diff --git a/examples/src/Example/Autocomplete.purs b/examples/src/Example/Autocomplete.purs index 510a139..91f1c00 100644 --- a/examples/src/Example/Autocomplete.purs +++ b/examples/src/Example/Autocomplete.purs @@ -4,22 +4,17 @@ import Example.Prelude import Control.MonadPlus (guard) import Data.Array as Array -import Data.Const (Const) import Data.Foldable (for_) -import Data.Maybe (Maybe(..)) import Data.Monoid as Monoid import Data.String as String -import Data.Symbol (SProxy(..)) import Effect.Aff (Aff) import Halogen as H import Halogen.HTML as HH import Halogen.HTML.Properties as HP import NSelect as Select +import Type.Proxy (Proxy(..)) -type Query = Const Void - -data Action - = HandleDropdown (Select.Message Action) +data Action = HandleDropdown (Select.Message Action) type State = { value :: String @@ -31,7 +26,7 @@ type Slots = ( dropdown :: Select.Slot Action Unit ) -_dropdown = SProxy :: SProxy "dropdown" +_dropdown = Proxy :: Proxy "dropdown" type HTML = H.ComponentHTML Action Slots Aff @@ -59,42 +54,43 @@ initialState = renderSelect :: State -> Select.State -> Select.HTML Action () Aff renderSelect state st = HH.div - ( Select.setRootProps [ class_ "inline-block"] - ) $ join - [ pure $ HH.input - ( Select.setInputProps - [ style "width: 20rem" - , HP.value state.value - , HP.placeholder "Autocomplete input" - ] - ) - , guard st.isOpen $> HH.div - [ class_ "Dropdown" - ] - [ HH.div - ( Select.setMenuProps - [ class_ "overflow-y-auto" - , style "max-height: 10rem;" + ( Select.setRootProps [ class_ "inline-block" ] + ) $ join + [ pure $ HH.input + ( Select.setInputProps + [ style "width: 20rem" + , HP.value state.value + , HP.placeholder "Autocomplete input" + ] + ) + , guard st.isOpen $> HH.div + [ class_ "Dropdown" ] - ) $ state.filteredItems # Array.mapWithIndex \index item -> - HH.div - ( Select.setItemProps index - [ class_ $ "py-1 px-3 cursor-pointer" <> - Monoid.guard (index == st.highlightedIndex) " bg-blue-300" + [ HH.div + ( Select.setMenuProps + [ class_ "overflow-y-auto" + , style "max-height: 10rem;" + ] + ) $ state.filteredItems # Array.mapWithIndex \index item -> + HH.div + ( Select.setItemProps index + [ class_ $ "py-1 px-3 cursor-pointer" <> + Monoid.guard (index == st.highlightedIndex) " bg-blue-300" + ] + ) + [ HH.text item ] ] - ) - [ HH.text item ] ] - ] render :: State -> HTML render state = HH.slot _dropdown unit Select.component - { render: renderSelect state - , itemCount: Array.length state.filteredItems - } $ Just <<< HandleDropdown + { render: renderSelect state + , itemCount: Array.length state.filteredItems + } + HandleDropdown -component :: H.Component HH.HTML Query Unit Void Aff +component :: forall q. H.Component q Unit Void Aff component = H.mkComponent { initialState: const initialState , render @@ -108,7 +104,7 @@ handleAction (HandleDropdown msg) = case msg of state <- H.get for_ (Array.index state.filteredItems index) \item -> H.modify_ $ _ { value = item } - void $ H.query _dropdown unit $ H.tell Select.Close + void $ H.tell _dropdown unit Select.Close Select.InputValueChanged value -> do H.modify_ $ \state -> state { value = value diff --git a/examples/src/Example/ComponentInDropdown.purs b/examples/src/Example/ComponentInDropdown.purs index 1a29f0d..48c4c0b 100644 --- a/examples/src/Example/ComponentInDropdown.purs +++ b/examples/src/Example/ComponentInDropdown.purs @@ -3,17 +3,13 @@ module Example.ComponentInDropdown where import Example.Prelude import Control.MonadPlus (guard) -import Data.Const (Const) -import Data.Maybe (Maybe(..)) -import Data.Symbol (SProxy(..)) +import Type.Proxy (Proxy(..)) import Effect.Aff (Aff) import Example.ComponentInDropdown.Child as Child import Halogen as H import Halogen.HTML as HH import NSelect as Select -type Query = Const Void - data Action = HandleDropdown (Select.Message Action) | HandleChild Child.Message @@ -27,11 +23,11 @@ type Slots = ) type SelectSlots = - ( child :: H.Slot Child.Query Child.Message Unit + ( child :: forall q. H.Slot q Child.Message Unit ) -_dropdown = SProxy :: SProxy "dropdown" -_child = SProxy :: SProxy "child" +_dropdown = Proxy :: Proxy "dropdown" +_child = Proxy :: Proxy "child" type HTML = H.ComponentHTML Action Slots Aff @@ -41,36 +37,37 @@ initialState = } renderSelect :: State -> Select.State -> Select.HTML Action SelectSlots Aff -renderSelect state st = +renderSelect _ st = HH.div - ( Select.setRootProps - [ class_ "inline-block" ] - ) $ join - [ pure $ HH.button - ( Select.setToggleProps []) - [ HH.text "Toggle" ] - , guard st.isOpen $> - HH.div - [ class_ "Dropdown p-4" - ] - [ HH.slot _child unit Child.component unit - (Just <<< Select.raise <<< HandleChild) - ] - ] + ( Select.setRootProps + [ class_ "inline-block" ] + ) $ join + [ pure $ HH.button + (Select.setToggleProps []) + [ HH.text "Toggle" ] + , guard st.isOpen $> + HH.div + [ class_ "Dropdown p-4" + ] + [ HH.slot _child unit Child.component unit + (Select.raise <<< HandleChild) + ] + ] render :: State -> HTML render state = HH.div_ - [ HH.slot _dropdown unit Select.component - { render: renderSelect state - , itemCount: 0 - } $ Just <<< HandleDropdown - , HH.div_ - [ HH.text $ "You typed: " <> state.value + [ HH.slot _dropdown unit Select.component + { render: renderSelect state + , itemCount: 0 + } + HandleDropdown + , HH.div_ + [ HH.text $ "You typed: " <> state.value + ] ] - ] -component :: H.Component HH.HTML Query Unit Void Aff +component :: forall q. H.Component q Unit Void Aff component = H.mkComponent { initialState: const initialState , render diff --git a/examples/src/Example/ComponentInDropdown/Child.purs b/examples/src/Example/ComponentInDropdown/Child.purs index abd820a..c01bb79 100644 --- a/examples/src/Example/ComponentInDropdown/Child.purs +++ b/examples/src/Example/ComponentInDropdown/Child.purs @@ -2,20 +2,15 @@ module Example.ComponentInDropdown.Child where import Prelude -import Data.Const (Const) -import Data.Maybe (Maybe(..)) import Effect.Aff (Aff) import Halogen as H import Halogen.HTML as HH import Halogen.HTML.Events as HE import Halogen.HTML.Properties as HP -type Query = Const Void - type Message = String -data Action - = OnInput String +data Action = OnInput String type State = { value :: String @@ -31,14 +26,14 @@ initialState = render :: State -> HTML render state = HH.div_ - [ HH.input - [ HP.value state.value - , HP.placeholder "Type something" - , HE.onValueInput $ Just <<< OnInput + [ HH.input + [ HP.value state.value + , HP.placeholder "Type something" + , HE.onValueInput OnInput + ] ] - ] -component :: H.Component HH.HTML Query Unit Message Aff +component :: forall q. H.Component q Unit Message Aff component = H.mkComponent { initialState: const initialState , render diff --git a/examples/src/Example/Dropdown.purs b/examples/src/Example/Dropdown.purs index c5bf797..bea1e57 100644 --- a/examples/src/Example/Dropdown.purs +++ b/examples/src/Example/Dropdown.purs @@ -3,17 +3,13 @@ module Example.Dropdown where import Example.Prelude import Control.MonadPlus (guard) -import Data.Const (Const) -import Data.Maybe (Maybe(..)) -import Data.Symbol (SProxy(..)) import Effect.Aff (Aff) import Halogen as H import Halogen.HTML as HH import Halogen.HTML.Events as HE import Halogen.HTML.Properties as HP import NSelect as Select - -type Query = Const Void +import Type.Proxy (Proxy(..)) data Action = OnInput String @@ -27,7 +23,7 @@ type Slots = ( dropdown :: Select.Slot Action Unit ) -_dropdown = SProxy :: SProxy "dropdown" +_dropdown = Proxy :: Proxy "dropdown" type HTML = H.ComponentHTML Action Slots Aff @@ -39,33 +35,33 @@ initialState = renderSelect :: State -> Select.State -> Select.HTML Action () Aff renderSelect state st = HH.div - ( Select.setRootProps [ class_ "inline-block"] - ) $ join - [ pure $ HH.button - ( Select.setToggleProps []) - [ HH.text $ if st.isOpen then "🐳️ Close" else "🐋️ Open" ] - , guard st.isOpen $> HH.div - [ class_ "Dropdown p-4" - ] - [ HH.input - [ HP.value state.value - , HP.placeholder "Type something" - , HE.onValueInput $ Just <<< Select.raise <<< OnInput - ] - , HH.div_ - [ HH.text $ "You typed: " <> state.value - ] + ( Select.setRootProps [ class_ "inline-block" ] + ) $ join + [ pure $ HH.button + (Select.setToggleProps []) + [ HH.text $ if st.isOpen then "🐳️ Close" else "🐋️ Open" ] + , guard st.isOpen $> HH.div + [ class_ "Dropdown p-4" + ] + [ HH.input + [ HP.value state.value + , HP.placeholder "Type something" + , HE.onValueInput $ Select.raise <<< OnInput + ] + , HH.div_ + [ HH.text $ "You typed: " <> state.value + ] + ] ] - ] render :: State -> HTML render state = HH.slot _dropdown unit Select.component { render: renderSelect state , itemCount: 0 - } $ Just <<< HandleDropdown + } $ HandleDropdown -component :: H.Component HH.HTML Query Unit Void Aff +component :: forall q. H.Component q Unit Void Aff component = H.mkComponent { initialState: const initialState , render diff --git a/examples/src/Example/TwoInputs.purs b/examples/src/Example/TwoInputs.purs index a800297..237732c 100644 --- a/examples/src/Example/TwoInputs.purs +++ b/examples/src/Example/TwoInputs.purs @@ -4,11 +4,9 @@ import Example.Prelude import Control.MonadPlus (guard) import Data.Array as Array -import Data.Const (Const) import Data.Foldable (for_) -import Data.Maybe (Maybe(..)) import Data.Monoid as Monoid -import Data.Symbol (SProxy(..)) +import Type.Proxy (Proxy(..)) import Effect.Aff (Aff) import Halogen as H import Halogen.HTML as HH @@ -17,8 +15,6 @@ import NSelect as Select import Web.Event.Event as Event import Web.UIEvent.KeyboardEvent as KE -type Query = Const Void - data Action = OnKeyDownInput DropdownSlot KE.KeyboardEvent | HandleDropdown DropdownSlot (Select.Message Action) @@ -38,7 +34,7 @@ type Slots = ( dropdown :: Select.Slot Action DropdownSlot ) -_dropdown = SProxy :: SProxy "dropdown" +_dropdown = Proxy :: Proxy "dropdown" type HTML = H.ComponentHTML Action Slots Aff @@ -64,31 +60,32 @@ renderSelect -> Select.HTML Action () Aff renderSelect state slot st = HH.div - ( Select.setRootProps [ class_ "inline-block"] - ) $ join - [ pure $ HH.input - ( Select.setInputProps' - { onKeyDown: \e -> OnKeyDownInput slot e - } - [ HP.value value - , HP.placeholder "input" - ] - ) - , guard st.isOpen $> HH.div - [ class_ "Dropdown" - , style "width: 20rem;" - ] - [ HH.div_ $ - state.items # Array.mapWithIndex \index item -> - HH.div - ( Select.setItemProps index - [ class_ $ "py-1 px-3 cursor-pointer" <> - Monoid.guard (index == st.highlightedIndex) " bg-blue-300" + ( Select.setRootProps [ class_ "inline-block" ] + ) $ join + [ pure $ HH.input + ( Select.setInputProps' + { onKeyDown: \e -> OnKeyDownInput slot e + } + [ HP.value value + , HP.placeholder "input" + ] + ) + , guard st.isOpen $> HH.div + [ class_ "Dropdown" + , style "width: 20rem;" + ] + [ HH.div_ + $ state.items + # Array.mapWithIndex \index item -> + HH.div + ( Select.setItemProps index + [ class_ $ "py-1 px-3 cursor-pointer" <> + Monoid.guard (index == st.highlightedIndex) " bg-blue-300" + ] + ) + [ HH.text item ] ] - ) - [ HH.text item ] ] - ] where value = case slot of DropdownFrom -> state.from @@ -97,21 +94,21 @@ renderSelect state slot st = render :: State -> HTML render state = HH.div - [ class_ "flex" ] - [ HH.slot _dropdown DropdownFrom Select.component - { render: renderSelect state DropdownFrom - , itemCount: Array.length state.items - } $ Just <<< HandleDropdown DropdownFrom - , HH.span - [ class_ "mx-4" ] - [ HH.text "-" ] - , HH.slot _dropdown DropdownTo Select.component - { render: renderSelect state DropdownTo - , itemCount: Array.length state.items - } $ Just <<< HandleDropdown DropdownTo - ] + [ class_ "flex" ] + [ HH.slot _dropdown DropdownFrom Select.component + { render: renderSelect state DropdownFrom + , itemCount: Array.length state.items + } $ HandleDropdown DropdownFrom + , HH.span + [ class_ "mx-4" ] + [ HH.text "-" ] + , HH.slot _dropdown DropdownTo Select.component + { render: renderSelect state DropdownTo + , itemCount: Array.length state.items + } $ HandleDropdown DropdownTo + ] -component :: H.Component HH.HTML Query Unit Void Aff +component :: forall q. H.Component q Unit Void Aff component = H.mkComponent { initialState: const initialState , render @@ -125,7 +122,7 @@ handleAction (OnKeyDownInput slot kbEvent) = do case KE.key kbEvent of "Tab" -> do H.liftEffect $ Event.preventDefault event - void $ H.query _dropdown slot $ H.tell Select.Select + void $ H.tell _dropdown slot Select.Select _ -> pure unit handleAction (HandleDropdown slot msg) = case msg of Select.Selected index -> do @@ -134,9 +131,9 @@ handleAction (HandleDropdown slot msg) = case msg of case slot of DropdownFrom -> H.modify_ $ _ { from = item } DropdownTo -> H.modify_ $ _ { to = item } - void $ H.query _dropdown slot $ H.tell Select.Close + void $ H.tell _dropdown slot Select.Close when (slot == DropdownFrom) $ do - void $ H.query _dropdown DropdownTo $ H.tell Select.Focus + void $ H.tell _dropdown DropdownTo Select.Focus Select.InputValueChanged value -> do case slot of DropdownFrom -> H.modify_ $ _ { from = value } diff --git a/packages.dhall b/packages.dhall new file mode 100644 index 0000000..db637b3 --- /dev/null +++ b/packages.dhall @@ -0,0 +1,13 @@ +let mkPackage = + https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.0-20190626/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57 + +let upstream = + https://github.com/purescript/package-sets/releases/download/psc-0.14.5-20220127/packages.dhall sha256:8ccbd53dbc7dbfd92a9cba9cca7a8bf36cb120a0a3e21106bf19a16d3ad6863e + +in upstream + with halogen-custom-element = + mkPackage + [ "aff", "effect", "halogen", "prelude", "psci-support", "web-html" ] + "https://github.com/input-output-hk/purescript-halogen-custom-element.git" + "05dd1f21a00f0e21824a39b57737e41ec4ee6c19" + with halogen-nselect = ./spago.dhall as Location diff --git a/spago.dhall b/spago.dhall new file mode 100644 index 0000000..59b6e95 --- /dev/null +++ b/spago.dhall @@ -0,0 +1,30 @@ +{- +Welcome to a Spago project! +You can edit this file as you like. + +Need help? See the following resources: +- Spago documentation: https://github.com/purescript/spago +- Dhall language tour: https://docs.dhall-lang.org/tutorials/Language-Tour.html + +When creating a new Spago project, you can use +`spago init --no-comments` or `spago init -C` +to generate this file without the comments in this block. +-} +{ name = "halogen-nselect" +, dependencies = + [ "aff" + , "effect" + , "foldable-traversable" + , "halogen" + , "maybe" + , "prelude" + , "psci-support" + , "unsafe-coerce" + , "web-dom" + , "web-events" + , "web-html" + , "web-uievents" + ] +, packages = ./packages.dhall +, sources = [ "src/**/*.purs" ] +} diff --git a/src/NSelect.purs b/src/NSelect.purs index 328c617..bf20a6a 100644 --- a/src/NSelect.purs +++ b/src/NSelect.purs @@ -20,7 +20,7 @@ module NSelect import Prelude import Data.Foldable (traverse_) -import Data.Maybe (Maybe(..)) +import Data.Maybe (Maybe(..), isJust) import Effect.Aff as Aff import Effect.Aff.Class (class MonadAff) import Effect.Class (class MonadEffect) @@ -28,7 +28,7 @@ import Halogen as H import Halogen.HTML as HH import Halogen.HTML.Events as HE import Halogen.HTML.Properties as HP -import Halogen.Query.EventSource as ES +import Halogen.Query.Event as QE import Unsafe.Coerce (unsafeCoerce) import Web.DOM.Element as Element import Web.DOM.ParentNode (QuerySelector(..), querySelector) @@ -69,6 +69,7 @@ data Action pa cs m | ReceiveProps (Props pa cs m) | OnWindowMouseDown | OnWindowMouseUp + | OnWindowMouseMove | OnWindowDragEnd | OnMouseDownRoot | OnMouseDownToggle @@ -85,6 +86,13 @@ type InnerState pa cs m = , clickedInside :: Boolean , isOpen :: Boolean , highlightedIndex :: Int + -- When we use the arrow keys, we want to prevent the mouse from stealing + -- the selection back if it is hovering over top of the dropdown. So when an + -- arrow key is pressed, we create a subscription that listens for a + -- mousemove event on the window. When this event is fired, we unsubscribe + -- and clean this value up. If this value is `Just`, we ignore the + -- `OnMouseEnterItem` action. + , mouseMoveSubscription :: Maybe H.SubscriptionId } initialState :: forall pa cs m. Props pa cs m -> InnerState pa cs m @@ -93,6 +101,7 @@ initialState props = , clickedInside: false , isOpen: false , highlightedIndex: 0 + , mouseMoveSubscription: Nothing } type State = @@ -123,7 +132,7 @@ setRootProps . Array (HH.IProp (RootProps r) (Action pa cs m)) -> Array (HH.IProp (RootProps r) (Action pa cs m)) setRootProps props = props <> - [ HE.onMouseDown $ Just <<< const OnMouseDownRoot + [ HE.onMouseDown $ const OnMouseDownRoot ] type ToggleProps r = @@ -136,7 +145,7 @@ setToggleProps . Array (HH.IProp (ToggleProps r) (Action pa cs m)) -> Array (HH.IProp (ToggleProps r) (Action pa cs m)) setToggleProps props = props <> - [ HE.onMouseDown $ Just <<< const OnMouseDownToggle + [ HE.onMouseDown $ const OnMouseDownToggle ] type InputProps r = @@ -155,8 +164,8 @@ sharedInputProps . Array (HH.IProp (InputProps r) (Action pa cs m)) sharedInputProps = [ HP.ref inputRef - , HE.onFocus $ Just <<< const OnFocusInput - , HE.onValueInput $ Just <<< OnValueInput + , HE.onFocus $ const OnFocusInput + , HE.onValueInput $ OnValueInput ] setInputProps @@ -164,7 +173,7 @@ setInputProps . Array (HH.IProp (InputProps r) (Action pa cs m)) -> Array (HH.IProp (InputProps r) (Action pa cs m)) setInputProps props = props <> sharedInputProps <> - [ HE.onKeyDown $ Just <<< OnKeyDownInput + [ HE.onKeyDown $ OnKeyDownInput ] type KeyDownHandler pa = KE.KeyboardEvent -> pa @@ -178,7 +187,7 @@ setInputProps' -> Array (HH.IProp (InputProps r) (Action pa cs m)) -> Array (HH.IProp (InputProps r) (Action pa cs m)) setInputProps' parentHandlers props = props <> sharedInputProps <> - [ HE.onKeyDown $ Just <<< OnKeyDownInput' parentHandlers.onKeyDown + [ HE.onKeyDown $ OnKeyDownInput' parentHandlers.onKeyDown ] menuRef :: H.RefLabel @@ -207,8 +216,8 @@ setItemProps -> Array (HH.IProp (ItemProps r) (Action pa cs m)) setItemProps index props = props <> [ HH.attr (HH.AttrName "data-nselect-item") (show index) - , HE.onClick $ Just <<< const (OnClickItem index) - , HE.onMouseEnter $ Just <<< const (OnMouseEnterItem index) + , HE.onClick $ const (OnClickItem index) + , HE.onMouseEnter $ const (OnMouseEnterItem index) ] render :: forall pa cs m. InnerState pa cs m -> HTML pa cs m @@ -218,7 +227,7 @@ render state = component :: forall pa cs m . MonadAff m - => H.Component HH.HTML Query (Props pa cs m) (Message pa) m + => H.Component Query (Props pa cs m) (Message pa) m component = H.mkComponent { initialState , render @@ -233,7 +242,8 @@ component = H.mkComponent handleVisibilityChange :: forall pa cs m . MonadEffect m - => Boolean -> DSL pa cs m Unit + => Boolean + -> DSL pa cs m Unit handleVisibilityChange isOpen = do state <- H.modify $ _ { isOpen = isOpen } @@ -260,6 +270,13 @@ handleHighlightedIndexChange => Int -> DSL pa cs m Unit handleHighlightedIndexChange index = do + waitingForMouseMove <- H.gets $ isJust <<< _.mouseMoveSubscription + when (not waitingForMouseMove) do + win <- H.liftEffect Web.window + mouseMoveSubscription <- H.subscribe $ + QE.eventListener ET.mousemove (Window.toEventTarget win) + (const $ Just OnWindowMouseMove) + H.modify_ _ { mouseMoveSubscription = Just mouseMoveSubscription } updateHighlightedIndex index scrollIntoViewIfNeeded index @@ -279,11 +296,9 @@ scrollIntoViewIfNeeded index = do itemOffsetTop <- HTMLElement.offsetTop item itemOffsetHeight <- HTMLElement.offsetHeight item - if scrollTop + menuHeight < itemOffsetTop + itemOffsetHeight - then Element.setScrollTop (itemOffsetTop + itemOffsetHeight - menuHeight) menuEl - else if itemOffsetTop < scrollTop - then Element.setScrollTop itemOffsetTop menuEl - else pure unit + if scrollTop + menuHeight < itemOffsetTop + itemOffsetHeight then Element.setScrollTop (itemOffsetTop + itemOffsetHeight - menuHeight) menuEl + else if itemOffsetTop < scrollTop then Element.setScrollTop itemOffsetTop menuEl + else pure unit where selector = QuerySelector $ "[data-nselect-item='" <> show index <> "']" @@ -296,13 +311,13 @@ handleAction = case _ of Init -> do win <- H.liftEffect Web.window void $ H.subscribe $ - ES.eventListenerEventSource ET.mousedown (Window.toEventTarget win) + QE.eventListener ET.mousedown (Window.toEventTarget win) (const $ Just OnWindowMouseDown) void $ H.subscribe $ - ES.eventListenerEventSource ET.mouseup (Window.toEventTarget win) + QE.eventListener ET.mouseup (Window.toEventTarget win) (const $ Just OnWindowMouseUp) void $ H.subscribe $ - ES.eventListenerEventSource DET.dragend (Window.toEventTarget win) + QE.eventListener DET.dragend (Window.toEventTarget win) (const $ Just OnWindowDragEnd) ReceiveProps props -> do @@ -316,14 +331,21 @@ handleAction = case _ of OnWindowMouseUp -> do -- Handle the case of mousedown on NSelect dropdown, mouseup on the outside. state <- H.get - when state.isOpen $ - H.modify_ $ _ { clickedInside = false } + when state.isOpen + $ H.modify_ + $ _ { clickedInside = false } + + OnWindowMouseMove -> do + mouseMoveSubscription <- H.gets _.mouseMoveSubscription + H.modify_ _ { mouseMoveSubscription = Nothing } + traverse_ H.unsubscribe mouseMoveSubscription OnWindowDragEnd -> do -- Handle the case of dragging from NSelect dropdown to the outside. state <- H.get - when state.isOpen $ - H.modify_ $ _ { clickedInside = false } + when state.isOpen + $ H.modify_ + $ _ { clickedInside = false } OnMouseDownRoot -> do H.modify_ $ _ { clickedInside = true } @@ -362,7 +384,9 @@ handleAction = case _ of H.raise $ Selected index OnMouseEnterItem index -> do - updateHighlightedIndex index + waitingForMouseMove <- H.gets $ isJust <<< _.mouseMoveSubscription + when (not waitingForMouseMove) do + updateHighlightedIndex index OnValueInput value -> do handleHighlightedIndexChange 0 @@ -371,7 +395,6 @@ handleAction = case _ of Raise pa -> do H.raise $ Emit pa - handleQuery :: forall pa cs m a . MonadAff m