Components.purs 10.1 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
module Gargantext.Components.NgramsTable.Components where

import Data.Lens ((^..), (^.), view)
import Data.Lens.At (at)
import Data.Lens.Fold (folded)
import Data.Lens.Index (ix)
import Data.List (null, toUnfoldable) as L
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Nullable (null, toMaybe)
import Data.Set (Set)
import Data.Set as Set
import React.DOM (a, span, text)
import React.DOM.Props as DOM
import Effect (Effect)
import FFI.Simple (delay)
import Reactix as R
import Reactix.DOM.HTML as H

import Gargantext.Prelude
20
import Gargantext.Components.NgramsTable.Core
21
import Gargantext.Components.Nodes.Lists.Types as NT
22 23 24 25
import Gargantext.Components.Table as Tbl
import Gargantext.Types as T
import Gargantext.Utils.Reactix as R2

26 27
thisModule = "Gargantext.Components.NgramsTable.Components"

28
type SearchInputProps =
29
  ( key :: String  -- to prevent refreshing & losing input
30 31 32 33 34 35 36 37
  , onSearch :: String -> Effect Unit
  , searchQuery :: String
  )

searchInput :: Record SearchInputProps -> R.Element
searchInput props = R.createElement searchInputCpt props []

searchInputCpt :: R.Component SearchInputProps
38
searchInputCpt = R.hooksComponentWithModule thisModule "searchInput" cpt
39
  where
40 41 42
    cpt { onSearch, searchQuery } _ = 
      pure $ H.div { className: "input-group" }
           [ searchButton
43
           , fieldInput
44 45 46 47 48 49 50 51 52 53 54 55 56
           ]
        where
          searchButton = 
            H.div { className: "input-group-addon" }
                  [
                   if searchQuery /= ""
                       then removeButton
                       else H.span { className: "fa fa-search" } []
                  ]
          removeButton =
            H.button { className: "btn btn-danger"
                     , on: {click: \e -> onSearch ""}}
                     [ H.span {className: "fa fa-times"} []]
57

58 59 60 61 62 63 64 65
          fieldInput  = 
            H.input { className: "form-control"
                    , defaultValue: searchQuery
                    , name: "search"
                    , on: { input: onSearch <<< R.unsafeEventValue }
                    , placeholder: "Search"
                    , type: "value"
                    }
66 67

type SelectionCheckboxProps =
68
  ( allNgramsSelected :: Boolean
69 70 71 72 73 74 75 76
  , dispatch          :: Dispatch
  , ngramsSelection   :: Set NgramsTerm
  )

selectionCheckbox :: Record SelectionCheckboxProps -> R.Element
selectionCheckbox props = R.createElement selectionCheckboxCpt props []

selectionCheckboxCpt :: R.Component SelectionCheckboxProps
77
selectionCheckboxCpt = R.hooksComponentWithModule thisModule "selectionCheckbox" cpt
78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
  where
    cpt { allNgramsSelected, dispatch, ngramsSelection } _ = do
      ref <- R.useRef null

      R.useEffect' $ delay unit $ \_ -> do
        let mCb = toMaybe $ R.readRef ref
        case mCb of
          Nothing -> pure unit
          Just cb -> do
            _ <- if allNgramsSelected || (Set.isEmpty ngramsSelection) then
              R2.setIndeterminateCheckbox cb false
            else
              R2.setIndeterminateCheckbox cb true
            pure unit

      pure $ H.input { checked: allNgramsSelected
                     , className: "checkbox"
                     , on: { change: const $ dispatch $ ToggleSelectAll }
                     , ref
                     , type: "checkbox" }


type RenderNgramsTree =
  ( ngrams      :: NgramsTerm
  , ngramsClick :: NgramsClick
  , ngramsEdit  :: NgramsClick
  , ngramsStyle :: Array DOM.Props
  , ngramsTable :: NgramsTable
  )

renderNgramsTree :: Record RenderNgramsTree -> R.Element
renderNgramsTree p = R.createElement renderNgramsTreeCpt p []

renderNgramsTreeCpt :: R.Component RenderNgramsTree
112
renderNgramsTreeCpt = R.hooksComponentWithModule thisModule "renderNgramsTree" cpt
113 114 115 116
  where
    cpt { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit } _ =
      pure $ H.ul {} [
        H.span { className: "tree" } [
117 118 119 120 121 122 123 124
          H.span { className: "righthanded" } [
            tree { ngramsClick
                 , ngramsDepth: {ngrams, depth: 0}
                 , ngramsEdit
                 , ngramsStyle
                 , ngramsTable
                 }
          ]
125 126 127 128 129 130 131 132
        ]
      ]


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

type TreeProps =
133
  ( ngramsClick :: NgramsClick
134 135 136 137 138 139 140 141 142 143
  , ngramsDepth :: NgramsDepth
  , ngramsEdit  :: NgramsClick
  , ngramsStyle :: Array DOM.Props
  , ngramsTable :: NgramsTable
  )

tree :: Record TreeProps -> R.Element
tree p = R.createElement treeCpt p []

treeCpt :: R.Component TreeProps
144
treeCpt = R.hooksComponentWithModule thisModule "tree" cpt
145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167
  where
    cpt params@{ ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle, ngramsTable } _ =
      pure $
        H.li { style: {width : "100%"} }
          ([ H.i { className, style } [] ]
           <> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ]
           <> maybe [] edit (ngramsEdit ngramsDepth)
           <> [ forest cs ])
      where
        tag =
          case ngramsClick ngramsDepth of
            Just effect ->
              a (ngramsStyle <> [DOM.onClick $ const effect])
            Nothing ->
              span ngramsStyle
        edit effect = [ H.text " "
                      , H.i { className: "glyphicon glyphicon-pencil"
                            , on: { click: const effect } } []
                      ]
        leaf = L.null cs
        className = "glyphicon glyphicon-chevron-" <> if open then "down" else "right"
        style = if leaf then {color: "#adb5bd"} else {color: ""}
        open = not leaf || false {- TODO -}
168
        cs   = ngramsTable ^.. ix ngramsDepth.ngrams <<< _NgramsRepoElement <<< _children <<< folded
Nicolas Pouillard's avatar
Nicolas Pouillard committed
169
        -- cs has a list is ok, the length is the number of direct children of an ngram which is generally < 10.
170 171 172

        forest =
          let depth = ngramsDepth.depth + 1 in
173 174 175 176
          if depth > 10 then
            const $ H.text "ERROR DEPTH > 10"
          else
            H.ul {} <<< map (\ngrams -> tree (params { ngramsDepth = {depth, ngrams} })) <<< L.toUnfoldable
177 178


179 180 181 182 183 184 185 186 187
type RenderNgramsItem = (
    dispatch          :: Action -> Effect Unit
  , ngrams            :: NgramsTerm
  , ngramsElement     :: NgramsElement
  , ngramsLocalPatch  :: NgramsTablePatch
  , ngramsParent      :: Maybe NgramsTerm
  , ngramsSelection   :: Set NgramsTerm
  , ngramsTable       :: NgramsTable
  , sidePanelTriggers :: Record NT.SidePanelTriggers
188 189
  )

190 191
renderNgramsItem :: R2.Component RenderNgramsItem
renderNgramsItem = R.createElement renderNgramsItemCpt
192 193

renderNgramsItemCpt :: R.Component RenderNgramsItem
194
renderNgramsItemCpt = R.hooksComponentWithModule thisModule "renderNgramsItem" cpt
195 196 197 198 199 200 201
  where
    cpt { dispatch
        , ngrams
        , ngramsElement
        , ngramsLocalPatch
        , ngramsParent
        , ngramsSelection
202 203 204
        , ngramsTable
        , sidePanelTriggers: { toggleSidePanel }
        } _ = do
205
      pure $ Tbl.makeRow [
206
          H.div { className: "ngrams-selector" } [
207
            H.span { className: "ngrams-chooser fa fa-eye-slash"
208 209
                   , on: { click: onClick } } []
          ]
210
        , selected
211
        , checkbox T.MapTerm
212
        , checkbox T.StopTerm
213 214 215 216 217 218 219 220 221
        , H.div {} [
          if ngramsParent == Nothing
            then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }
            else
              H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } } [
                  H.i { className: "glyphicon glyphicon-plus" } []
                , (R2.buff $ span ngramsStyle [text $ " " <> ngramsTermText ngrams])
              ]
        ]
222 223 224
        , H.text $ show (ngramsElement ^. _NgramsElement <<< _occurrences)
      ]
      where
225 226
        onClick _ = do
          R2.callTrigger toggleSidePanel unit
227 228 229 230
        termList    = ngramsElement ^. _NgramsElement <<< _list
        ngramsStyle = [termStyle termList ngramsOpacity]
        ngramsEdit  = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams
        ngramsClick
231
          = Just <<< dispatch <<< CoreAction <<< cycleTermListItem <<< view _ngrams
232 233 234 235 236 237 238 239 240 241 242
          -- ^ This is the old behavior it is nicer to use since one can
          --   rapidly change the ngram list without waiting for confirmation.
          --   However this might expose bugs. One of them can be reproduced
          --   by clicking a multiple times on the same ngram, sometimes it stays
          --   transient.
          -- | ngramsTransient = const Nothing
          -- | otherwise       = Just <<< dispatch <<< cycleTermListItem <<< view _ngrams
        selected    =
          H.input { checked: Set.member ngrams ngramsSelection
                  , className: "checkbox"
                  , on: { change: const $ dispatch $ ToggleSelect ngrams }
243 244
                  , type: "checkbox"
                  }
245 246 247 248 249 250
        checkbox termList' =
          let chkd = termList == termList'
              termList'' = if chkd then T.CandidateTerm else termList'
          in
          H.input { checked: chkd
                  , className: "checkbox"
251
                  , on: { change: const $ dispatch $ CoreAction $
252 253 254 255 256 257 258 259 260 261 262 263 264
                          setTermListA ngrams (replace termList termList'') }
                  , readOnly: ngramsTransient
                  , type: "checkbox" }
        ngramsTransient = tablePatchHasNgrams ngramsLocalPatch ngrams
          -- ^ TODO here we do not look at ngramsNewElems, shall we?
        ngramsOpacity
          | ngramsTransient = 0.5
          | otherwise       = 1.0

        cycleTermListItem n = setTermListA n (replace termList (nextTermList termList))


termStyle :: T.TermList -> Number -> DOM.Props
265
termStyle T.MapTerm     opacity = DOM.style { color: "green", opacity }
266 267 268 269 270 271 272 273 274 275
termStyle T.StopTerm      opacity = DOM.style { color: "red",   opacity
                                              , textDecoration: "line-through" }
termStyle T.CandidateTerm opacity = DOM.style { color: "black", opacity }

tablePatchHasNgrams :: NgramsTablePatch -> NgramsTerm -> Boolean
tablePatchHasNgrams ngramsTablePatch ngrams =
  isJust $ ngramsTablePatch.ngramsPatches ^. _PatchMap <<< at ngrams


nextTermList :: T.TermList -> T.TermList
276
nextTermList T.MapTerm     = T.StopTerm
277
nextTermList T.StopTerm      = T.CandidateTerm
278
nextTermList T.CandidateTerm = T.MapTerm