NgramsTable.purs 22.5 KB
Newer Older
1 2 3 4
module Gargantext.Components.NgramsTable
  ( MainNgramsTableProps
  , mainNgramsTable
  ) where
5

6
import Prelude
7 8 9
  ( class Show, Unit, bind, const, discard, identity, map, mempty, not
  , pure, show, unit, (#), ($), (&&), (+), (/=), (<$>), (<<<), (<>), (=<<)
  , (==), (||) )
10
import Control.Monad (unless)
11
import Data.Array as A
12 13
import Data.FunctorWithIndex (mapWithIndex)
import Data.Lens (Lens', to, view, (%~), (.~), (^.), (^..), (^?))
14
import Data.Lens.Common (_Just)
15 16 17
import Data.Lens.At (at)
import Data.Lens.Index (ix)
import Data.Lens.Fold (folded)
18 19 20 21
import Data.Lens.Record (prop)
import Data.List as List
import Data.Map (Map)
import Data.Map as Map
22
import Data.Maybe (Maybe(..), maybe, fromJust)
23
import Data.Monoid.Additive (Additive(..))
24
import Data.Ord.Down (Down(..))
25 26
import Data.Set (Set)
import Data.Set as Set
27
import Data.Symbol (SProxy(..))
28
import Data.Tuple (Tuple(..), snd)
29
import Data.Tuple.Nested ((/\))
30
import Effect (Effect)
31 32
import Reactix as R
import Reactix.DOM.HTML as H
33
import React (ReactClass, ReactElement, Children)
34 35
import React.DOM (a, i, input, li, span, text, ul)
import React.DOM.Props (_type, checked, className, onChange, onClick, style)
36
import React.DOM.Props as DOM
37 38
import Thermite as Thermite
import Thermite (modifyState_)
39 40 41
import Gargantext.Types
  ( CTabNgramType, OrderBy(..), TabType, TermList(..), readTermList
  , readTermSize, termLists, termSizes)
42
import Gargantext.Components.AutoUpdate (autoUpdateElt)
43
import Gargantext.Components.NgramsTable.Core
44 45
  ( CoreState, NgramsElement(..), NgramsPatch(..), NgramsTablePatch
  , NgramsTable, NgramsTerm, PageParams, Replace, Versioned(..)
46 47 48
  , VersionedNgramsTable, _NgramsElement, _NgramsTable, _children
  , _list, _ngrams, _occurrences, _root, addNewNgram, applyNgramsTablePatch
  , applyPatchSet, commitPatch, convOrderBy, initialPageParams, loadNgramsTable
49 50
  , patchSetFromMap, replace, singletonNgramsTablePatch, isEmptyNgramsTablePatch
  , normNgram, ngramsTermText, fromNgramsPatches, PatchMap(..), rootsOf )
51
import Gargantext.Components.Loader (loader)
52
import Gargantext.Components.Table as T
53
import Gargantext.Sessions (Session)
54
import Gargantext.Utils.Reactix as R2
55

56 57 58
import Partial.Unsafe (unsafePartial)
import Unsafe.Coerce (unsafeCoerce)

59
type State =
60 61
  CoreState
  ( ngramsParent     :: Maybe NgramsTerm -- Nothing means we are not currently grouping terms
62 63 64 65 66
  , ngramsChildren   :: Map NgramsTerm Boolean
                     -- ^ Used only when grouping.
                     --   This updates the children of `ngramsParent`,
                     --   ngrams set to `true` are to be added, and `false` to
                     --   be removed.
67 68 69 70
  , ngramsSelection  :: Set NgramsTerm
                     -- ^ The set of selected checkboxes of the first column.
  , ngramsSelectAll  :: Boolean
                     -- ^ The checkbox to select all the checkboxes of the first column.
71
  )
72

73
_ngramsChildren :: forall row. Lens' { ngramsChildren :: Map NgramsTerm Boolean | row } (Map NgramsTerm Boolean)
74 75
_ngramsChildren = prop (SProxy :: SProxy "ngramsChildren")

76 77 78 79 80 81
_ngramsSelectAll :: forall row. Lens' { ngramsSelectAll :: Boolean | row } Boolean
_ngramsSelectAll = prop (SProxy :: SProxy "ngramsSelectAll")

_ngramsSelection :: forall row. Lens' { ngramsSelection :: Set NgramsTerm | row } (Set NgramsTerm)
_ngramsSelection = prop (SProxy :: SProxy "ngramsSelection")

82 83
initialState :: VersionedNgramsTable -> State
initialState (Versioned {version}) =
84
  { ngramsTablePatch: mempty
85
  , ngramsVersion:    version
86 87
  , ngramsParent:     Nothing
  , ngramsChildren:   mempty
88 89
  , ngramsSelectAll:  false
  , ngramsSelection:  mempty
90 91 92
  }

data Action
93
  = CommitPatch NgramsTablePatch
94 95 96 97 98 99
  | SetParentResetChildren (Maybe NgramsTerm)
  -- ^ This sets `ngramsParent` and resets `ngramsChildren`.
  | ToggleChild Boolean NgramsTerm
  -- ^ Toggles the NgramsTerm in the `PatchSet` `ngramsChildren`.
  -- If the `Boolean` is `true` it means we want to add it if it is not here,
  -- if it is `false` it is meant to be removed if not here.
100
  | AddTermChildren
101
  | Refresh
102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
  | ToggleSelect NgramsTerm
  -- ^ Toggles the NgramsTerm in the `Set` `ngramsSelection`.
  | ToggleSelectAll

setTermListA :: NgramsTerm -> Replace TermList -> Action
setTermListA n patch_list =
  CommitPatch $
    singletonNgramsTablePatch n $
    NgramsPatch { patch_list, patch_children: mempty }

setTermListSetA :: NgramsTable -> Set NgramsTerm -> TermList -> Action
setTermListSetA ngramsTable ns new_list =
  CommitPatch $ fromNgramsPatches $ PatchMap $ mapWithIndex f $ toMap ns
  where
    f :: NgramsTerm -> Unit -> NgramsPatch
    f n unit = NgramsPatch { patch_list, patch_children: mempty }
      where
        cur_list = ngramsTable ^? at n <<< _Just <<< _NgramsElement <<< _list
        patch_list = replace (unsafePartial (fromJust cur_list)) new_list
    toMap :: forall a. Set a -> Map a Unit
    toMap = unsafeCoerce
    -- TODO https://github.com/purescript/purescript-ordered-collections/pull/21
    -- toMap = Map.fromFoldable

addNewNgramA :: NgramsTerm -> Action
addNewNgramA ngram = CommitPatch $ addNewNgram ngram CandidateTerm
128 129 130

type Dispatch = Action -> Effect Unit

131 132 133 134 135 136 137
tableContainer :: { path            :: R.State PageParams
                  , dispatch        :: Dispatch
                  , ngramsParent    :: Maybe NgramsTerm
                  , ngramsChildren  :: Map NgramsTerm Boolean
                  , ngramsSelection :: Set NgramsTerm
                  , ngramsTable     :: NgramsTable
                  , tabNgramType    :: CTabNgramType
138
                  }
139
               -> Record T.TableContainerProps -> R.Element
140
tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
141 142 143
               , dispatch
               , ngramsParent
               , ngramsChildren
144
               , ngramsSelection
145
               , ngramsTable: ngramsTableCache
146
               , tabNgramType
147
               } props =
148 149 150 151 152 153 154 155
  H.div {className: "container-fluid"}
  [ H.div {className: "jumbotron1"}
    [ H.div {className: "row"}
      [ H.div {className: "panel panel-default"}
        [ H.div {className: "panel-heading"}
          [ H.h2 {className: "panel-title", style: {textAlign : "center"}}
            [ H.span {className: "glyphicon glyphicon-hand-down"} []
            , H.text "Extracted Terms"
156
            ]
157 158 159 160 161 162
          , H.div {className: "row"}
            [ H.div {className: "col-md-3", style: {marginTop: "6px"}}
              [ H.input { className: "form-control"
                        , name: "search"
                        , placeholder: "Search"
                        , type: "value"
163
                        , value: searchQuery
164 165
                        , on: {input: \e -> setSearchQuery (R2.unsafeEventValue e)}}
              , H.div {} (
166
                   if A.null props.tableBody && searchQuery /= "" then [
167
                     H.button { className: "btn btn-primary"
168 169
                              , on: {click: const $ dispatch $ addNewNgramA $ normNgram tabNgramType searchQuery}
                              }
170
                     [ H.text ("Add " <> searchQuery) ]
171 172 173 174 175
                     ] else [])]
            , H.div {className: "col-md-2", style: {marginTop : "6px"}}
              [ H.li {className: " list-group-item"}
                [ R2.select { id: "picklistmenu"
                            , className: "form-control custom-select"
176
                            , value: (maybe "" show termListFilter)
177 178 179 180 181 182
                            , on: {change: (\e -> setTermListFilter $ readTermList $ R2.unsafeEventValue e)}}
                  (map optps1 termLists)]]
            , H.div {className: "col-md-2", style: {marginTop : "6px"}}
              [ H.li {className: "list-group-item"}
                [ R2.select {id: "picktermtype"
                            , className: "form-control custom-select"
183
                            , value: (maybe "" show termSizeFilter)
184 185 186 187 188 189 190
                            , on: {change: (\e -> setTermSizeFilter $ readTermSize $ R2.unsafeEventValue e)}}
                    (map optps1 termSizes)]]
            , H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}}
              [ H.li {className: " list-group-item"}
                [ props.pageSizeDescription
                , props.pageSizeControl
                , H.text " items / "
191 192 193 194 195 196 197 198 199 200 201 202 203 204
                , props.paginationLinks]]
            , H.div {className: "col-md-1", style: {marginTop : "6px", marginBottom : "1px"}}
              [ H.li {className: " list-group-item"}
                [ H.button { className: "btn btn-primary"
                           , on: {click: const $ dispatch $ setTermListSetA ngramsTableCache ngramsSelection GraphTerm }
                           }
                  [ H.text "Map" ]
                , H.button { className: "btn btn-primary"
                           , on: {click: const $ dispatch $ setTermListSetA ngramsTableCache ngramsSelection StopTerm }
                           }
                  [ H.text "Stop" ]
                ]
              ]
            ]]
205 206
        , H.div {}
          (maybe [] (\ngrams ->
207 208 209 210 211 212 213
              let
                ngramsTable =
                  ngramsTableCache # at ngrams
                                 <<< _Just
                                 <<< _NgramsElement
                                 <<< _children
                                 %~ applyPatchSet (patchSetFromMap ngramsChildren)
214 215 216
                ngramsClick {depth: 1, ngrams: child} =
                  Just $ dispatch $ ToggleChild false child
                ngramsClick _ = Nothing
217
                ngramsEdit _ = Nothing
218
              in
219
              [ H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
220
              , R2.buff $ renderNgramsTree { ngramsTable, ngrams, ngramsStyle: [], ngramsClick, ngramsEdit }
221
              , H.button {className: "btn btn-primary", on: {click: (const $ dispatch AddTermChildren)}} [H.text "Save"]
222
              , H.button {className: "btn btn-secondary", on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}} [H.text "Cancel"]
223
              ]) ngramsParent)
224 225 226 227
          , H.div {id: "terms_table", className: "panel-body"}
            [ H.table {className: "table able"}
              [ H.thead {className: "tableHeader"} [props.tableHead]
              , H.tbody {} props.tableBody]]]]]]
228
  where
229 230 231 232
    -- WHY setPath     f = origSetPageParams (const $ f path)
    setSearchQuery    x = setPath $ _ { searchQuery = x }
    setTermListFilter x = setPath $ _ { termListFilter = x }
    setTermSizeFilter x = setPath $ _ { termSizeFilter = x }
233

234 235 236
toggleMaybe :: forall a. a -> Maybe a -> Maybe a
toggleMaybe _ (Just _) = Nothing
toggleMaybe b Nothing  = Just b
237

238
-- NEXT
239 240 241 242 243
data Action'
  = SetParentResetChildren' (Maybe NgramsTerm)
  | ToggleChild' (Maybe NgramsTerm) NgramsTerm
  | Refresh'

244
-- NEXT
245
type Props =
246
  ( path         :: R.State PageParams
247
  , versioned    :: VersionedNgramsTable )
248

249
-- NEXT
250 251
loadedNgramsTable :: Record Props -> R.Element
loadedNgramsTable props = R.createElement loadedNgramsTableCpt props []
252

253
-- NEXT
254 255
loadedNgramsTableCpt :: R.Component Props
loadedNgramsTableCpt = R.hooksComponent "G.C.NgramsTable.loadedNgramsTable" cpt
256 257 258 259 260
  where
    cpt {versioned} _ = do
      state <- useNgramsReducer (initialState versioned)
      pure $ R.fragment []

261 262 263 264 265 266 267 268
    useNgramsReducer :: State -> R.Hooks (R.Reducer State Action')
    useNgramsReducer init = R2.useReductor' performNgramsAction init

    performNgramsAction :: Action' -> State -> Effect State
    performNgramsAction (SetParentResetChildren' term) = pure -- TODO
    performNgramsAction (ToggleChild' b c) = pure -- TODO
    performNgramsAction Refresh' = pure -- TODO

269 270 271 272 273 274 275 276
type LoadedNgramsTableProps =
  ( tabNgramType :: CTabNgramType
  , path         :: R.State PageParams
  , versioned    :: VersionedNgramsTable
  )

loadedNgramsTableSpec :: Thermite.Spec State (Record LoadedNgramsTableProps) Action
loadedNgramsTableSpec = Thermite.simpleSpec performAction render
277 278 279 280
  where
    setParentResetChildren :: Maybe NgramsTerm -> State -> State
    setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = mempty }

281
    performAction :: Thermite.PerformAction State (Record LoadedNgramsTableProps) Action
282 283 284
    performAction (SetParentResetChildren p) _ _ =
      modifyState_ $ setParentResetChildren p
    performAction (ToggleChild b c) _ _ =
285 286 287 288 289 290 291 292 293 294 295 296 297 298
      modifyState_ $ _ngramsChildren <<< at c %~ toggleMaybe b
    performAction (ToggleSelect c) _ _ =
      modifyState_ $ _ngramsSelection <<< at c %~ toggleMaybe unit
    performAction ToggleSelectAll _ { ngramsSelectAll: true } =
      modifyState_ $ (_ngramsSelection .~ mempty)
                 <<< (_ngramsSelectAll .~ false)
    performAction ToggleSelectAll { versioned: Versioned { data: initTable } }
                                  { ngramsTablePatch } =
      let
        ngramsTable = applyNgramsTablePatch ngramsTablePatch initTable
        roots = rootsOf ngramsTable
      in
      modifyState_ $ (_ngramsSelection .~ roots)
                 <<< (_ngramsSelectAll .~ true)
299
    performAction Refresh {path: path /\ _} {ngramsVersion} = do
300 301 302 303 304
      commitPatch path (Versioned {version: ngramsVersion, data: mempty})
      -- Here we purposedly send an empty patch as a way to synchronize with
      -- the server.
    performAction (CommitPatch pt) {path: path /\ _} {ngramsVersion} =
      unless (isEmptyNgramsTablePatch pt) $
305
        commitPatch path (Versioned {version: ngramsVersion, data: pt})
306

307 308 309
    performAction AddTermChildren _ {ngramsParent: Nothing} =
        -- impossible but harmless
        pure unit
310
    performAction AddTermChildren {path: path /\ _}
311 312
                  { ngramsParent: Just parent
                  , ngramsChildren
313
                  , ngramsVersion
314 315
                  } = do
        modifyState_ $ setParentResetChildren Nothing
316
        commitPatch path (Versioned {version: ngramsVersion, data: pt})
317 318 319
      where
        pc = patchSetFromMap ngramsChildren
        pe = NgramsPatch { patch_list: mempty, patch_children: pc }
320
        pt = singletonNgramsTablePatch parent pe
321

322
    render :: Thermite.Render State (Record LoadedNgramsTableProps) Action
323 324 325 326 327
    render dispatch { path: path@({scoreType, params} /\ setPath)
                    , versioned: Versioned { data: initTable }
                    , tabNgramType }
                    { ngramsTablePatch, ngramsParent, ngramsChildren,
                      ngramsSelection, ngramsSelectAll }
328
                    _reactChildren =
329
      [ autoUpdateElt { duration: 3000, effect: dispatch Refresh }
330
      , R2.scuff $ T.table { params: params /\ setParams -- TODO-LENS
331 332
                           , rows, container, colNames, wrapColElts, totalRecords
                           }
333
      ]
334 335
      where
        totalRecords = 47361 -- TODO
336 337 338 339 340 341 342 343 344 345 346 347 348
        colNames = T.ColumnName <$> ["Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy
        selected =
          input
            [ _type "checkbox"
            , className "checkbox"
            , checked ngramsSelectAll
            , onChange $ const $ dispatch $ ToggleSelectAll
            ]
        -- This is used to *decorate* the Select header with the checkbox.
        wrapColElts (T.ColumnName "Select") = const [R2.buff selected]
        wrapColElts (T.ColumnName "Score")  = (_ <> [H.text ("(" <> show scoreType <> ")")])
        wrapColElts _                       = identity
        container = tableContainer {path, dispatch, ngramsParent, ngramsChildren, ngramsSelection, ngramsTable, tabNgramType}
349
        setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
350 351
        ngramsTable = applyNgramsTablePatch ngramsTablePatch initTable
        orderWith =
352
          case convOrderBy <$> params.orderBy of
353 354 355 356 357 358 359 360 361
            Just ScoreAsc  -> A.sortWith \x -> (snd x) ^. _NgramsElement <<< _occurrences
            Just ScoreDesc -> A.sortWith \x -> Down $ (snd x) ^. _NgramsElement <<< _occurrences
            _              -> identity -- the server ordering is enough here

        rows = convertRow <$> orderWith (addOcc <$> Map.toUnfoldable (Map.filter displayRow (ngramsTable ^. _NgramsTable)))
        addOcc (Tuple ne ngramsElement) =
          let Additive occurrences = sumOccurrences ngramsTable ngramsElement in
          Tuple ne (ngramsElement # _NgramsElement <<< _occurrences .~ occurrences)

362
        ngramsParentRoot :: Maybe NgramsTerm
363
        ngramsParentRoot =
364
          (\np -> ngramsTable ^? at np <<< _Just <<< _NgramsElement <<< _root <<< _Just) =<< ngramsParent
365 366 367 368 369 370 371 372 373 374 375 376 377

        displayRow (NgramsElement {ngrams, root}) =
          root == Nothing
          -- ^ Display only nodes without parents
          && ngramsChildren ^. at ngrams /= Just true
          -- ^ and which are not scheduled to be added already
          && Just ngrams /= ngramsParent
          -- ^ and which are not our new parent
          && Just ngrams /= ngramsParentRoot
          -- ^ and which are not the root of our new parent
          || -- Unless they are scheduled to be removed.
          ngramsChildren ^. at ngrams == Just false
        convertRow (Tuple ngrams ngramsElement) =
378 379 380
          { row: R2.buff <$> renderNgramsItem { ngramsTable, ngrams,
                                                ngramsParent, ngramsElement,
                                                ngramsSelection, dispatch }
381 382 383
          , delete: false
          }

384 385 386
loadedNgramsTableClass :: ReactClass { children :: Children | LoadedNgramsTableProps }
loadedNgramsTableClass = Thermite.createClass "LoadedNgramsNgramsTable"
  loadedNgramsTableSpec (\{versioned} -> initialState versioned)
387

388 389
loadedNgramsTable' :: Record LoadedNgramsTableProps -> R.Element
loadedNgramsTable' props = R2.createElement' (loadedNgramsTableClass) props []
390 391

type MainNgramsTableProps =
392
  ( nodeId        :: Int
393 394 395
    -- ^ This node can be a corpus or contact.
  , defaultListId :: Int
  , tabType       :: TabType
396
  , session       :: Session
397 398
  , tabNgramType  :: CTabNgramType
  )
399

400 401
mainNgramsTable :: Record MainNgramsTableProps -> R.Element
mainNgramsTable props = R.createElement mainNgramsTableCpt props []
402

403 404 405
mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponent "MainNgramsTable" cpt
  where
406
    cpt {nodeId, defaultListId, tabType, session, tabNgramType} _ = do
407 408 409
      path /\ setPath <- R.useState' $ initialPageParams session nodeId [defaultListId] tabType
      let paint versioned = loadedNgramsTable' {tabNgramType, path: path /\ setPath, versioned}
      pure $ loader path loadNgramsTable paint
410

411 412 413
type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int}
type NgramsClick = NgramsDepth -> Maybe (Effect Unit)

414 415
tree :: { ngramsTable :: NgramsTable
        , ngramsStyle :: Array DOM.Props
416
        , ngramsEdit  :: NgramsClick
417 418
        , ngramsClick :: NgramsClick
        } -> NgramsDepth -> ReactElement
419
tree params@{ngramsTable, ngramsStyle, ngramsEdit, ngramsClick} nd =
420
  li [ style {width : "100%"} ]
421
    ([ i icon []
422
     , tag [text $ " " <> ngramsTermText nd.ngrams]
423 424 425
     ] <> maybe [] edit (ngramsEdit nd) <>
     [ forest cs
     ])
426 427
  where
    tag =
428
      case ngramsClick nd of
429 430 431 432
        Just effect ->
          a (ngramsStyle <> [onClick $ const effect])
        Nothing ->
          span ngramsStyle
433 434 435
    edit effect = [ text " "
                  , i [ className "glyphicon glyphicon-pencil"
                      , onClick $ const effect ] [] ]
436
    leaf = List.null cs
437
    icon = gray <> [className $ "glyphicon glyphicon-chevron-" <> if open then "down" else "right"]
438 439
    open = not leaf || false {- TODO -}
    gray = if leaf then [style {color: "#adb5bd"}] else []
440
    cs   = ngramsTable ^.. ix nd.ngrams <<< _NgramsElement <<< _children <<< folded
441

442 443 444
    forest =
      let depth = nd.depth + 1 in
      ul [] <<< map (\ngrams -> tree params {depth, ngrams}) <<< List.toUnfoldable
445

446 447 448 449 450 451 452 453
sumOccurrences' :: NgramsTable -> NgramsTerm -> Additive Int
sumOccurrences' ngramsTable label =
    ngramsTable ^. ix label <<< to (sumOccurrences ngramsTable)

sumOccurrences :: NgramsTable -> NgramsElement -> Additive Int
sumOccurrences ngramsTable (NgramsElement {occurrences, children}) =
    Additive occurrences <> children ^. folded <<< to (sumOccurrences' ngramsTable)

454 455 456
renderNgramsTree :: { ngrams      :: NgramsTerm
                    , ngramsTable :: NgramsTable
                    , ngramsStyle :: Array DOM.Props
457
                    , ngramsClick :: NgramsClick
458
                    , ngramsEdit  :: NgramsClick
459
                    } -> ReactElement
460
renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit } =
461
  ul [] [
462
    span [className "tree"] [tree {ngramsTable, ngramsStyle, ngramsClick, ngramsEdit} {ngrams, depth: 0}]
463 464 465 466
  ]

renderNgramsItem :: { ngrams :: NgramsTerm
                    , ngramsTable :: NgramsTable
467
                    , ngramsElement :: NgramsElement
468
                    , ngramsParent :: Maybe NgramsTerm
469
                    , ngramsSelection :: Set NgramsTerm
470 471
                    , dispatch :: Action -> Effect Unit
                    } -> Array ReactElement
472 473 474 475
renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent
                 , ngramsSelection, dispatch } =
  [ selected
  , checkbox GraphTerm
476 477
  , checkbox StopTerm
  , if ngramsParent == Nothing
478
    then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }
479 480
    else
      a [onClick $ const $ dispatch $ ToggleChild true ngrams]
481
        [ i [className "glyphicon glyphicon-plus"] []
482
        , span ngramsStyle [text $ " " <> ngramsTermText ngrams]
483
        ]
484
  , text $ show (ngramsElement ^. _NgramsElement <<< _occurrences)
485 486
  ]
  where
487
    termList    = ngramsElement ^. _NgramsElement <<< _list
488
    ngramsStyle = [termStyle termList]
489
    ngramsEdit  = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams
490 491 492 493 494 495 496 497
    ngramsClick = Just <<< dispatch <<< cycleTermListItem <<< view _ngrams
    selected    =
      input
        [ _type "checkbox"
        , className "checkbox"
        , checked $ Set.member ngrams ngramsSelection
        , onChange $ const $ dispatch $ ToggleSelect ngrams
        ]
498 499 500 501 502 503 504 505
    checkbox termList' =
      let chkd = termList == termList'
          termList'' = if chkd then CandidateTerm else termList'
      in
      input
        [ _type "checkbox"
        , className "checkbox"
        , checked chkd
506 507
        , onChange $ const $ dispatch $
            setTermListA ngrams (replace termList termList'')
508 509
        ]

510
    cycleTermListItem n = setTermListA n (replace termList (nextTermList termList))
511 512 513 514 515 516

termStyle :: TermList -> DOM.Props
termStyle GraphTerm     = style {color: "green"}
termStyle StopTerm      = style {color: "red", textDecoration : "line-through"}
termStyle CandidateTerm = style {color: "black"}

517 518 519 520 521
nextTermList :: TermList -> TermList
nextTermList GraphTerm     = StopTerm
nextTermList StopTerm      = CandidateTerm
nextTermList CandidateTerm = GraphTerm

522 523 524
optps1 :: forall a. Show a => { desc :: String, mval :: Maybe a } -> R.Element
optps1 { desc, mval } = H.option {value} [H.text desc]
  where value = maybe "" show mval