Merge branch 'feature/annotation' of...

Merge branch 'feature/annotation' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-annotation

dist/index.html

@@ -9,6 +9,8 @@
         <link href="styles/bootstrap.min.css" rel="stylesheet">
         <!-- <link href="css/lavish-bootstrap.css" rel="stylesheet"> -->
         <link rel="stylesheet" type="text/css" href="styles/menu.css"/>
+        <link rel="stylesheet" type="text/css" href="styles/context-menu.css"/>
+        <link rel="stylesheet" type="text/css" href="styles/annotation.css"/>
         <link href="styles/Login.css" rel="stylesheet">
         <style>
          * {margin: 0; padding: 0; list-style: none;}

dist/styles/annotation.css

+.annotation-run.candidate-term, .annotation-menu .candidate-term{
+    color: #000;
+    background-color: #aaa;
+}
+.annotation-run.graph-term, .annotation-menu .graph-term {
+    color: #000;
+    background-color: #0f0;
+}
+.annotation-run.stop-term, .annotation-menu .stop-term {
+    color: #000;
+    background-color: #f00;
+}

dist/styles/context-menu.css

+.context-menu {
+  display: block;
+  position: fixed;
+  z-index: 9999;
+  background: #fff;
+  border: 1px solid #000;
+  border-radius: 3px;
+  padding: 0;
+}
+.context-menu-items {
+  display: block;
+  position: relative;
+}
+.context-menu-item {
+  display: block;
+  margin: 10px;
+  text-align: center;
+  margin: 0;
+  padding: 0;
+}
+.context-menu-item a {
+  display: block;
+  padding: 10px 20px;
+  text-align: center;
+  font-size: 16px;
+  height: 100%;
+}

package.json

@@ -4,7 +4,8 @@
         "rebuild-set": "spago psc-package-insdhall",
         "install-ps": "psc-package install",
         "build": "pulp --psc-package browserify -t dist/bundle.js",
-        "repl": "pulp --psc-package repl"
+        "repl": "pulp --psc-package repl",
+        "clean": "rm -Rf output"
     },
     "dependencies": {
         "@babel/polyfill": "^7.0.0",

src/Gargantext/Components/Annotated/AnnotatedField.purs → src/Gargantext/Components/Annotation/AnnotatedField.purs

 -- | The AnnotatedField Component is for colouring ngrams that appear in a text
 -- | 
--- | Given a list of ngrams and a text, it:
+-- | Given an array of ngrams and a text, it:
 -- | 
 -- | 1. Searches the text for the ngrams
 -- | 2. Renders each the resulting runs according to the Maybe TermList they appear in
@@ -9,26 +9,24 @@
 -- | 
 -- | 1. We must only re-search the text when the ngrams change for performance
 -- | 2. We will need a more ambitious search algorithm for skipgrams.
-module Gargantext.Components.Annotated.AnnotatedField where
+module Gargantext.Components.Annotation.AnnotatedField where
 
-import Prelude hiding (div)
-import Data.Array as A
+import Prelude
 import Data.Map as Map
-import Data.Maybe (Maybe(..), maybe, isJust)
-import Data.Lens (Lens', lens)
-import Data.List as List
-import Data.List (List(..))
-import Data.Tuple (Tuple(..))
-import Effect (Effect)
-import Effect.Class.Console (log)
-import Effect.Unsafe (unsafePerformEffect)
-import React (ReactElement, ReactClass, createElement)
-import Gargantext.Types (TermList(..))
-import Gargantext.Components.NgramsTable (NgramsTable(..), highlightNgrams)
-import Gargantext.Utils.Selection (getSelection, toString)
+import Data.Maybe ( Maybe(..), maybe )
+import Data.Lens ( Lens', lens )
+import Data.Traversable ( traverse_ )
+import Data.Tuple ( Tuple(..) )
+import Effect ( Effect )
 import Reactix as R
 import Reactix.DOM.Raw as RDOM
 
+import Gargantext.Types ( TermList(..) )
+import Gargantext.Components.Annotation.Utils ( termClass )
+import Gargantext.Components.NgramsTable ( NgramsTable(..), highlightNgrams )
+import Gargantext.Components.Annotation.Menu ( annotationMenu )
+import Gargantext.Utils.Selection as Sel
+
 newtype PageOffset = PageOffset { x :: Number, y :: Number }
 
 type Run = Tuple String (Maybe TermList)
@@ -44,8 +42,11 @@ annotatedField = R.createLeaf annotatedFieldComponent
 annotatedFieldComponent :: R.Component Props
 annotatedFieldComponent = R.pureLeaf "AnnotatedField" cpt
   where
-    cpt props = R.createDOMElement "p" { className: "annotated-field" } $ children props
-    children props = A.fromFoldable (annotateRun <$> compile props)
+    runs props = annotateRun <$> compile props
+    cpt props =
+      RDOM.div { className: "annotated-field-wrapper" }
+        [ annotationMenu { termList: Nothing }
+        , RDOM.div { className: "annotated-field-runs" } (annotateRun <$> compile props) ]
 
 type RunProps = ( list :: Maybe TermList, text :: String )
 
@@ -55,16 +56,23 @@ annotateRun (Tuple text list) = R.createLeaf annotatedRunComponent { text, list
 annotatedRunComponent :: R.Component RunProps
 annotatedRunComponent = R.pureLeaf "AnnotatedRun" cpt
   where cpt { text, list } = maybe (unstyled text) (styled text) list
-        styled text list = R.createDOMElement "span" { style: termStyle list } [ RDOM.text text ]
-        unstyled text = R.createDOMElement "span" {} [ RDOM.text text ]
+        styled text list = RDOM.span { className: className list } [ RDOM.text text ]
+        unstyled text = RDOM.span {} [ RDOM.text text ]
+        className list = "annotation-run " <> termClass list
 
-compile :: Record Props -> List Run
+compile :: Record Props -> Array Run
 compile props = runs props.text
-  where runs (Just text) = highlight props.ngrams text
-        runs _ = Nil
+  where runs (Just text) = highlightNgrams props.ngrams text
+        runs _ = []
+
+maybeShowMenu :: SyntheticEvent -> NgramsTable -> (Maybe TermList -> Effect Unit) -> Effect Unit
+maybeShowMenu e n a = Sel.getSelection >>= traverse_ (a <<< findNgram n <<< Sel.toString)
+
+showMenu
+
 
-highlight :: NgramsTable -> String -> List Run
-highlight n t = List.fromFoldable $ highlightNgrams n t
+findNgram :: NgramsTable -> String -> Maybe TermList
+findNgram _ _ = Nothing
 
 -- contextMenuHandler :: (Action -> Effect Unit) -> SyntheticMouseEvent -> Effect Unit
 -- contextMenuHandler d e =
@@ -78,12 +86,8 @@ highlight n t = List.fromFoldable $ highlightNgrams n t
 --              y <- pageY e
 --              pure $ PageOffset { x, y }
 
-termStyle :: TermList -> { backgroundColor :: String }
-termStyle GraphTerm     = { backgroundColor: "green" }
-termStyle StopTerm      = { backgroundColor: "red" }
-termStyle CandidateTerm = { backgroundColor: "black" }
 
--- _runs :: Lens' State (List Run)
+-- _runs :: Lens' State (Array Run)
 -- _runs = lens (\a -> a.runs) (\a r -> a { runs = r })
 
 -- _contextMenu :: Lens' State ???

src/Gargantext/Components/Annotation/Menu.purs

+-- | A ContextMenU that allows you to add terms to a list
+module Gargantext.Components.Annotation.Menu where
+
+
+import Prelude ( Unit, (==), ($), (<>), unit, pure )
+import Data.Array as A
+import Data.Maybe ( Maybe(..) )
+import Effect ( Effect )
+import Effect.Uncurried ( mkEffectFn1 )
+import Reactix as R
+import Reactix.DOM.Raw as RDOM
+import Unsafe.Coerce ( unsafeCoerce )
+
+import Gargantext.Types ( TermList(..), termListName )
+import Gargantext.Utils.Reactix as R'
+import Gargantext.Components.Annotation.Utils ( termClass )
+
+import Gargantext.Components.ContextMenu.ContextMenu as CM
+
+type Props = ( termList :: Maybe TermList )
+
+-- | An Annotation Menu is parameterised by a Maybe Termlist of the
+-- | TermList the currently selected text belongs to
+annotationMenu :: Record Props -> R.Element
+annotationMenu = R.createLeaf annotationMenuCpt
+
+annotationMenuCpt :: R.Component Props
+annotationMenuCpt = R.hooksLeaf "Annotation.Menu" cpt
+  where
+    cpt :: forall m. R'.HooksLeaf m Props
+    cpt { termList } = pure $
+      R'.div { className: "annotation-menu" } [ CM.contextMenu $ children termList ]
+    children l = A.mapMaybe (\l' -> addToList l' l) [ GraphTerm, CandidateTerm, StopTerm ]
+
+-- | Given the TermList to render the item for and the Maybe TermList the item may belong to, possibly render the menuItem
+addToList :: TermList -> Maybe TermList -> Maybe R.Element
+addToList t (Just t')
+  | t == t' = Nothing
+  | true = addToList t Nothing
+addToList t _ = Just $ CM.contextMenuItem [ link ]
+  where link = R'.a { onClick: click, className: className } [ RDOM.text label ]
+        label = "Add to " <> termListName t
+        className = termClass t
+        click = mkEffectFn1 $ \_ -> addToTermList t
+
+-- TODO: what happens when we add to a term list?
+addToTermList :: TermList -> Effect Unit
+addToTermList _ = pure unit
+

src/Gargantext/Components/Annotation/Utils.purs

+module Gargantext.Components.Annotation.Utils where
+
+import Gargantext.Types ( TermList(..) )
+
+termClass :: TermList -> String
+termClass GraphTerm = "graph-term"
+termClass StopTerm = "stop-term"
+termClass CandidateTerm = "candidate-term"

src/Gargantext/Components/ContextMenu/ContextMenu.purs

 -- | The ContextMenu component renders a generic context menu
-module Gargantext.Component.ContextMenu.ContextMenu where
+module Gargantext.Components.ContextMenu.ContextMenu where
   -- (MenuProps, Action(..), separator) where
 
 import Prelude hiding (div)
 import Effect (Effect)
-import Data.String (joinWith)
-import React
-  ( class ReactComponentSpec
-  , Context, ContextProvider, ContextConsumer
-  , ReactClass, ReactElement, ReactClassConstructor, Children
-  , component, createElement )
-import React.DOM (a, div, li, ul')
-import React.DOM as DOM -- for Props
-import React.DOM.Props (className, onContextMenu, onMouseOut, onBlur)
-import Thermite
-  ( Render, PerformAction
-  , simpleSpec, modifyState_
-  , createReactSpec, defaultRender
-  , _render )
-import Gargantext.Utils.React (WithChildren, wrap)
-
--- type State' = { open :: Boolean }
--- newtype State = State State'
-
--- defaultState :: State
--- defaultState = State { open: false }
-
--- type MenuProps = { classes :: String, items :: Array (Effect Unit -> ReactElement) }
--- type ItemProps p = { hideMenu :: Context (Effect Unit) | p }
+import Reactix as R
+import Reactix.DOM.Raw as RDOM
+
+import Gargantext.Utils.Reactix as R'
+
+contextMenu :: Array R.Element -> R.Element
+contextMenu = R.createTree contextMenuCpt {}
+
+contextMenuCpt :: R.Component (R'.WithChildren ())
+contextMenuCpt = R.hooksTree "ContextMenu" cpt
+  where
+    cpt :: forall m. R'.HooksTree m ()
+    cpt _props children = pure $
+      R'.nav { className: "context-menu" }
+        [ R'.ul { className: "context-menu-items" } children ]
+
+contextMenuItem :: Array R.Element -> R.Element
+contextMenuItem = R.createTree contextMenuItemCpt {}
+
+contextMenuItemCpt :: R.Component (R'.WithChildren ())
+contextMenuItemCpt = R.hooksTree "ContextMenuItem" cpt
+  where
+    cpt :: forall m. R'.HooksTree m ()
+    cpt _props children = pure $ R'.li { className: "context-menu-item" } children
+
 
 -- data Action = Show | Hide
 

src/Gargantext/Config.purs

@@ -26,7 +26,7 @@ endConfig = endConfig' V10
 
 endConfig' :: ApiVersion -> EndConfig
 endConfig' v = { front : frontRelative
-               , back  : backLocal v  }
+               , back  : backDemo v  }
 
 ------------------------------------------------------------------------
 frontRelative :: Config

src/Gargantext/Pages/Corpus/Document.purs

@@ -22,9 +22,9 @@ import Gargantext.Config          (toUrl, NodeType(..), End(..))
 import Gargantext.Config.REST     (get)
 import Gargantext.Components.Node (NodePoly(..))
 import Gargantext.Components.NgramsTable (NgramsTable(..), NgramsElement(..))
-import Gargantext.Components.Annotated.AnnotatedField as AnnotatedField
+import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
 import Gargantext.Types (TermList(..))
-import Gargantext.Utils.React ( crapify )
+import Gargantext.Utils.Reactix ( scuff )
 
 nge :: String -> Tuple String NgramsElement
 nge word = Tuple word elem where
@@ -330,7 +330,7 @@ docview = simpleSpec performAction render
           ]
       ]
         where
-          annotate t = crapify $ AnnotatedField.annotatedField { ngrams: state.ngramsTable, text: t }
+          annotate t = scuff $ AnnotatedField.annotatedField { ngrams: state.ngramsTable, text: t }
           li' = li [className "list-group-item justify-content-between"]
           text' x = text $ maybe "Nothing" identity x
           badge s = span [className "badge badge-default badge-pill"] [text s]

src/Gargantext/Utils/React.purs

@@ -14,9 +14,6 @@ type WithChildren props = { children :: Children | props }
 wrap :: (Array ReactElement -> ReactElement) -> ReactElement -> ReactElement
 wrap f e = f [e]
 
-crapify :: R.Element -> ReactElement
-crapify = unsafeCoerce
-
 -- many ::
 --   forall props extra state action.
 --      Spec state { extra :: extra | WithIndex props } action

src/Gargantext/Utils/Reactix.purs

+module Gargantext.Utils.Reactix
+  ( WithChildren, HooksTree, HooksLeaf, buff, scuff, nav, ul, li, a, div )
+  where
+
+import React ( ReactElement )
+import Reactix as R
+import Unsafe.Coerce ( unsafeCoerce )
+
+-- | A convenience for adding `children` to a list of props
+type WithChildren p = ( children :: R.Children | p )
+
+type HooksTree m p = R.MonadHooks m => Record p -> Array R.Element -> m R.Element
+type HooksLeaf m p = R.MonadHooks m => Record p -> m R.Element
+
+-- | Turns a ReactElement into a Reactix Element
+-- | buff (v.) to polish
+buff :: ReactElement -> R.Element
+buff = unsafeCoerce
+
+-- | Turns a Reactix Element into a ReactElement.
+-- | scuff (v.) to spoil the gloss or finish of. 
+scuff :: R.Element -> ReactElement
+scuff = unsafeCoerce
+
+div :: forall r. Record r -> Array R.Element -> R.Element
+div = R.createDOMElement "div"
+
+nav :: forall r. Record r -> Array R.Element -> R.Element
+nav = R.createDOMElement "nav"
+
+ul :: forall r. Record r -> Array R.Element -> R.Element
+ul = R.createDOMElement "ul"
+
+li :: forall r. Record r -> Array R.Element -> R.Element
+li = R.createDOMElement "li"
+
+a :: forall r. Record r -> Array R.Element -> R.Element
+a = R.createDOMElement "a"
+