Menu.purs 1.97 KB
Newer Older
James Laver's avatar
James Laver committed
1 2 3 4
-- | A ContextMenU that allows you to add terms to a list
module Gargantext.Components.Annotation.Menu where


5
import Prelude (Unit, pure, ($), (<>), (==))
James Laver's avatar
James Laver committed
6
import Data.Array as A
7 8 9
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Uncurried (mkEffectFn1)
James Laver's avatar
James Laver committed
10
import Reactix as R
11
import Reactix.DOM.HTML as HTML
James Laver's avatar
James Laver committed
12

13 14
import Gargantext.Types (TermList(..), termListName)
import Gargantext.Components.Annotation.Utils (termBootstrapClass)
James Laver's avatar
James Laver committed
15 16

import Gargantext.Components.ContextMenu.ContextMenu as CM
17
import Gargantext.Utils.Reactix as R2
James Laver's avatar
James Laver committed
18

19 20
data MenuType = NewNgram | SetTermListItem

21
type Props =
22
  ( list :: Maybe TermList
23
  , menuType :: MenuType
James Laver's avatar
James Laver committed
24
  , setList :: TermList -> Effect Unit -- not a state hook setter
25
  )
26

27
type AnnotationMenu = { x :: Number, y :: Number | Props }
James Laver's avatar
James Laver committed
28 29 30

-- | An Annotation Menu is parameterised by a Maybe Termlist of the
-- | TermList the currently selected text belongs to
31
annotationMenu :: R2.Setter (Maybe AnnotationMenu) -> AnnotationMenu -> R.Element
32
annotationMenu setMenu { x,y,list,menuType,setList } =
33
  CM.contextMenu { x,y,setMenu } [
34
    R.createElement annotationMenuCpt {list,menuType,setList} []
35
  ]
James Laver's avatar
James Laver committed
36 37

annotationMenuCpt :: R.Component Props
38
annotationMenuCpt = R.hooksComponent "Annotation.Menu" cpt
James Laver's avatar
James Laver committed
39
  where
40 41
    cpt props _ = pure $ R.fragment $ children props
    children props = A.mapMaybe (addToList props) [ GraphTerm, CandidateTerm, StopTerm ]
James Laver's avatar
James Laver committed
42

43
-- | Given the TermList to render the item for zand the Maybe TermList the item may belong to, possibly render the menuItem
44 45 46
addToList :: Record Props -> TermList -> Maybe R.Element
addToList {list: Just t'} t
  | t == t'   = Nothing
47 48 49 50
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
Nicolas Pouillard's avatar
Nicolas Pouillard committed
51
    label SetTermListItem = "Change to " <> termListName t
52
    className = "list-group-item list-group-item-" <> (termBootstrapClass t)
53
    click = mkEffectFn1 $ \_ -> setList t