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

import Gargantext.Prelude

5
import Data.Array as A
6
import Data.Either (Either)
7
import Data.Maybe (Maybe(..), fromMaybe)
8
import Data.Tuple.Nested ((/\))
9
import Effect.Aff (Aff)
arturo's avatar
arturo committed
10
import Gargantext.Components.App.Store (Boxes)
11
import Gargantext.Components.Bootstrap as B
12
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
13
import Gargantext.Components.Forest.Tree.Node.Action.Utils (loadLanguages)
14
import Gargantext.Components.Forest.Tree.Node.Tools as Tools
15 16 17
import Gargantext.Components.Lang (Lang(..))
import Gargantext.Components.ListSelection as ListSelection
import Gargantext.Components.ListSelection.Types as ListSelection
18 19
import Gargantext.Config.REST (AffRESTError, RESTError(..))
import Gargantext.Hooks.Loader (useLoader)
20 21 22 23 24 25
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
26
import Record as Record
27 28
import Toestand as T

29 30 31 32 33 34 35 36 37 38 39 40 41 42 43

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
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
  cpt props@({ session }) _ = do
    useLoader { errorHandler
              , loader: loadLanguages
              , path: { session }
              , render: \langs ->
              actionWriteNodesDocumentsWithLangs (Record.merge props { langs }) [] }
    where
      errorHandler err = case err of
        ReadJSONError err' -> here.warn2 "[actionSearch] ReadJSONError" $ show err'
        _                  -> here.warn2 "[actionSearch] RESTError" err

type ActionWriteNodesDocumentsWithLangs =
  ( langs :: Array Lang
  | ActionWriteNodesDocuments )

actionWriteNodesDocumentsWithLangs :: R2.Component ActionWriteNodesDocumentsWithLangs
actionWriteNodesDocumentsWithLangs = R.createElement actionWriteNodesDocumentsWithLangsCpt
actionWriteNodesDocumentsWithLangsCpt :: R.Component ActionWriteNodesDocumentsWithLangs
actionWriteNodesDocumentsWithLangsCpt = here.component "actionWriteNodesDocumentsWithLangs" cpt where
  cpt { dispatch, id, langs, session } _ = do
64

65 66
    -- lang' /\ langBox
    --     <- R2.useBox' $ fromMaybe EN $ A.head langs
67
    lang' /\ langBox
68
        <- R2.useBox' EN
69 70 71 72
    selection' /\ selectionBox
        <- R2.useBox' ListSelection.MyListsFirst
    paragraphs' /\ paragraphBox
        <- R2.useBox' "7"
73

74 75 76 77 78
    pure $
      Tools.panelWithSubmitButton { action: DocumentsFromWriteNodes { id
                                                                    , lang: lang'
                                                                    , selection: selection'
                                                                    , paragraphs: paragraphs' }
79 80
                                  , dispatch
                                  , mError: Nothing }
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 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
          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: langs <> [ No_extraction ]
              }
              []
            ]
          ]
        ,
          -- paragraph
          H.div
          { className: "form-group "}
          [
            H.div
            { className: "form-group__label" }
            [
              B.label_ $
              "Paragraph size (sentences)"
            ]
          ,
            H.div
            { className: "form-group__field" }
            [
              B.formInput
              { 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
              } []
            ]
          ]
152
        ]
153 154


155 156 157 158 159 160 161 162 163
type Params =
  ( id         :: GT.ID
  , selection  :: ListSelection.Selection
  , lang       :: Lang
  , paragraphs :: String
  )

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