Commit 8b7aae81 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[NgramsTable] annotation works now and type checks

Menu actions still need some work.
parent 59961292
...@@ -37,6 +37,7 @@ type Props = ...@@ -37,6 +37,7 @@ type Props =
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit , setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
, text :: Maybe String , text :: Maybe String
) )
type MouseEvent = E.SyntheticEvent DE.MouseEvent
-- UNUSED -- UNUSED
-- defaultProps :: Record Props -- defaultProps :: Record Props
...@@ -49,22 +50,26 @@ annotatedFieldComponent :: R.Component Props ...@@ -49,22 +50,26 @@ annotatedFieldComponent :: R.Component Props
annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt
where where
cpt {ngrams,setTermList,text} _ = do cpt {ngrams,setTermList,text} _ = do
menu /\ setMenu <- R.useState $ \_ -> pure (Nothing :: Maybe AnnotationMenu) menu /\ setMenu <- R.useState $ \_ -> pure Nothing
let wrapperProps = let wrapperProps =
{ className: "annotated-field-wrapper" } { className: "annotated-field-wrapper" }
onSelect _ Nothing event = maybeShowMenu text setMenu setTermList event onSelect _ Nothing event = maybeShowMenu setMenu setTermList ngrams event
onSelect text' (Just list) event = do onSelect text' (Just list) event = do
let x = E.clientX event let x = E.clientX event
y = E.clientY event y = E.clientY event
setList = setTermList text' (Just list) setList = setTermList text' (Just list)
setMenu $ Just {x, y, text: text', list, menuType: SetTermListItem, setList} setMenu $ Just {x, y, list: Just list, menuType: SetTermListItem, setList}
mapCompile (Tuple t l) = {text: t, list: l, onSelect}
compiled = map mapCompile $ compile ngrams text
runs = runs =
HTML.div { className: "annotated-field-runs" } $ map annotateRun (compile ngrams text) onSelect HTML.div { className: "annotated-field-runs" } $ map annotateRun compiled
pure $ HTML.div wrapperProps [maybeAddMenu setMenu runs menu] pure $ HTML.div wrapperProps [maybeAddMenu setMenu runs menu]
maybeShowMenu text setMenu setTermList event = do
maybeShowMenu setMenu setTermList ngrams event = do
s <- Sel.getSelection s <- Sel.getSelection
case s of case s of
Just sel -> do Just sel -> do
...@@ -73,10 +78,10 @@ maybeShowMenu text setMenu setTermList event = do ...@@ -73,10 +78,10 @@ maybeShowMenu text setMenu setTermList event = do
sel' -> do sel' -> do
let x = E.clientX event let x = E.clientX event
y = E.clientY event y = E.clientY event
list = findNgram text sel' list = findNgram ngrams sel'
setList = setTermList sel' list setList = setTermList sel' list
E.preventDefault event E.preventDefault event
setMenu $ Just { x, y, sel, list, menuType: NewNgram, setList } setMenu $ Just { x, y, list, menuType: NewNgram, setList }
Nothing -> pure unit Nothing -> pure unit
maybeAddMenu maybeAddMenu
...@@ -87,7 +92,7 @@ maybeAddMenu ...@@ -87,7 +92,7 @@ maybeAddMenu
maybeAddMenu setMenu e (Just props) = annotationMenu setMenu props <> e maybeAddMenu setMenu e (Just props) = annotationMenu setMenu props <> e
maybeAddMenu _ e _ = e maybeAddMenu _ e _ = e
--compile :: NgramsTable -> Maybe String -> Array Run compile :: NgramsTable -> Maybe String -> Array (Tuple String (Maybe TermList))
compile ngrams = maybe [] (highlightNgrams ngrams) compile ngrams = maybe [] (highlightNgrams ngrams)
findNgram :: NgramsTable -> String -> Maybe TermList findNgram :: NgramsTable -> String -> Maybe TermList
...@@ -98,19 +103,13 @@ findNgram (NgramsTable m) s = m ^? at s <<< _Just <<< _NgramsElement <<< _list ...@@ -98,19 +103,13 @@ findNgram (NgramsTable m) s = m ^? at s <<< _Just <<< _NgramsElement <<< _list
type Run = type Run =
( text :: String ( text :: String
, list :: (Maybe TermList) , list :: (Maybe TermList)
--, onSelect :: a , onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
) )
annotateRun :: Record Run -> R.Element annotateRun :: Record Run -> R.Element
annotateRun {text, list, onSelect} = R.createElement annotatedRunComponent { text, list, onSelect } [] annotateRun p = R.createElement annotatedRunComponent p []
type RunProps =
( text :: String
, list :: Maybe TermList
--, onSelect :: a
)
annotatedRunComponent :: R.Component RunProps annotatedRunComponent :: R.Component Run
annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt
where where
cpt { text, list: Nothing, onSelect } _ = cpt { text, list: Nothing, onSelect } _ =
...@@ -118,8 +117,7 @@ annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt ...@@ -118,8 +117,7 @@ annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt
cpt { text, list: (Just list), onSelect } _ = cpt { text, list: (Just list), onSelect } _ =
HTML.span { className: className list HTML.span { className: className list
, onClick: mkEffectFn1 $ \e -> onSelect text (Just list) e , onClick: mkEffectFn1 $ \e -> onSelect text (Just list) e} [ HTML.text text ]
} [ HTML.text text ]
where where
className list = "annotation-run " <> termClass list className list = "annotation-run " <> termClass list
......
...@@ -20,8 +20,7 @@ import Gargantext.Utils.Selection (Selection, selectionToString) ...@@ -20,8 +20,7 @@ import Gargantext.Utils.Selection (Selection, selectionToString)
data MenuType = NewNgram | SetTermListItem data MenuType = NewNgram | SetTermListItem
type Props = type Props =
( sel :: Selection ( list :: Maybe TermList
, list :: Maybe TermList
, menuType :: MenuType , menuType :: MenuType
, setList :: TermList -> Effect Unit , setList :: TermList -> Effect Unit
) )
...@@ -31,9 +30,9 @@ type AnnotationMenu = { x :: Number, y :: Number | Props } ...@@ -31,9 +30,9 @@ type AnnotationMenu = { x :: Number, y :: Number | Props }
-- | An Annotation Menu is parameterised by a Maybe Termlist of the -- | An Annotation Menu is parameterised by a Maybe Termlist of the
-- | TermList the currently selected text belongs to -- | TermList the currently selected text belongs to
annotationMenu :: (Maybe AnnotationMenu -> Effect Unit) -> AnnotationMenu -> R.Element annotationMenu :: (Maybe AnnotationMenu -> Effect Unit) -> AnnotationMenu -> R.Element
annotationMenu setMenu { x,y,sel,list,menuType,setList } = annotationMenu setMenu { x,y,list,menuType,setList } =
CM.contextMenu { x,y,setMenu } [ CM.contextMenu { x,y,setMenu } [
R.createElement annotationMenuCpt {sel,list,menuType,setList} [] R.createElement annotationMenuCpt {list,menuType,setList} []
] ]
annotationMenuCpt :: R.Component Props annotationMenuCpt :: R.Component Props
......
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