Code.purs 5.92 KB
Newer Older
1 2
module Gargantext.Components.Nodes.Corpus.Code where

arturo's avatar
arturo committed
3 4
import Gargantext.Prelude

5
import Data.Either (Either(..))
6
import Data.FunctorWithIndex (mapWithIndex)
7 8 9 10 11
import Data.List as List
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
arturo's avatar
arturo committed
12
import Gargantext.Components.App.Store (Boxes)
arturo's avatar
arturo committed
13 14 15
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), ComponentStatus(..), Sizing(..), Variant(..))
import Gargantext.Components.Corpus.CodeSection (fieldsCodeEditor, loadCorpusWithReload, saveCorpus)
16 17 18 19
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus.Types (Hyperdata(..))
import Gargantext.Components.Nodes.Types (FTFieldList(..), FTFieldsWithIndex(..), defaultField)
import Gargantext.Components.TileMenu (tileMenu)
20
import Gargantext.Config.REST (logRESTError)
21 22 23
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, sessionId)
arturo's avatar
arturo committed
24
import Gargantext.Utils ((?))
25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T

here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Code"

type Props =
  ( nodeId          :: Int
  , session         :: Session
  , boxes           :: Boxes
  )

type ViewProps =
  ( corpus  :: NodePoly Hyperdata
  , nodeId  :: Int
  , reload  :: T2.ReloadS
  , session :: Session
  , boxes   :: Boxes
  )

corpusCodeLayout :: R2.Leaf Props
49
corpusCodeLayout = R2.leaf corpusCodeLayoutCpt
50 51 52 53 54 55 56 57 58 59
corpusCodeLayoutCpt :: R.Component Props
corpusCodeLayoutCpt = here.component "corpusCodeLayout" cpt where
  cpt { nodeId, session, boxes } _ = do
    reload <- T.useBox T2.newReload
    reload' <- T.useLive T.unequal reload
    useLoader { errorHandler
              , loader: loadCorpusWithReload
              , path: { nodeId, reload: reload', session }
              , render: \corpus -> corpusCodeView { corpus, nodeId, reload, session, boxes } }
    where
60
      errorHandler = logRESTError here "[corpusLayoutWithKey]"
61 62 63 64 65 66

corpusCodeView :: Record ViewProps -> R.Element
corpusCodeView props = R.createElement corpusCodeViewCpt props []
corpusCodeViewCpt :: R.Component ViewProps
corpusCodeViewCpt = here.component "corpusCodeView" cpt where
  cpt {corpus: (NodePoly {hyperdata: Hyperdata {fields: FTFieldList fields}}), nodeId, reload, session, boxes} _ = do
67
    let fieldsWithIndex = FTFieldsWithIndex $ mapWithIndex (\idx -> \ftField -> { idx, ftField }) fields
68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85
    fieldsS <- T.useBox fieldsWithIndex
    fields' <- T.useLive T.unequal fieldsS
    fieldsRef <- R.useRef fields

    -- handle props change of fields
    R.useEffect1' fields $ do
      if R.readRef fieldsRef == fields then
        pure unit
      else do
        R.setRef fieldsRef fields
        T.write_ fieldsWithIndex fieldsS

    corpusRoute <- pure $ const do
      pure $ GR.Corpus (sessionId session) nodeId

    pure $

      H.div
arturo's avatar
arturo committed
86
      { className: "corpus-code-layout" }
87 88
      [
        H.div
arturo's avatar
arturo committed
89
        { className: "corpus-code-layout__toolbar" }
90
        [
arturo's avatar
arturo committed
91 92 93 94 95
          tileMenu
          { boxes
          , currentTile: Just corpusRoute
          , xTile: Just corpusRoute
          , yTile: Just corpusRoute
96
          }
arturo's avatar
arturo committed
97 98 99 100 101 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 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151
          [
            B.button
            { callback: const $ pure unit
            , status: Muted
            , size: SmallSize
            , variant: ButtonVariant Secondary
            }
            [
              B.icon
              { name: "folder" }
            ,
              B.wad_
              [ "d-inline-block", "virtual-space", "w-1" ]
            ,
              H.text "Folders section"
            ]
          ]
        ,
          B.wad
          [ "d-flex", "justify-content-flex-end gap-1" ]
          [
            B.button
            { callback: onClickAdd fieldsS
            , variant: OutlinedButtonVariant Primary
            }
            [
              B.icon
              { name: "plus" }
            ,
              B.wad_
              [ "d-inline-block", "virtual-spacer", "w-1" ]
            ,
              H.text "New field"
            ]
          ,
            B.button
            { variant: ButtonVariant Primary
            , status: saveEnabled fieldsWithIndex fields'
            , callback: onClickSave
                          { fields: fields'
                          , nodeId
                          , reload
                          , session
                          }
            }
            [
              B.icon
              { name: "floppy-o" }
            ,
              B.wad_
              [ "d-inline-flex", "virtual-space", "w-1" ]
            ,
              H.text "Save changes"
            ]
          ]
152 153 154
        ]
      ,
        H.div
arturo's avatar
arturo committed
155
        { className: "corpus-code-layout__fields" }
156 157 158 159
        [
          fieldsCodeEditor
          { fields: fieldsS
          , nodeId
arturo's avatar
arturo committed
160 161
          , session
          } []
162 163 164
        ]
      ]

arturo's avatar
arturo committed
165 166
  saveEnabled :: FTFieldsWithIndex -> FTFieldsWithIndex -> ComponentStatus
  saveEnabled fs fsS = fs == fsS ? Disabled $ Enabled
167 168 169 170 171 172 173 174 175 176 177 178

  onClickSave :: forall e. { fields :: FTFieldsWithIndex
                            , nodeId :: Int
                            , reload :: T2.ReloadS
                            , session :: Session } -> e -> Effect Unit
  onClickSave {fields: FTFieldsWithIndex fields, nodeId, reload, session} _ = do
    launchAff_ do
      res <- saveCorpus $ { hyperdata: Hyperdata {fields: FTFieldList $ (_.ftField) <$> fields}
                          , nodeId
                          , session }
      liftEffect $ do
        _ <- case res of
arturo's avatar
arturo committed
179
              Left err -> here.warn2 "[corpusLayoutView] onClickSave RESTError" err
180 181 182 183 184 185 186
              _ -> pure unit
        T2.reload reload

  onClickAdd :: forall e. T.Box FTFieldsWithIndex -> e -> Effect Unit
  onClickAdd fieldsS _ = do
    T.modify_ (\(FTFieldsWithIndex fs) -> FTFieldsWithIndex $
      List.snoc fs $ { idx: List.length fs, ftField: defaultField }) fieldsS