UpdateTerms.purs 4.54 KB
Newer Older
1 2 3 4
module Gargantext.Components.PhyloExplorer.Sidebar.UpdateTerms where

import Gargantext.Prelude

5 6 7
import Data.Array as A
import Data.Either (Either(..))
import Data.Tuple.Nested ((/\))
8
import Effect (Effect)
9 10
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
11 12 13 14
import Gargantext.Components.App.Store as AppStore
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), ComponentStatus(..), Variant(..))
import Gargantext.Components.PhyloExplorer.Store as PhyloStore
15 16 17 18 19 20 21 22
import Gargantext.Components.PhyloExplorer.Types (ListId, CorpusId)
import Gargantext.Config.REST (AffRESTError)
import Gargantext.Core.NgramsTable.Functions as NTC
import Gargantext.Core.NgramsTable.Types as CNT
import Gargantext.Hooks.Session (useSession)
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType, FrontendError(..), TabSubType(..), TabType(..), TermList(..))
import Gargantext.Utils ((?))
23
import Gargantext.Utils.Reactix as R2
24
import Gargantext.Utils.Toestand as T2
25 26
import Reactix as R
import Reactix.DOM.HTML as H
27
import Toestand as T
28 29 30 31

here :: R2.Here
here = R2.here "Gargantext.Components.PhyloExplorer.Sidebar.UpdateTerms"

32 33 34 35 36
type Props =
  ( selectedTerm    :: String
  , ngramType       :: CTabNgramType
   )

37 38 39
-- | @NOTE #408: only dealing with single Term selection
-- |             (hence not dealing with multiple selection, nor Branch,
-- |             nor Source → if so, please change the source code accordingly)
40
updateTerms :: R2.Leaf Props
41 42
updateTerms = R2.leaf updateTermsCpt

43
updateTermsCpt :: R.Component Props
44
updateTermsCpt = here.component "main" cpt where
45 46 47
  cpt { selectedTerm
      , ngramType
      } _ = do
48 49
    -- | States
    -- |
50 51
    session <- useSession

52 53 54 55
    { errors
    , reloadForest
    } <- AppStore.use

56
    store <- PhyloStore.use
57

58 59 60 61
    corpusId     <- R2.useLive' store.corpusId
    listId       <- R2.useLive' store.listId

    onPending' /\ onPending <- R2.useBox' false
62 63 64 65

    -- | Behaviors
    -- |
    let
66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
      onClick :: TermList -> Effect Unit
      onClick termList = launchAff_ do

        liftEffect do
          T.write_ true onPending

        res <- sendPatch
          termList
          session
          corpusId
          listId
          ngramType
          selectedTerm

        case res of
          Left err -> liftEffect do
            T.modify_ (A.cons $ FRESTError { error: err }) errors
            here.warn2 "[sendPatches] RESTError" err
          Right _ -> liftEffect do
            T2.reload reloadForest

        liftEffect do
          T.write_ false onPending
89 90 91 92 93 94 95 96 97 98

    -- | Render
    -- |
    pure $

      B.buttonGroup
      { collapse: false }
      [
        B.button
        { variant: ButtonVariant Light
99 100 101 102
        , status: onPending' ?
            Disabled $
            Enabled
        , callback: const $ onClick CandidateTerm
103 104 105 106 107 108 109 110 111 112 113 114
        }
        [
          B.icon
          { name: "circle"
          , className: "mr-1 candidate-term"
          }
        ,
          H.text "Move as candidate"
        ]
      ,
        B.button
        { variant: ButtonVariant Light
115 116 117 118
        , status: onPending' ?
            Disabled $
            Enabled
        , callback: const $ onClick StopTerm
119 120 121 122 123 124 125 126 127 128
        }
        [
          B.icon
          { name: "circle"
          , className: "mr-1 stop-term"
          }
        ,
          H.text "Move as stop"
        ]
      ]
129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177

sendPatch ::
     TermList
  -> Session
  -> CorpusId
  -> ListId
  -> CTabNgramType
  -> String
  -> AffRESTError CNT.VersionedNgramsPatches
sendPatch termList session corpusId listId tabNgramType label
    = NTC.putNgramsPatches coreParams versioned
  -- (!) in the future, as the like of Graph update terms, handling task
  -- >>= case _ of
      -- Left err -> pure $ Left err
      -- Right ret -> do
        -- _task <- NTC.postNgramsChartsAsync coreParams
        -- pure $ Right ret
  where
    -- @NOTE #408: currently no versioning for Phylo
    versioned :: CNT.VersionedNgramsPatches
    versioned
      = CNT.Versioned
          { version: 1
          , data: np
          }

    coreParams :: CNT.CoreParams ()
    coreParams
      = { session
        , nodeId: corpusId
        , listIds: [ listId ]
        , tabType: TabCorpus (TabNgramType tabNgramType)
        }

    term :: CNT.NgramsTerm
    term = NTC.normNgram tabNgramType label

    np :: CNT.NgramsPatches
    np = NTC.singletonPatchMap term $ CNT.NgramsPatch
          { patch_children: mempty
          , patch_list
          }

    patch_list :: CNT.Replace TermList
    patch_list
      = CNT.Replace
          { new: termList
          , old: MapTerm
          }