Merge remote-tracking branch 'origin/dev-edgeFilter' into feature/sigmax-graph-explorer

dist/index.html

@@ -12,6 +12,8 @@
         <link rel="stylesheet" type="text/css" href="styles/menu.css"/>
         <link href="styles/Graph.css" rel="stylesheet" type="text/css" />
         <link href="styles/Login.css" rel="stylesheet" type="text/css" />
+        <link rel="stylesheet" type="text/css" href="styles/annotation.css"/>
+        <link rel="stylesheet" type="text/css" href="styles/range-slider.css"/>
         <style>
          * {margin: 0; padding: 0; list-style: none;}
          .tree ul li {

dist/styles/range-slider.css

+.range-slider {
+  position: relative;
+}
+
+.range-slider .scale {
+  position: absolute;
+  background-color: #555;
+}
+
+.range-slider .knob {
+  position: absolute;
+}

dist/styles/range-slider.sass

+.range-slider
+  position: relative
+
+  .scale
+    position: absolute
+    background-color: #555
+
+  .knob
+    position: absolute

psc-package.json

@@ -15,6 +15,7 @@
     "generics-rep",
     "integers",
     "js-timers",
+    "math",
     "maybe",
     "numbers",
     "prelude",

src/Gargantext/Components/GraphExplorer/Types.purs

@@ -36,10 +36,14 @@ newtype Edge = Edge
   , source :: String
   , target :: String
   , weight :: Number
+  , confluence :: Number
   }
 
 derive instance newtypeEdge :: Newtype Edge _
 
+-- | A 'fully closed interval' in CS parlance
+type InclusiveRange t = { min :: t, max :: t }
+
 type ListId      = Int
 type CorpusId    = Int
 type CorpusLabel = String
@@ -208,7 +212,8 @@ instance decodeJsonEdge :: DecodeJson Edge where
     source <- obj .? "source"
     target <- obj .? "target"
     weight <- obj .? "weight"
-    pure $ Edge { id_, source, target, weight }
+    confluence <- obj .? "confluence"
+    pure $ Edge { id_, source, target, weight, confluence }
 
 newtype Legend = Legend  {id_ ::Int , color :: String, label :: String}
 

src/Gargantext/Components/RangeSlider.purs

+-- | The RangeSlider is a slider component with two knobs, allowing
+-- | the user to specify both a minimum and maximum value to filter
+-- | data by. It may be dragged with the mouse or moved with the
+-- | keyboard like a regular slider component.  The RangeSlider is
+-- | designed to let the user adjust in multiples of a provided
+-- | epsilon (smallest difference)
+module Gargantext.Components.RangeSlider where
+
+import Prelude
+import Reactix as R
+import Data.Traversable (traverse_)
+import Gargantext.Utils.Reactix as R2
+import DOM.Simple.Document (document)
+import DOM.Simple.EventListener as EL
+import DOM.Simple.Types (DOMRect, Element)
+import DOM.Simple.Event as Event
+import DOM.Simple.Console (log, log2)
+import Data.Tuple.Nested ((/\))
+import Effect.Uncurried (EffectFn1, mkEffectFn1)
+import Gargantext.Utils.Math (roundToMultiple)
+import Gargantext.Utils.Range as Range
+import Data.Maybe (Maybe(..))
+import Data.Nullable (null)
+import Effect (Effect)
+import Reactix.DOM.HTML as H
+import Reactix.SyntheticEvent as RE
+-- data Axis = X | Y
+
+type NumberRange = Range.Closed Number
+-- To avoid overloading the terms 'min' and 'max' here, we treat 'min'
+-- and 'max' as being the bounds of the scale and 'low' and 'high' as
+-- being the selected values
+type Props =
+  ( bounds :: NumberRange       -- The minimum and maximum values it is possible to select
+  , initialValue :: NumberRange -- The user's selection of minimum and maximum values
+  , epsilon :: Number           -- The smallest possible change (for mouse)
+  , step :: Number              -- The 'standard' change (for keyboard)
+  -- , axis :: Axis                -- Which direction to move in
+  , width :: Number
+  , height :: Number
+  , onChange :: NumberRange -> Effect Unit )
+
+rangeSlider :: Record Props -> R.Element
+rangeSlider props = R.createElement rangeSliderCpt props []
+
+data Knob = MinKnob | MaxKnob
+
+data RangeUpdate = SetMin Number | SetMax Number
+
+rangeSliderCpt :: R.Component Props
+rangeSliderCpt = R.hooksComponent "RangeSlider" cpt
+  where
+    cpt props _ = do
+      R.useEffect' $ \_ -> log2 "Props: " props
+      -- scale bar
+      scaleElem <- R.useRef null -- dom ref
+      scalePos <- R2.usePositionRef scaleElem
+      -- low knob
+      lowElem <- R.useRef null -- a dom ref to the low knob
+      lowPos <- R2.usePositionRef lowElem
+      -- high knob
+      highElem <- R.useRef null -- a dom ref to the high knob
+      highPos <- R2.usePositionRef highElem
+      -- The value of the user's selection
+      value /\ setValue <- R.useState $ \_ -> pure $ initialValue props
+      let Range.Closed value' = value
+
+      -- the knob we are currently in a drag for. set by mousedown on a knob
+      dragKnob /\ setDragKnob <- R.useState $ \_ -> pure Nothing
+      -- the bounding box within which the mouse can drag
+      dragScale <- R.useRef $ Nothing
+      -- the handler functions for trapping mouse events, so they can be removed
+      mouseMoveHandler <- (R.useRef $ Nothing) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent)))
+      mouseUpHandler <- (R.useRef $ Nothing) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent)))
+      let destroy = \_ ->
+            do log "RangeSlider: Destroying event handlers"
+               destroyEventHandler "mousemove" mouseMoveHandler
+               destroyEventHandler "mouseup" mouseUpHandler
+      R2.useLayoutEffect1' dragKnob $ \_ -> do
+        case dragKnob of
+          Just knob -> do
+            let drag = getDragScale knob scalePos lowPos highPos
+            R.setRef dragScale drag
+            let onMouseMove = EL.callback $ \(event :: Event.MouseEvent) ->
+              case reproject drag scalePos value (R2.domMousePosition event) of
+                  Just val -> setKnob knob setValue value val
+                  Nothing -> destroy unit
+            let onMouseUp = EL.callback $ \(_event :: Event.MouseEvent) -> destroy unit
+            log "RangeSlider: Creating event handlers"
+            EL.addEventListener document "mousemove" onMouseMove
+            EL.addEventListener document "mouseup" onMouseUp
+          Nothing -> destroy unit
+      pure $ H.div { className, aria }
+        [ renderScale scaleElem props value'
+        , renderKnob lowElem  value'.min ("Minimum value:" <> show value'.min) MinKnob setDragKnob
+        , renderKnob highElem value'.max ("Maximum value:" <> show value'.max) MaxKnob setDragKnob
+        ]
+    className = "range-slider"
+    aria = { label: "Range Slider Control. Expresses filtering data by a minimum and maximum value range through two slider knobs. Knobs can be adjusted with the arrow keys." }
+
+destroyEventHandler
+  :: forall e
+  .  Event.IsEvent e
+  => String -> R.Ref (Maybe (EL.Callback e)) -> Effect Unit
+destroyEventHandler name ref = traverse_ destroy $ R.readRef ref
+  where
+    destroy handler = do
+      EL.removeEventListener document name handler
+      R.setRef ref Nothing
+
+setKnob :: Knob -> (Range.Closed Number -> Effect Unit) -> Range.Closed Number -> Number -> Effect Unit
+setKnob knob setValue r val = setValue $ setter knob r val
+  where
+    setter MinKnob = Range.withMin
+    setter MaxKnob = Range.withMax
+
+getDragScale :: Knob -> R.Ref (Maybe DOMRect) -> R.Ref (Maybe DOMRect) -> R.Ref (Maybe DOMRect) -> Maybe (Range.Closed Number)
+getDragScale knob scalePos lowPos highPos = do
+  scale <- R.readRef scalePos
+  low <- R.readRef lowPos
+  high <- R.readRef highPos
+  pure $ Range.Closed { min: min knob scale high, max: max knob scale low }
+  where
+    min MinKnob scale _ = scale.left
+    min MaxKnob _ low = low.left
+    max MinKnob _ high = high.left
+    max MaxKnob scale _ = scale.right
+
+renderScale ref {width,height} {min, max} =
+   H.div { ref, className, width, height, aria } []
+  where
+    className = "scale"
+    aria = { label: "Scale running from " <> show min <> " to " <> show max }
+
+renderKnob ref val label knob set =
+  H.div { ref, tabIndex, className, aria, onMouseDown } [ H.text (show val) ]
+  where
+    tabIndex = 0
+    className = "knob"
+    aria = { label }
+    onMouseDown = mkEffectFn1 $ \_ -> set (Just knob)
+
+-- todo round to nearest epsilon
+reproject :: Maybe (Range.Closed Number) -> R.Ref (Maybe DOMRect) -> Range.Closed Number -> R2.Point -> Maybe Number
+reproject drag scale value (R2.Point mousePos) = do
+  drag_ <- drag
+  scale_ <- rectRange <$> R.readRef scale
+  let normal = Range.normalise scale_ (Range.clamp drag_ mousePos.x)
+  pure $ Range.projectNormal value normal
+    
+rectRange :: DOMRect -> Range.Closed Number
+rectRange rect = Range.Closed { min, max }
+  where min = rect.left
+        max = rect.right
+
+initialValue :: Record Props -> NumberRange
+initialValue props = roundRange props.epsilon props.bounds props.initialValue
+
+round :: Number -> NumberRange -> Number -> Number
+round epsilon bounds = roundToMultiple epsilon <<< Range.clamp bounds
+
+roundRange :: Number -> NumberRange -> NumberRange -> NumberRange
+roundRange epsilon bounds (Range.Closed initial) = Range.Closed { min, max }
+  where min = round epsilon bounds initial.min
+        max = round epsilon bounds initial.max
+  

src/Gargantext/Pages/Corpus/Graph.purs

@@ -26,6 +26,7 @@ import Gargantext.Hooks.Sigmax.Types as Sigmax
 import Gargantext.Hooks.Sigmax.Sigmajs (CameraProps, SigmaNode, cameras, getCameraProps, goTo, pauseForceAtlas2, sigmaOnMouseMove)
 import Gargantext.Components.GraphExplorer.Types (Cluster(..), MetaData(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData, intColor)
 import Gargantext.Components.Login.Types (AuthData(..), TreeId)
+import Gargantext.Components.RangeSlider as RangeSlider
 import Gargantext.Components.RandomText (words)
 import Gargantext.Components.Graph as Graph
 import Gargantext.Components.Tree as Tree
@@ -88,7 +89,10 @@ numberTargetValue e =
 
 -- TODO remove newtype here
 newtype State = State
-  { graphData :: GraphData
+  { rawGraphData :: GraphData
+  , graphData :: GraphData
+  , edgeFilters :: EdgeFilters
+  , nodeFilters :: NodeFilters
   , filePath :: String
   , sigmaGraphData :: Maybe Graph.Graph
   , legendData :: Array Legend
@@ -105,6 +109,10 @@ newtype State = State
 
 derive instance newtypeState :: Newtype State _
 
+emptyGraphData :: GraphData
+emptyGraphData = GraphData { nodes: [], edges: [], sides: [], metaData }
+  where metaData = Just $ MetaData { title : "", legend : [], corpusId : [] }
+
 initialState :: State
 initialState = State
   { graphData : GraphData {nodes: [], edges: [], sides: [], metaData : Just $ MetaData{title : "", legend : [], corpusId : [], listId : 0}}
@@ -223,6 +231,7 @@ render d p (State {sigmaGraphData, settings, legendData}) c =
   -- [dispLegend legendData]
 --}
 
+=======
 
 
 

src/Gargantext/Utils/Math.purs

+module Gargantext.Utils.Math where
+
+import Prelude
+import Math as Math
+
+roundToMultiple :: Number -> Number -> Number
+roundToMultiple num eps = eps * Math.round (num / eps)
+

src/Gargantext/Utils/Range.purs

+module Gargantext.Utils.Range where
+
+import Prelude
+import Data.Newtype (class Newtype)
+import Data.Ord (class Ord)
+
+class Range r v where
+  clamp :: r -> v -> v
+  within :: r -> v -> Boolean
+
+-- | A Closed Interval, in math speak
+newtype Closed t = Closed { min :: t, max :: t }
+
+derive instance newtypeClosed :: Newtype (Closed t) _
+
+instance closedRange :: Ord t => Range (Closed t) t where
+  clamp (Closed r) = max r.min <<< min r.max
+  within (Closed r) v = (v <= r.max) && (v >= r.min)
+
+range :: Closed Number -> Number
+range (Closed r) = r.max - r.min
+
+-- | Clamps the value to within the range and returns a normalised
+-- | (0-1) float indication progress along the range
+normalise :: Closed Number -> Number -> Number
+normalise r v = clamp r v / range r
+
+-- | Given a normal (0-1) float representing progress along a range,
+-- | project it onto the range
+projectNormal :: Closed Number -> Number -> Number
+projectNormal r v = clamp closedProbability v * range r
+
+-- | A closed range between 0 and 1
+closedProbability :: Closed Number
+closedProbability = Closed { min: 0.0, max: 1.0 }
+
+-- | Updates the minimum value in a closed range
+withMin :: forall t. Closed t -> t -> Closed t
+withMin (Closed {max}) min = Closed { min, max }
+
+-- | Updates the maximum value in a closed range
+withMax :: forall t. Closed t -> t -> Closed t
+withMax (Closed {min}) max = Closed { min, max }
+

src/Gargantext/Utils/Reactix.purs

@@ -3,12 +3,14 @@ module Gargantext.Utils.Reactix
 
 import Prelude
 
-import DOM.Simple.Event as DE
 import Data.Maybe (Maybe(..))
 import Data.Nullable (Nullable, null, toMaybe)
 import Data.Traversable (traverse_)
 import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested ((/\))
+import DOM.Simple.Element as Element
+import DOM.Simple.Event as DE
+import DOM.Simple as DOM
 import Effect (Effect)
 import Effect.Uncurried (EffectFn1, mkEffectFn1)
 import FFI.Simple ((...), defineProperty)
@@ -76,6 +78,8 @@ instance isComponentReactClass
 mousePosition :: RE.SyntheticEvent DE.MouseEvent -> Point
 mousePosition e = Point { x: RE.clientX e, y: RE.clientY e }
 
+domMousePosition :: DE.MouseEvent -> Point
+domMousePosition = mousePosition <<< unsafeCoerce
 -- | This is naughty, it quietly mutates the input and returns it
 named :: forall o. String -> o -> o
 named = flip $ defineProperty "name"
@@ -101,3 +105,18 @@ nullRef = R.useRef null
 
 nothingRef :: forall t. R.Hooks (R.Ref (Maybe t))
 nothingRef = R.useRef Nothing
+
+useLayoutEffect1' :: forall a. a -> (Unit -> Effect Unit) -> R.Hooks Unit
+useLayoutEffect1' a f = R.useLayoutEffect1 a $ \_ ->
+  do f unit
+     pure $ \_ -> pure unit
+
+useLayoutRef :: forall a b. (a -> b) -> b -> R.Ref a -> R.Hooks (R.Ref b)
+useLayoutRef fn init ref = do
+  new <- R.useRef init
+  let old = R.readRef ref
+  useLayoutEffect1' old $ \_ -> R.setRef new (fn old)
+  pure new
+
+usePositionRef :: R.Ref (Nullable DOM.Element) -> R.Hooks (R.Ref (Maybe DOM.DOMRect))
+usePositionRef = useLayoutRef (map Element.boundingRect <<< toMaybe) Nothing