Menu.purs 1.85 KB
Newer Older
James Laver's avatar
James Laver committed
1 2 3 4 5 6
-- | 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
7
import Data.Maybe ( Maybe(..), maybe' )
James Laver's avatar
James Laver committed
8 9 10
import Effect ( Effect )
import Effect.Uncurried ( mkEffectFn1 )
import Reactix as R
11 12
import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E
James Laver's avatar
James Laver committed
13 14 15 16 17 18

import Gargantext.Types ( TermList(..), termListName )
import Gargantext.Components.Annotation.Utils ( termClass )

import Gargantext.Components.ContextMenu.ContextMenu as CM

19 20 21
type Props = ( list :: Maybe TermList )

type AnnotationMenu = { x :: Number, y :: Number, list :: Maybe TermList }
James Laver's avatar
James Laver committed
22 23 24

-- | An Annotation Menu is parameterised by a Maybe Termlist of the
-- | TermList the currently selected text belongs to
25 26 27
annotationMenu :: (Maybe AnnotationMenu -> Effect Unit) -> AnnotationMenu -> R.Element
annotationMenu setMenu { x,y,list } =
  CM.contextMenu { x,y,setMenu } [ R.createElement annotationMenuCpt {list} [] ]
James Laver's avatar
James Laver committed
28 29

annotationMenuCpt :: R.Component Props
30
annotationMenuCpt = R.hooksComponent "Annotation.Menu" cpt
James Laver's avatar
James Laver committed
31
  where
32
    cpt { list } _ = pure $ R.fragment $ children list
James Laver's avatar
James Laver committed
33 34
    children l = A.mapMaybe (\l' -> addToList l' l) [ GraphTerm, CandidateTerm, StopTerm ]

35
-- | Given the TermList to render the item for zand the Maybe TermList the item may belong to, possibly render the menuItem
James Laver's avatar
James Laver committed
36 37 38 39 40
addToList :: TermList -> Maybe TermList -> Maybe R.Element
addToList t (Just t')
  | t == t' = Nothing
  | true = addToList t Nothing
addToList t _ = Just $ CM.contextMenuItem [ link ]
41
  where link = HTML.a { onClick: click, className: className } [ HTML.text label ]
James Laver's avatar
James Laver committed
42 43 44 45 46 47 48 49
        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