WriteNodesDocuments.purs 3.75 KB
Newer Older
1 2 3 4 5 6
module Gargantext.Components.Forest.Tree.Node.Action.WriteNodesDocuments where

import Gargantext.Prelude

import Data.Either (Either)
import Data.Maybe (Maybe(..))
7
import Data.Tuple.Nested ((/\))
8
import Effect.Aff (Aff)
arturo's avatar
arturo committed
9
import Gargantext.Components.App.Store (Boxes)
10
import Gargantext.Components.Bootstrap as B
11 12
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (panel, submitButton)
13 14 15
import Gargantext.Components.Lang (Lang(..))
import Gargantext.Components.ListSelection as ListSelection
import Gargantext.Components.ListSelection.Types as ListSelection
16
import Gargantext.Config.REST (AffRESTError, RESTError)
17 18 19 20 21 22
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
23 24
import Toestand as T

25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40

here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.WriteNodesDocuments"

-- | Action : WriteNodesDocuments
type ActionWriteNodesDocuments =
  ( boxes    :: Boxes
  , dispatch :: Action -> Aff Unit
  , id       :: GT.ID
  , session  :: Session )

actionWriteNodesDocuments :: R2.Component ActionWriteNodesDocuments
actionWriteNodesDocuments = R.createElement actionWriteNodesDocumentsCpt
actionWriteNodesDocumentsCpt :: R.Component ActionWriteNodesDocuments
actionWriteNodesDocumentsCpt = here.component "actionWriteNodesDocuments" cpt where
  cpt { boxes, dispatch, id, session } _ = do
41 42 43 44 45 46 47

    lang' /\ langBox
        <- R2.useBox' EN
    selection' /\ selectionBox
        <- R2.useBox' ListSelection.MyListsFirst
    paragraphs' /\ paragraphBox
        <- R2.useBox' "7"
48

49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
    let bodies = [
      H.div
      { className: "col-12 flex-space-around" }
      [ H.h4 {}
        [ H.text "Will traverse all Write Nodes and insert them as documents into current corpus." ]
      ]
    ,
      -- lang
      H.div
      { className: "form-group" }
      [
        H.div
        { className: "form-group__label" }
        [
          B.label_ $
          "File lang"
        ]
      ,
        H.div
        { className: "form-group__field" }
        [
          B.formSelect'
          { callback: flip T.write_ langBox
          , value: lang'
          , list: [ EN, FR, No_extraction, Universal ]
          }
          []
        ]
      ]
    ,
      -- paragraph
      H.div
      { className: "form-group "}
      [
        H.div
        { className: "form-group__label" }
        [
          B.label_ $
          "Paragraph size (sentences)"
        ]
      ,
        H.div
        { className: "form-group__field" }
        [
93
          B.formInput
94 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
          { callback: flip T.write_ paragraphBox
          , value: paragraphs'
          }
        ]
      ]
    ,
      --selection
      H.div
      { className: "form-group" }
      [
        H.div
        { className: "form-group__label" }
        [
          B.label_ $
            "List selection"
        ]
      ,
        H.div
        { className: "form-group__field" }
        [
          ListSelection.selection
          { selection: selectionBox
          , session
          } []
        ]
      ]
    ]
121

122
    pure $ panel bodies (submitButton (DocumentsFromWriteNodes { id, lang: lang', selection: selection', paragraphs: paragraphs' }) dispatch)
123 124


125 126 127 128 129 130 131 132 133
type Params =
  ( id         :: GT.ID
  , selection  :: ListSelection.Selection
  , lang       :: Lang
  , paragraphs :: String
  )

documentsFromWriteNodesReq :: Session -> Record Params -> AffRESTError GT.AsyncTaskWithType
documentsFromWriteNodesReq session params@{ id } = do
134
  eTask :: Either RESTError GT.AsyncTask <-
135
    post session (NodeAPI GT.Node (Just id) "documents-from-write-nodes") params
136
  pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.UpdateNode }) <$> eTask