Commit 4967c4bf authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch '364-dev-graph-search-rc0.x' of...

Merge branch '364-dev-graph-search-rc0.x' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge
parents 1dbf3d8b 5f71811d
...@@ -2,19 +2,19 @@ module Gargantext.Components.GraphExplorer.Search ...@@ -2,19 +2,19 @@ module Gargantext.Components.GraphExplorer.Search
( Props, nodeSearchControl ) where ( Props, nodeSearchControl ) where
import Prelude import Prelude
import DOM.Simple.Console (log2)
import Data.Foldable (foldl) import Data.Foldable (foldl)
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Set as Set import Data.Set as Set
import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.InputWithAutocomplete (inputWithAutocomplete) import Gargantext.Components.InputWithAutocomplete (inputWithAutocomplete)
import Gargantext.Hooks.Sigmax.Types as SigmaxT import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Utils (queryMatchesLabel) import Gargantext.Utils (queryMatchesLabel)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Search" here = R2.here "Gargantext.Components.GraphExplorer.Search"
...@@ -29,7 +29,7 @@ type Props = ( ...@@ -29,7 +29,7 @@ type Props = (
-- Searches given node and matches it's label or any of the children's labels. -- Searches given node and matches it's label or any of the children's labels.
nodeMatchesSearch :: String -> Record SigmaxT.Node -> Boolean nodeMatchesSearch :: String -> Record SigmaxT.Node -> Boolean
nodeMatchesSearch s n@{ children } = nodeMatchesSearch s n@{ children } =
foldl (\acc childLabel -> queryMatchesLabel s childLabel) initial children foldl (\_ childLabel -> queryMatchesLabel s childLabel) initial children
where where
initial = queryMatchesLabel s n.label initial = queryMatchesLabel s n.label
...@@ -79,4 +79,3 @@ triggerSearch graph search multiSelectEnabled selectedNodeIds = do ...@@ -79,4 +79,3 @@ triggerSearch graph search multiSelectEnabled selectedNodeIds = do
T.modify_ (\nodes -> T.modify_ (\nodes ->
Set.union matching $ if multiSelectEnabled then nodes else SigmaxT.emptyNodeIds) selectedNodeIds Set.union matching $ if multiSelectEnabled then nodes else SigmaxT.emptyNodeIds) selectedNodeIds
...@@ -2,14 +2,14 @@ module Gargantext.Components.InputWithAutocomplete where ...@@ -2,14 +2,14 @@ module Gargantext.Components.InputWithAutocomplete where
import Prelude import Prelude
import DOM.Simple (contains)
import DOM.Simple as DOM import DOM.Simple as DOM
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..), maybe)
import Data.Nullable (Nullable, null, toMaybe) import Data.Nullable (Nullable, null, toMaybe)
import Effect (Effect) import Effect (Effect)
import Effect.Timer (setTimeout) import FFI.Simple ((..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import React.SyntheticEvent as E
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T import Toestand as T
...@@ -34,43 +34,72 @@ inputWithAutocomplete = R.createElement inputWithAutocompleteCpt ...@@ -34,43 +34,72 @@ inputWithAutocomplete = R.createElement inputWithAutocompleteCpt
inputWithAutocompleteCpt :: R.Component Props inputWithAutocompleteCpt :: R.Component Props
inputWithAutocompleteCpt = here.component "inputWithAutocomplete" cpt inputWithAutocompleteCpt = here.component "inputWithAutocomplete" cpt
where where
cpt props@{ autocompleteSearch cpt { autocompleteSearch
, classes , classes
, onAutocompleteClick , onAutocompleteClick
, onEnterPress , onEnterPress
, state } _ = do , state } _ = do
state' <- T.useLive T.unequal state -- States
inputRef <- R.useRef null state' <- T.useLive T.unequal state
completions <- T.useBox $ autocompleteSearch state' containerRef <- R.useRef null
inputRef <- R.useRef null
let onFocus completions' _ = T.write_ (autocompleteSearch state') completions' completions <- T.useBox $ autocompleteSearch state'
-- Render
pure $ pure $
H.span { className: "input-with-autocomplete " <> classes }
H.div
{ className: "input-with-autocomplete " <> classes
, ref: containerRef
}
[ [
completionsCpt { completions, onAutocompleteClick, state } [] completionsCpt { completions, onAutocompleteClick, state } []
, H.input { type: "text" , H.input { type: "text"
, ref: inputRef , ref: inputRef
, className: "form-control" , className: "form-control"
, value: state' , value: state'
, on: { blur: onBlur completions , on: { focus: onFocus completions state'
, focus: onFocus completions
, input: onInput completions , input: onInput completions
, change: onInput completions , change: onInput completions
, keyUp: onInputKeyUp inputRef } } , keyUp: onInputKeyUp inputRef
, blur: onBlur completions containerRef
}
}
] ]
-- Helpers
where where
-- (!) `onBlur` DOM.Event is triggered before any `onClick` DOM.Event
-- So when a completion is being clicked, the UX will be broken
--
-- ↳ As a solution we chose to check if the click is made from
-- the autocompletion list
onBlur :: forall event.
T.Box Completions
-> R.Ref (Nullable DOM.Element)
-> event
-> Effect Unit
onBlur completions containerRef event =
if isInnerEvent
then
pure $ (event .. "preventDefault")
else
T.write_ [] completions
-- setTimeout is a bit of a hack here -- clicking on autocomplete where
-- element will clear out the blur first, so the autocomplete click mContains = do
-- won't fire without a timeout here. However, blur is very handy and a <- toMaybe $ R.readRef containerRef
-- handles automatic autocomplete search, otherwise I'd have to hide it b <- toMaybe (event .. "relatedTarget")
-- in various different places (i.e. carefully handle all possible Just (contains a b)
-- events where blur happens and autocomplete should hide).
onBlur completions _ = setTimeout 100 $ do
T.write_ [] completions
isInnerEvent = maybe false identity mContains
onFocus :: forall event. T.Box Completions -> String -> event -> Effect Unit
onFocus completions st _ = T.write_ (autocompleteSearch st) completions
onInput :: forall event. T.Box Completions -> event -> Effect Unit
onInput completions e = do onInput completions e = do
let val = R.unsafeEventValue e let val = R.unsafeEventValue e
T.write_ val state T.write_ val state
...@@ -93,10 +122,14 @@ inputWithAutocompleteCpt = here.component "inputWithAutocomplete" cpt ...@@ -93,10 +122,14 @@ inputWithAutocompleteCpt = here.component "inputWithAutocomplete" cpt
else else
pure $ false pure $ false
---------------------------------------------------------
type CompletionsProps = type CompletionsProps =
( completions :: T.Box Completions ( completions :: T.Box Completions
, onAutocompleteClick :: String -> Effect Unit , onAutocompleteClick :: String -> Effect Unit
, state :: T.Box String , state :: T.Box String
) )
completionsCpt :: R2.Component CompletionsProps completionsCpt :: R2.Component CompletionsProps
...@@ -106,19 +139,29 @@ completionsCptCpt :: R.Component CompletionsProps ...@@ -106,19 +139,29 @@ completionsCptCpt :: R.Component CompletionsProps
completionsCptCpt = here.component "completionsCpt" cpt completionsCptCpt = here.component "completionsCpt" cpt
where where
cpt { completions, onAutocompleteClick, state } _ = do cpt { completions, onAutocompleteClick, state } _ = do
-- State
completions' <- T.useLive T.unequal completions completions' <- T.useLive T.unequal completions
let className = "completions " <> (if completions' == [] then "d-none" else "") let className = "completions " <> (if completions' == [] then "d-none" else "")
pure $ H.div { className } -- Render
pure $
H.div
{ className }
[ [
H.div { className: "list-group" } (cCpt <$> completions') H.div { className: "list-group" } (cCpt <$> completions')
] ]
-- Helpers
where where
cCpt c = cCpt c =
H.button { type: "button" H.button { type: "button"
, className: "list-group-item" , className: "list-group-item"
, on: { click: onClick c } } [ H.text c ] , on: { click: onClick c } } [ H.text c ]
onClick c _ = do onClick c _ = do
T.write_ c state T.write_ c state
T.write_ [] completions
onAutocompleteClick c onAutocompleteClick c
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment