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


import Data.Array as A
6
import Data.Generic.Rep (class Generic)
7
import Data.Eq.Generic (genericEq)
8 9 10
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Uncurried (mkEffectFn1)
James Laver's avatar
James Laver committed
11
import Reactix as R
12
import Reactix.DOM.HTML as HTML
13 14 15
import Toestand as T

import Gargantext.Prelude
James Laver's avatar
James Laver committed
16

17 18
import Gargantext.Types (TermList(..), termListName)
import Gargantext.Components.Annotation.Utils (termBootstrapClass)
James Laver's avatar
James Laver committed
19 20

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

23 24
here :: R2.Here
here = R2.here "Gargantext.Components.Annotation.Menu"
25

26
data MenuType = NewNgram | SetTermListItem
27 28
derive instance Generic MenuType _
instance Eq MenuType where
29
  eq = genericEq
30

31
type Props =
32
  ( list     :: Maybe TermList
33
  , menuType :: MenuType
34
  , setList  :: TermList -> Effect Unit -- not a state hook setter
35
  )
36

37
type AnnotationMenu = (
38 39 40 41
    onClose    :: Effect Unit
  , redrawMenu :: T.Box Boolean
  , x          :: Number
  , y          :: Number
42
  | Props
43
  )
James Laver's avatar
James Laver committed
44

45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
type AnnotationMenuWrapper =
  (
    menuRef :: R.Ref (Maybe (Record AnnotationMenu))
  )

eqAnnotationMenu :: Record AnnotationMenu -> Record AnnotationMenu -> Boolean
eqAnnotationMenu new old = new.list == old.list &&
                           new.menuType == old.menuType &&
                           new.x == old.x &&
                           new.y == old.y

eqAnnotationMenuWrapper :: { new :: Maybe (Record AnnotationMenu)
                           , old :: Maybe (Record AnnotationMenu) } -> Effect Boolean
eqAnnotationMenuWrapper { new: Nothing, old: Nothing } = pure $ true
eqAnnotationMenuWrapper { new: Nothing, old: Just _ } = pure $ false
eqAnnotationMenuWrapper { new: Just _, old: Nothing } = pure $ false
eqAnnotationMenuWrapper { new: Just n, old: Just o } = pure $ eqAnnotationMenu n o

annotationMenuWrapper :: R2.Leaf AnnotationMenuWrapper
annotationMenuWrapper p = R.createElement annotationMenuWrapperCpt p []
annotationMenuWrapperCpt :: R.Component AnnotationMenuWrapper
annotationMenuWrapperCpt = here.component "annotationMenuWrapper" cpt where
  cpt { menuRef } _ = do
    case R.readRef menuRef of
      Nothing -> pure $ HTML.div {} []
      Just menu -> pure $ annotationMenu menu

James Laver's avatar
James Laver committed
72 73
-- | An Annotation Menu is parameterised by a Maybe Termlist of the
-- | TermList the currently selected text belongs to
74 75 76 77
annotationMenu :: R2.Leaf AnnotationMenu
annotationMenu p = R.createElement annotationMenuCpt p []
annotationMenuCpt :: R.Component AnnotationMenu
annotationMenuCpt = here.component "annotationMenu" cpt where
78 79 80
  cpt { x, y, list, menuType, onClose, redrawMenu, setList } _ = do
    redrawMenu' <- T.useLive T.unequal redrawMenu

81 82 83 84 85 86 87 88 89
    pure $ CM.contextMenu {x, y, onClose} [
        annotationMenuInner { list, menuType, setList }
      ]

annotationMenuInner :: R2.Leaf Props
annotationMenuInner p = R.createElement annotationMenuInnerCpt p []
annotationMenuInnerCpt :: R.Component Props
annotationMenuInnerCpt = here.component "annotationMenuInner" cpt where
  cpt props _ = pure $ R.fragment $ A.mapMaybe (addToList props) [ MapTerm, CandidateTerm, StopTerm ]
James Laver's avatar
James Laver committed
90

91
-- | Given the TermList to render the item for zand the Maybe TermList the item may belong to, possibly render the menuItem
92 93 94
addToList :: Record Props -> TermList -> Maybe R.Element
addToList {list: Just t'} t
  | t == t'   = Nothing
95
addToList {menuType, setList} t = Just $ CM.contextMenuItem {} [ link ]
96
  where
97
    link = HTML.a { on: { click }, className: className } [ HTML.text (label menuType) ]
98
    label NewNgram = "Add to " <> termListName t
Nicolas Pouillard's avatar
Nicolas Pouillard committed
99
    label SetTermListItem = "Change to " <> termListName t
100
    className = "list-group-item list-group-item-" <> (termBootstrapClass t)
101
    click _ = setList t