Commit 7003f000 authored by Karen Konou's avatar Karen Konou

[Node frame analysis] upload functions

parent 20f92af7
Pipeline #3592 failed with stage
in 0 seconds
...@@ -384,8 +384,8 @@ linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params w ...@@ -384,8 +384,8 @@ linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params w
handleRESTError errors eTask $ \_task -> pure unit handleRESTError errors eTask $ \_task -> pure unit
refreshTree p refreshTree p
documentsFromWriteNodes id p@{ boxes: { errors }, session } = do documentsFromWriteNodes params p@{ boxes: { errors }, session } = do
eTask <- documentsFromWriteNodesReq session id eTask <- documentsFromWriteNodesReq session params
handleRESTError errors eTask $ \_task -> pure unit handleRESTError errors eTask $ \_task -> pure unit
refreshTree p refreshTree p
...@@ -411,5 +411,5 @@ performAction (MergeNode {params}) p = mergeNode params ...@@ -411,5 +411,5 @@ performAction (MergeNode {params}) p = mergeNode params
performAction (LinkNode { nodeType, params }) p = linkNode nodeType params p performAction (LinkNode { nodeType, params }) p = linkNode nodeType params p
performAction RefreshTree p = refreshTree p performAction RefreshTree p = refreshTree p
performAction CloseBox p = closeBox p performAction CloseBox p = closeBox p
performAction (DocumentsFromWriteNodes { id }) p = documentsFromWriteNodes id p performAction (DocumentsFromWriteNodes params) p = documentsFromWriteNodes params p
performAction NoAction _ = liftEffect $ here.log "[performAction] NoAction" performAction NoAction _ = liftEffect $ here.log "[performAction] NoAction"
...@@ -30,7 +30,7 @@ data Action = AddNode String GT.NodeType ...@@ -30,7 +30,7 @@ data Action = AddNode String GT.NodeType
| MergeNode {params :: Maybe SubTreeOut} | MergeNode {params :: Maybe SubTreeOut}
| LinkNode {nodeType :: Maybe GT.NodeType, params :: Maybe SubTreeOut} | LinkNode {nodeType :: Maybe GT.NodeType, params :: Maybe SubTreeOut}
| DocumentsFromWriteNodes { id :: GT.ID } | DocumentsFromWriteNodes { id :: GT.ID, lang :: Lang, selection :: Selection, paragraphs :: String }
| NoAction | NoAction
......
...@@ -119,11 +119,18 @@ actionWriteNodesDocumentsCpt = here.component "actionWriteNodesDocuments" cpt wh ...@@ -119,11 +119,18 @@ actionWriteNodesDocumentsCpt = here.component "actionWriteNodesDocuments" cpt wh
] ]
] ]
pure $ panel bodies (submitButton (DocumentsFromWriteNodes { id }) dispatch) pure $ panel bodies (submitButton (DocumentsFromWriteNodes { id, lang: lang', selection: selection', paragraphs: paragraphs' }) dispatch)
documentsFromWriteNodesReq :: Session -> GT.ID -> AffRESTError GT.AsyncTaskWithType type Params =
documentsFromWriteNodesReq session id = do ( id :: GT.ID
, selection :: ListSelection.Selection
, lang :: Lang
, paragraphs :: String
)
documentsFromWriteNodesReq :: Session -> Record Params -> AffRESTError GT.AsyncTaskWithType
documentsFromWriteNodesReq session params@{ id } = do
eTask :: Either RESTError GT.AsyncTask <- eTask :: Either RESTError GT.AsyncTask <-
post session (NodeAPI GT.Node (Just id) "documents-from-write-nodes") { id } post session (NodeAPI GT.Node (Just id) "documents-from-write-nodes") params
pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.UpdateNode }) <$> eTask pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.UpdateNode }) <$> eTask
...@@ -4,10 +4,14 @@ import Gargantext.Prelude ...@@ -4,10 +4,14 @@ import Gargantext.Prelude
import Data.Argonaut (class EncodeJson, encodeJson) import Data.Argonaut (class EncodeJson, encodeJson)
import Data.Array as A import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Lens.Lens.Product (_1)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T import Toestand as T
here :: R2.Here here :: R2.Here
...@@ -42,6 +46,9 @@ instance Read Lang where ...@@ -42,6 +46,9 @@ instance Read Lang where
instance EncodeJson Lang where instance EncodeJson Lang where
encodeJson a = encodeJson (show a) encodeJson a = encodeJson (show a)
instance JSON.WriteForeign Lang where
writeImpl l = JSON.writeImpl $ show l
-- Language used for the landing page -- Language used for the landing page
data LandingLang = LL_EN | LL_FR data LandingLang = LL_EN | LL_FR
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment