Merge remote-tracking branch 'origin/dev-doc-annot' into dev-merge

src/Gargantext/Components/Annotation/AnnotatedField.purs

@@ -12,33 +12,35 @@
 module Gargantext.Components.Annotation.AnnotatedField where
 
 import Prelude
-import Data.Map as Map
+import Data.Lens ((^?), _Just)
+import Data.Lens.At (at)
 import Data.Maybe ( Maybe(..), maybe, maybe' )
-import Data.Lens ( Lens', lens )
-import Data.Traversable ( traverse_ )
 import Data.Tuple ( Tuple(..) )
 import Data.Tuple.Nested ( (/\) )
-import DOM.Simple.Console
 import DOM.Simple.Event as DE
 import Effect ( Effect )
-import Effect.Uncurried (mkEffectFn1)
+import Effect.Uncurried ( mkEffectFn1 )
 import Reactix as R
 import Reactix.DOM.HTML as HTML
 import Reactix.SyntheticEvent as E
 
-import Gargantext.Types ( TermList(..) )
+import Gargantext.Types ( TermList )
 import Gargantext.Components.Annotation.Utils ( termClass )
-import Gargantext.Components.NgramsTable ( NgramsTable(..), highlightNgrams )
-import Gargantext.Components.ContextMenu.ContextMenu as CM
+import Gargantext.Components.NgramsTable.Core ( NgramsTerm, NgramsTable(..), _NgramsElement, _list, highlightNgrams )
 import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu )
 import Gargantext.Utils.Selection as Sel
 
 type Run = Tuple String (Maybe TermList)
 
-type Props = ( ngrams :: NgramsTable, text :: Maybe String )
+type Props =
+  ( ngrams      :: NgramsTable
+  , setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
+  , text        :: Maybe String
+  )
 
-defaultProps :: Record Props
-defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing }
+-- UNUSED
+-- defaultProps :: Record Props
+-- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit }
 
 annotatedField :: Record Props -> R.Element
 annotatedField p = R.createElement annotatedFieldComponent p []
@@ -46,14 +48,15 @@ annotatedField p = R.createElement annotatedFieldComponent p []
 annotatedFieldComponent :: R.Component Props
 annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt
   where
-    runs props =
-      HTML.div { className: "annotated-field-runs" } (map annotateRun $ compile props)
-    cpt props _ = do
+    cpt {ngrams,setTermList,text} _ = do
       menu /\ setMenu <- R.useState $ \_ -> pure Nothing
       let wrapperProps =
             { className: "annotated-field-wrapper"
-            , onContextMenu: mkEffectFn1 (maybeShowMenu setMenu props.ngrams) }
-      pure $ HTML.div wrapperProps [ maybeAddMenu setMenu (runs props) menu]
+            , onContextMenu: mkEffectFn1 (maybeShowMenu setMenu setTermList ngrams)
+            }
+          runs =
+            HTML.div { className: "annotated-field-runs" } $ map annotateRun $ compile ngrams text
+      pure $ HTML.div wrapperProps [maybeAddMenu setMenu runs menu]
 
 maybeAddMenu
   :: (Maybe AnnotationMenu -> Effect Unit)
@@ -63,17 +66,16 @@ maybeAddMenu
 maybeAddMenu setMenu e (Just props) = annotationMenu setMenu props <> e
 maybeAddMenu _ e _ = e
 
-compile :: Record Props -> Array Run
-compile props = runs props.text
-  where runs = maybe [] (highlightNgrams props.ngrams)
+compile :: NgramsTable -> Maybe String -> Array Run
+compile ngrams = maybe [] (highlightNgrams ngrams)
 
 maybeShowMenu
-  :: forall t
-  .  (Maybe AnnotationMenu -> Effect Unit)
+  :: (Maybe AnnotationMenu -> Effect Unit)
+  -> (NgramsTerm -> Maybe TermList -> TermList -> Effect Unit)
   -> NgramsTable
   -> E.SyntheticEvent DE.MouseEvent
   -> Effect Unit
-maybeShowMenu setMenu ngrams event = do
+maybeShowMenu setMenu setTermList ngrams event = do
   s <- Sel.getSelection
   case s of
     Just sel -> do
@@ -81,13 +83,15 @@ maybeShowMenu setMenu ngrams event = do
         "" -> pure unit
         sel' -> do
           let x = E.clientX event
-          let y = E.clientY event
+              y = E.clientY event
+              list = findNgram ngrams sel'
+              setList = setTermList sel' list
           E.preventDefault event
-          setMenu $ Just { x, y, list: findNgram ngrams sel' }
+          setMenu $ Just { x, y, sel, list, setList }
     Nothing -> pure unit
 
 findNgram :: NgramsTable -> String -> Maybe TermList
-findNgram _ _ = Nothing
+findNgram (NgramsTable m) s = m ^? at s <<< _Just <<< _NgramsElement <<< _list
 
 -- Runs
 

src/Gargantext/Components/Annotation/Menu.purs

@@ -2,7 +2,7 @@
 module Gargantext.Components.Annotation.Menu where
 
 
-import Prelude ( Unit, (==), ($), (<>), unit, pure )
+import Prelude ( Unit, (==), ($), (<>), unit, pure, otherwise )
 import Data.Array as A
 import Data.Maybe ( Maybe(..), maybe' )
 import Effect ( Effect )
@@ -15,35 +15,36 @@ import Gargantext.Types ( TermList(..), termListName )
 import Gargantext.Components.Annotation.Utils ( termClass )
 
 import Gargantext.Components.ContextMenu.ContextMenu as CM
+import Gargantext.Utils.Selection (Selection, selectionToString)
 
-type Props = ( list :: Maybe TermList )
+type Props =
+  ( sel :: Selection
+  , list :: Maybe TermList
+  , setList :: TermList -> Effect Unit
+  )
 
-type AnnotationMenu = { x :: Number, y :: Number, list :: Maybe TermList }
+type AnnotationMenu = { x :: Number, y :: Number | Props }
 
 -- | An Annotation Menu is parameterised by a Maybe Termlist of the
 -- | TermList the currently selected text belongs to
 annotationMenu :: (Maybe AnnotationMenu -> Effect Unit) -> AnnotationMenu -> R.Element
-annotationMenu setMenu { x,y,list } =
-  CM.contextMenu { x,y,setMenu } [ R.createElement annotationMenuCpt {list} [] ]
+annotationMenu setMenu { x,y,sel,list,setList } =
+  CM.contextMenu { x,y,setMenu } [
+    R.createElement annotationMenuCpt {sel,list,setList} []
+  ]
 
 annotationMenuCpt :: R.Component Props
 annotationMenuCpt = R.hooksComponent "Annotation.Menu" cpt
   where
-    cpt { list } _ = pure $ R.fragment $ children list
-    children l = A.mapMaybe (\l' -> addToList l' l) [ GraphTerm, CandidateTerm, StopTerm ]
+    cpt props _ = pure $ R.fragment $ children props
+    children props = A.mapMaybe (addToList props) [ GraphTerm, CandidateTerm, StopTerm ]
 
 -- | Given the TermList to render the item for zand 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 ]
+addToList :: Record Props -> TermList -> Maybe R.Element
+addToList {list: Just t'} t
+  | t == t'   = Nothing
+addToList {setList} t = Just $ CM.contextMenuItem [ link ]
   where link = HTML.a { onClick: click, className: className } [ HTML.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
-
+        click = mkEffectFn1 $ \_ -> setList t

src/Gargantext/Config.purs

@@ -166,10 +166,11 @@ pathUrl c (GetNgrams
                     _           -> pathUrl c (NodeAPI Url_Document) i
 
 
-pathUrl c (PutNgrams t listid) i =
-    pathUrl c (NodeAPI Node) i <> "/ngrams?ngramsType=" <> showTabType' t <> listid'
-  where
-    listid' = maybe "" (\x -> "&list=" <> show x) listid
+pathUrl c (PutNgrams t listid termList) i =
+    pathUrl c (NodeAPI Node) i <> "/ngrams?ngramsType="
+      <> showTabType' t
+      <> maybe "" (\x -> "&list=" <> show x) listid
+      <> foldMap (\x -> "&listType=" <> show x) termList
 pathUrl c Auth Nothing = c.prePath <> "auth"
 pathUrl c Auth (Just _) = "impossible" -- TODO better types
 pathUrl c (NodeAPI nt) i = c.prePath <> nodeTypeUrl nt <> (maybe "" (\i' -> "/" <> show i') i)
@@ -274,7 +275,7 @@ data Path
       , termSizeFilter :: Maybe TermSize
       , searchQuery    :: String
       }
-  | PutNgrams TabType (Maybe ListId)
+  | PutNgrams TabType (Maybe ListId) (Maybe TermList)
   -- ^ The name is not good. In particular this URL is used both in PUT and POST.
   | NodeAPI NodeType
   | Search  { {-id :: Int

src/Gargantext/Pages/Layout.purs

@@ -6,7 +6,6 @@ import Gargantext.Pages.Layout.Actions (Action(..))
 import Gargantext.Pages.Layout.Specs.AddCorpus as AC
 -- import Gargantext.Pages.Corpus.Tabs as TV
 
-import Gargantext.Pages.Corpus.Document       as Document
 import Gargantext.Pages.Corpus.Graph          as GE
 -- import Gargantext.Pages.Corpus.Tabs.Terms.NgramsTable as NG
 
@@ -51,7 +50,6 @@ dispatchAction dispatcher _ (Folder id) = do
 
 dispatchAction dispatcher _ (Document i n) = do
   dispatcher $ SetRoute $ Document i n
-  dispatcher $ DocumentViewA $ Document.Load i n
 
 dispatchAction dispatcher _ (PGraphExplorer nid) = do
   dispatcher $ SetRoute $ PGraphExplorer nid

src/Gargantext/Pages/Layout/Actions.purs

@@ -12,7 +12,6 @@ import Routing.Hash                                    (setHash)
 import Gargantext.Components.Login                  as LN
 import Gargantext.Components.Modals.Modal              (modalShow)
 import Gargantext.Pages.Annuaire             as Annuaire
-import Gargantext.Pages.Corpus.Document       as D
 import Gargantext.Pages.Corpus.Graph     as GE
 import Gargantext.Pages.Layout.Specs.AddCorpus      as AC
 import Gargantext.Pages.Layout.Specs.Search         as S
@@ -28,7 +27,6 @@ data Action
   | SearchA    S.Action
   | AddCorpusA AC.Action
   | GraphExplorerA     GE.Action
-  | DocumentViewA D.Action
   | AnnuaireAction     Annuaire.Action
   | ShowLogin
   | Logout
@@ -65,7 +63,6 @@ performAction ShowAddCorpus  _ _ = void do
 performAction (LoginA          _) _ _ = pure unit
 performAction (AddCorpusA      _) _ _ = pure unit
 performAction (SearchA         _) _ _ = pure unit
-performAction (DocumentViewA   _) _ _ = pure unit
 performAction (GraphExplorerA  _) _ _ = pure unit
 performAction (AnnuaireAction  _) _ _ = pure unit
   -- liftEffect $ modalShow "addCorpus"
@@ -97,12 +94,6 @@ _annuaireAction = prism AnnuaireAction \action ->
        AnnuaireAction a -> Right a
        _                -> Left  action
 
-_documentViewAction :: Prism' Action D.Action
-_documentViewAction = prism DocumentViewA \action ->
-  case action of
-    DocumentViewA caction -> Right caction
-    _-> Left action
-
 _graphExplorerAction :: Prism' Action GE.Action
 _graphExplorerAction = prism GraphExplorerA \action ->
   case action of

src/Gargantext/Pages/Layout/Specs.purs

@@ -23,11 +23,11 @@ import Gargantext.Pages.Corpus.Document as Annotation
 import Gargantext.Pages.Corpus.Dashboard as Dsh
 import Gargantext.Pages.Corpus.Graph as GE
 import Gargantext.Pages.Home as L
-import Gargantext.Pages.Layout.Actions (Action(..), _addCorpusAction, _documentViewAction, _graphExplorerAction, _loginAction, _searchAction, performAction)
+import Gargantext.Pages.Layout.Actions (Action(..), _addCorpusAction, _graphExplorerAction, _loginAction, _searchAction, performAction)
 import Gargantext.Pages.Layout.Specs.AddCorpus as AC
 import Gargantext.Pages.Layout.Specs.Search    as S
 import Gargantext.Pages.Layout.Specs.SearchBar as SB
-import Gargantext.Pages.Layout.States (AppState, _addCorpusState, _documentViewState, _graphExplorerState, _loginState, _searchState)
+import Gargantext.Pages.Layout.States (AppState, _addCorpusState, _graphExplorerState, _loginState, _searchState)
 import Gargantext.Router (Routes(..))
 import Gargantext.Utils.Reactix as R'
 
@@ -60,7 +60,7 @@ pagesComponent s = case s.currentRoute of
     selectSpec (Corpus   i)      = layout0 $ cmapProps (const {nodeId: i}) $ noState Corpus.layout
     selectSpec AddCorpus         = layout0 $ focus _addCorpusState _addCorpusAction AC.layoutAddcorpus
     selectSpec SearchView        = layout0 $ focus _searchState _searchAction  S.searchSpec
-    selectSpec (Document l i)      = layout0 $ focus _documentViewState _documentViewAction  Annotation.docview
+    selectSpec (Document l i)    = layout0 $ cmapProps (const {nodeId: i, listId: l}) $ noState Annotation.layout
     selectSpec (PGraphExplorer i)= layout1  $ focus _graphExplorerState _graphExplorerAction  GE.specOld
     selectSpec Dashboard         = layout0 $ noState Dsh.layoutDashboard
     selectSpec (Annuaire i)      = layout0 $ cmapProps (const {annuaireId: i}) $ noState A.layout

src/Gargantext/Pages/Layout/States.purs

@@ -7,7 +7,6 @@ import Data.Maybe                                      (Maybe(Just))
 import Effect (Effect)
 import Gargantext.Components.Login                  as LN
 
-import Gargantext.Pages.Corpus.Document       as D
 import Gargantext.Pages.Corpus.Graph     as GE
 import Gargantext.Pages.Layout.Specs.AddCorpus      as AC
 import Gargantext.Pages.Layout.Specs.Search         as S
@@ -18,7 +17,6 @@ type AppState =
   , loginState         :: LN.State
   , addCorpusState     :: AC.State
   , searchState        :: S.State
-  , documentState      :: D.State
   , showLogin          :: Boolean
   , showCorpus         :: Boolean
   , graphExplorerState :: GE.State
@@ -33,7 +31,6 @@ initAppState = do
     , loginState
     , addCorpusState : AC.initialState
     , searchState    : S.initialState
-    , documentState  : D.initialState {}
     , showLogin      : false
     , showCorpus     : false
     , graphExplorerState : GE.initialState
@@ -52,9 +49,6 @@ _addCorpusState = lens (\s -> s.addCorpusState) (\s ss -> s{addCorpusState = ss}
 _searchState :: Lens' AppState S.State
 _searchState = lens (\s -> s.searchState) (\s ss -> s{searchState = ss})
 
-_documentViewState :: Lens' AppState D.State
-_documentViewState = lens (\s -> s.documentState) (\s ss -> s{documentState = ss})
-
 _graphExplorerState :: Lens' AppState GE.State
 _graphExplorerState = lens (\s -> s.graphExplorerState) (\s ss -> s{graphExplorerState = ss})