Commit 92f7d8a9 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge remote-tracking branch 'origin/164-dev-node-write-analysis' into dev-merge

parents cebc94e1 7003f000
...@@ -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
......
...@@ -4,10 +4,15 @@ import Gargantext.Prelude ...@@ -4,10 +4,15 @@ import Gargantext.Prelude
import Data.Either (Either) import Data.Either (Either)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Components.App.Store (Boxes) import Gargantext.Components.App.Store (Boxes)
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (panel, submitButton) import Gargantext.Components.Forest.Tree.Node.Tools (panel, submitButton)
import Gargantext.Components.Lang (Lang(..))
import Gargantext.Components.ListSelection as ListSelection
import Gargantext.Components.ListSelection.Types as ListSelection
import Gargantext.Config.REST (AffRESTError, RESTError) import Gargantext.Config.REST (AffRESTError, RESTError)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, post) import Gargantext.Sessions (Session, post)
...@@ -15,6 +20,8 @@ import Gargantext.Types as GT ...@@ -15,6 +20,8 @@ import Gargantext.Types as GT
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 Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.WriteNodesDocuments" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.WriteNodesDocuments"
...@@ -31,20 +38,99 @@ actionWriteNodesDocuments = R.createElement actionWriteNodesDocumentsCpt ...@@ -31,20 +38,99 @@ actionWriteNodesDocuments = R.createElement actionWriteNodesDocumentsCpt
actionWriteNodesDocumentsCpt :: R.Component ActionWriteNodesDocuments actionWriteNodesDocumentsCpt :: R.Component ActionWriteNodesDocuments
actionWriteNodesDocumentsCpt = here.component "actionWriteNodesDocuments" cpt where actionWriteNodesDocumentsCpt = here.component "actionWriteNodesDocuments" cpt where
cpt { boxes, dispatch, id, session } _ = do cpt { boxes, dispatch, id, session } _ = do
let bodies =
[ R2.row lang' /\ langBox
[ H.div { className: "col-12 flex-space-around" } <- R2.useBox' EN
[ H.div { className: "form-group" } selection' /\ selectionBox
<- R2.useBox' ListSelection.MyListsFirst
paragraphs' /\ paragraphBox
<- R2.useBox' "7"
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." ] [ 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" }
[
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
} []
]
]
]
pure $ panel bodies (submitButton (DocumentsFromWriteNodes { id, lang: lang', selection: selection', paragraphs: paragraphs' }) dispatch)
pure $ panel bodies (submitButton (DocumentsFromWriteNodes { id }) dispatch)
type Params =
( id :: GT.ID
, selection :: ListSelection.Selection
, lang :: Lang
, paragraphs :: String
)
documentsFromWriteNodesReq :: Session -> GT.ID -> AffRESTError GT.AsyncTaskWithType documentsFromWriteNodesReq :: Session -> Record Params -> AffRESTError GT.AsyncTaskWithType
documentsFromWriteNodesReq session id = do 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