Commit 59961292 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[NgramsTable] selection/clicking on selected ngrams

Also, context menu changed to a 'mouseup' which checks for selection.
parent 64e9fcfe
.annotation-run {
cursor: pointer;
}
.annotation-run.candidate-term, .context-menu .candidate-term{
color: #000;
background-color: #aaa;
......
......@@ -19,6 +19,7 @@
text-align: center;
margin: 0;
padding: 0;
cursor: pointer;
}
.context-menu-item a {
display: block;
......
......@@ -17,7 +17,9 @@ import Data.Lens.At (at)
import Data.Maybe ( Maybe(..), maybe, maybe' )
import Data.Tuple ( Tuple(..) )
import Data.Tuple.Nested ( (/\) )
import DOM.Simple.Console ( log, log2 )
import DOM.Simple.Event as DE
import Effect.Class ( liftEffect )
import Effect ( Effect )
import Effect.Uncurried ( mkEffectFn1 )
import Reactix as R
......@@ -27,15 +29,13 @@ import Reactix.SyntheticEvent as E
import Gargantext.Types ( TermList )
import Gargantext.Components.Annotation.Utils ( termClass )
import Gargantext.Components.NgramsTable.Core ( NgramsTerm, NgramsTable(..), _NgramsElement, _list, highlightNgrams )
import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu )
import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, MenuType(..) )
import Gargantext.Utils.Selection as Sel
type Run = Tuple String (Maybe TermList)
type Props =
( ngrams :: NgramsTable
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
, text :: Maybe String
( ngrams :: NgramsTable
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
, text :: Maybe String
)
-- UNUSED
......@@ -49,33 +49,22 @@ annotatedFieldComponent :: R.Component Props
annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt
where
cpt {ngrams,setTermList,text} _ = do
menu /\ setMenu <- R.useState $ \_ -> pure Nothing
menu /\ setMenu <- R.useState $ \_ -> pure (Nothing :: Maybe AnnotationMenu)
let wrapperProps =
{ className: "annotated-field-wrapper"
, 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]
{ className: "annotated-field-wrapper" }
maybeAddMenu
:: (Maybe AnnotationMenu -> Effect Unit)
-> R.Element
-> Maybe AnnotationMenu
-> R.Element
maybeAddMenu setMenu e (Just props) = annotationMenu setMenu props <> e
maybeAddMenu _ e _ = e
onSelect _ Nothing event = maybeShowMenu text setMenu setTermList event
onSelect text' (Just list) event = do
let x = E.clientX event
y = E.clientY event
setList = setTermList text' (Just list)
setMenu $ Just {x, y, text: text', list, menuType: SetTermListItem, setList}
compile :: NgramsTable -> Maybe String -> Array Run
compile ngrams = maybe [] (highlightNgrams ngrams)
runs =
HTML.div { className: "annotated-field-runs" } $ map annotateRun (compile ngrams text) onSelect
pure $ HTML.div wrapperProps [maybeAddMenu setMenu runs menu]
maybeShowMenu
:: (Maybe AnnotationMenu -> Effect Unit)
-> (NgramsTerm -> Maybe TermList -> TermList -> Effect Unit)
-> NgramsTable
-> E.SyntheticEvent DE.MouseEvent
-> Effect Unit
maybeShowMenu setMenu setTermList ngrams event = do
maybeShowMenu text setMenu setTermList event = do
s <- Sel.getSelection
case s of
Just sel -> do
......@@ -84,27 +73,54 @@ maybeShowMenu setMenu setTermList ngrams event = do
sel' -> do
let x = E.clientX event
y = E.clientY event
list = findNgram ngrams sel'
list = findNgram text sel'
setList = setTermList sel' list
E.preventDefault event
setMenu $ Just { x, y, sel, list, setList }
setMenu $ Just { x, y, sel, list, menuType: NewNgram, setList }
Nothing -> pure unit
maybeAddMenu
:: (Maybe AnnotationMenu -> Effect Unit)
-> R.Element
-> Maybe AnnotationMenu
-> R.Element
maybeAddMenu setMenu e (Just props) = annotationMenu setMenu props <> e
maybeAddMenu _ e _ = e
--compile :: NgramsTable -> Maybe String -> Array Run
compile ngrams = maybe [] (highlightNgrams ngrams)
findNgram :: NgramsTable -> String -> Maybe TermList
findNgram (NgramsTable m) s = m ^? at s <<< _Just <<< _NgramsElement <<< _list
-- Runs
type RunProps = ( list :: Maybe TermList, text :: String )
type Run =
( text :: String
, list :: (Maybe TermList)
--, onSelect :: a
)
annotateRun :: Run -> R.Element
annotateRun (Tuple text list) = R.createElement annotatedRunComponent { text, list } []
annotateRun :: Record Run -> R.Element
annotateRun {text, list, onSelect} = R.createElement annotatedRunComponent { text, list, onSelect } []
type RunProps =
( text :: String
, list :: Maybe TermList
--, onSelect :: a
)
annotatedRunComponent :: R.Component RunProps
annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt
where cpt { text, list } _ = maybe' (\_ -> unstyled text) (styled text) list
styled text list = HTML.span { className: className list } [ HTML.text text ]
unstyled text = HTML.span {} [ HTML.text text ]
className list = "annotation-run " <> termClass list
where
cpt { text, list: Nothing, onSelect } _ =
HTML.span { onMouseUp: mkEffectFn1 $ \e -> onSelect text Nothing e } [ HTML.text text ]
cpt { text, list: (Just list), onSelect } _ =
HTML.span { className: className list
, onClick: mkEffectFn1 $ \e -> onSelect text (Just list) e
} [ HTML.text text ]
where
className list = "annotation-run " <> termClass list
......@@ -17,9 +17,12 @@ import Gargantext.Components.Annotation.Utils ( termClass )
import Gargantext.Components.ContextMenu.ContextMenu as CM
import Gargantext.Utils.Selection (Selection, selectionToString)
data MenuType = NewNgram | SetTermListItem
type Props =
( sel :: Selection
, list :: Maybe TermList
, menuType :: MenuType
, setList :: TermList -> Effect Unit
)
......@@ -28,9 +31,9 @@ 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,sel,list,setList } =
annotationMenu setMenu { x,y,sel,list,menuType,setList } =
CM.contextMenu { x,y,setMenu } [
R.createElement annotationMenuCpt {sel,list,setList} []
R.createElement annotationMenuCpt {sel,list,menuType,setList} []
]
annotationMenuCpt :: R.Component Props
......@@ -43,8 +46,10 @@ annotationMenuCpt = R.hooksComponent "Annotation.Menu" cpt
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 $ \_ -> setList t
addToList {menuType, setList} t = Just $ CM.contextMenuItem [ link ]
where
link = HTML.a { onClick: click, className: className } [ HTML.text (label menuType) ]
label NewNgram = "Add to " <> termListName t
label SetTermListItem = "Change to" <> termListName t
className = termClass t
click = mkEffectFn1 $ \_ -> setList t
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