Commit 52e3afa0 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch '350-dev-graph-search-in-forms-not-labels' of...

Merge branch '350-dev-graph-search-in-forms-not-labels' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev
parents e184d32a 35bbbf08
...@@ -25,7 +25,7 @@ test: ...@@ -25,7 +25,7 @@ test:
script: script:
# find 0.14.2 purescript version here: # find 0.14.2 purescript version here:
# https://lazamar.co.uk/nix-versions/ # https://lazamar.co.uk/nix-versions/
- nix-env -i purescript-0.14.2 -f https://github.com/NixOS/nixpkgs/archive/bed08131cd29a85f19716d9351940bdc34834492.tar.gz - nix-env -i purescript-0.14.4 -f https://github.com/NixOS/nixpkgs/archive/bed08131cd29a85f19716d9351940bdc34834492.tar.gz
- nix-env -i git - nix-env -i git
- nix-env -i nodejs - nix-env -i nodejs
- nix-env -i yarn - nix-env -i yarn
......
...@@ -260,6 +260,7 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges} ...@@ -260,6 +260,7 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges}
nodeFn _i nn@(GET.Node n) = nodeFn _i nn@(GET.Node n) =
Seq.singleton { Seq.singleton {
borderColor: color borderColor: color
, children: n.children
, color : color , color : color
, equilateral: { numPoints: 3 } , equilateral: { numPoints: 3 }
, gargType , gargType
......
...@@ -2,6 +2,7 @@ module Gargantext.Components.GraphExplorer.Search ...@@ -2,6 +2,7 @@ module Gargantext.Components.GraphExplorer.Search
( Props, nodeSearchControl ) where ( Props, nodeSearchControl ) where
import Prelude import Prelude
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 DOM.Simple.Console (log2)
...@@ -25,32 +26,37 @@ type Props = ( ...@@ -25,32 +26,37 @@ type Props = (
) )
-- | Whether a node matches a search string -- | Whether a node matches a search string
-- 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 = queryMatchesLabel s n.label nodeMatchesSearch s n@{ children } =
foldl (\acc childLabel -> queryMatchesLabel s childLabel) initial children
where
initial = queryMatchesLabel s n.label
searchNodes :: String -> Seq.Seq (Record SigmaxT.Node) -> Seq.Seq (Record SigmaxT.Node) searchNodes :: String -> Seq.Seq (Record SigmaxT.Node) -> Seq.Seq (Record SigmaxT.Node)
searchNodes "" _ = Seq.empty searchNodes "" _ = Seq.empty
searchNodes s nodes = Seq.filter (nodeMatchesSearch s) nodes searchNodes s nodes = Seq.filter (nodeMatchesSearch s) nodes
nodeSearchControl :: R2.Component Props nodeSearchControl :: R2.Component Props
nodeSearchControl = R.createElement sizeButtonCpt nodeSearchControl = R.createElement nodeSearchControlCpt
nodeSearchControlCpt :: R.Component Props
sizeButtonCpt :: R.Component Props nodeSearchControlCpt = here.component "nodeSearchControl" cpt
sizeButtonCpt = here.component "nodeSearchControl" cpt
where where
cpt { graph, multiSelectEnabled, selectedNodeIds } _ = do cpt { graph, multiSelectEnabled, selectedNodeIds } _ = do
search <- T.useBox "" search <- T.useBox ""
search' <- T.useLive T.unequal search search' <- T.useLive T.unequal search
multiSelectEnabled' <- T.useLive T.unequal multiSelectEnabled multiSelectEnabled' <- T.useLive T.unequal multiSelectEnabled
let doSearch s = triggerSearch graph s multiSelectEnabled' selectedNodeIds
pure $ R.fragment pure $ R.fragment
[ inputWithAutocomplete { autocompleteSearch: autocompleteSearch graph [ inputWithAutocomplete { autocompleteSearch: autocompleteSearch graph
, classes: "mx-2" , classes: "mx-2"
, onAutocompleteClick: \s -> triggerSearch graph s multiSelectEnabled' selectedNodeIds , onAutocompleteClick: doSearch
, onEnterPress: \s -> triggerSearch graph s multiSelectEnabled' selectedNodeIds , onEnterPress: doSearch
, state: search } [] , state: search } []
, H.div { className: "btn input-group-addon" , H.div { className: "btn input-group-addon"
, on: { click: \_ -> triggerSearch graph search' multiSelectEnabled' selectedNodeIds } , on: { click: \_ -> doSearch search' }
} }
[ H.span { className: "fa fa-search" } [] ] [ H.span { className: "fa fa-search" } [] ]
] ]
...@@ -73,3 +79,4 @@ triggerSearch graph search multiSelectEnabled selectedNodeIds = do ...@@ -73,3 +79,4 @@ 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
module Gargantext.Components.InputWithAutocomplete where module Gargantext.Components.InputWithAutocomplete where
import Prelude import Prelude
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null, toMaybe)
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.Nullable (Nullable, null, toMaybe)
import Effect (Effect) import Effect (Effect)
import Effect.Timer (setTimeout) import Effect.Timer (setTimeout)
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 React.SyntheticEvent as E
import Toestand as T import Toestand as T
import Gargantext.Utils.Reactix as R2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.InputWithAutocomplete" here = R2.here "Gargantext.Components.InputWithAutocomplete"
......
...@@ -5,6 +5,7 @@ import Gargantext.Prelude ...@@ -5,6 +5,7 @@ import Gargantext.Prelude
import Data.Array as A import Data.Array as A
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Foldable (foldl) import Data.Foldable (foldl)
import Data.Maybe (fromMaybe)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
...@@ -41,7 +42,7 @@ handleErrorInAsyncProgress errors ap@(AsyncProgress { log, status: IsFinished }) ...@@ -41,7 +42,7 @@ handleErrorInAsyncProgress errors ap@(AsyncProgress { log, status: IsFinished })
handleErrorInAsyncProgress _ _ = pure unit handleErrorInAsyncProgress _ _ = pure unit
concatErrors :: AsyncProgress -> String concatErrors :: AsyncProgress -> String
concatErrors (AsyncProgress { log }) = foldl eventsErrorMessage "" log concatErrors (AsyncProgress { error, log }) = foldl eventsErrorMessage (fromMaybe "" error) log
where where
eventsErrorMessage acc (AsyncTaskLog { events }) = (foldl eventErrorMessage "" events) <> "\n" <> acc eventsErrorMessage acc (AsyncTaskLog { events }) = (foldl eventErrorMessage "" events) <> "\n" <> acc
eventErrorMessage acc (AsyncEvent { level: "ERROR", message }) = message <> "\n" <> acc eventErrorMessage acc (AsyncEvent { level: "ERROR", message }) = message <> "\n" <> acc
......
...@@ -35,6 +35,7 @@ type EdgeId = String ...@@ -35,6 +35,7 @@ type EdgeId = String
type Node = ( type Node = (
borderColor :: String borderColor :: String
, children :: Array String
, color :: String , color :: String
, equilateral :: { numPoints :: Int } , equilateral :: { numPoints :: Int }
, gargType :: GT.Mode , gargType :: GT.Mode
......
...@@ -736,8 +736,9 @@ derive newtype instance JSON.ReadForeign AsyncTaskWithType ...@@ -736,8 +736,9 @@ derive newtype instance JSON.ReadForeign AsyncTaskWithType
instance Eq AsyncTaskWithType where eq = genericEq instance Eq AsyncTaskWithType where eq = genericEq
newtype AsyncProgress = AsyncProgress newtype AsyncProgress = AsyncProgress
{ id :: AsyncTaskID { id :: AsyncTaskID
, log :: Array AsyncTaskLog , error :: Maybe String
, log :: Array AsyncTaskLog
, status :: AsyncTaskStatus , status :: AsyncTaskStatus
} }
derive instance Generic AsyncProgress _ derive instance Generic AsyncProgress _
......
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