Code.purs 5.86 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 20 21 22
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)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, sessionId)
arturo's avatar
arturo committed
23
import Gargantext.Utils ((?))
24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
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
48
corpusCodeLayout = R2.leaf corpusCodeLayoutCpt
49
corpusCodeLayoutCpt :: R.Component Props
50 51
corpusCodeLayoutCpt = R2.hereComponent here "corpusCodeLayout" hCpt where
  hCpt hp { nodeId, session, boxes } _ = do
52 53
    reload <- T.useBox T2.newReload
    reload' <- T.useLive T.unequal reload
54
    useLoader { errorHandler: Nothing
55
              , herePrefix: hp
56 57 58 59 60 61 62 63 64
              , loader: loadCorpusWithReload
              , path: { nodeId, reload: reload', session }
              , render: \corpus -> corpusCodeView { corpus, nodeId, reload, session, boxes } }

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
65
    let fieldsWithIndex = FTFieldsWithIndex $ mapWithIndex (\idx -> \ftField -> { idx, ftField }) fields
66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
    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
84
      { className: "corpus-code-layout" }
85 86
      [
        H.div
arturo's avatar
arturo committed
87
        { className: "corpus-code-layout__toolbar" }
88
        [
arturo's avatar
arturo committed
89 90 91 92 93
          tileMenu
          { boxes
          , currentTile: Just corpusRoute
          , xTile: Just corpusRoute
          , yTile: Just corpusRoute
94
          }
arturo's avatar
arturo committed
95 96 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
          [
            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"
            ]
          ]
150 151 152
        ]
      ,
        H.div
arturo's avatar
arturo committed
153
        { className: "corpus-code-layout__fields" }
154 155 156 157
        [
          fieldsCodeEditor
          { fields: fieldsS
          , nodeId
arturo's avatar
arturo committed
158 159
          , session
          } []
160 161 162
        ]
      ]

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

  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
177
              Left err -> here.warn2 "[corpusLayoutView] onClickSave RESTError" err
178 179 180 181 182 183 184
              _ -> 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