Skip to content

P
purescript-gargantext
Commit e13a1318 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[FEAT] Upload File with FR Lang

parent 666c37ac
Hide whitespace changes
Inline Side-by-side
Showing with 52 additions and 40 deletions
src/Gargantext/Components/FolderView.purs
View file @ e13a1318
......@@ -327,8 +327,8 @@ performAction = performAction' where
performAction' (SharePublic { params }) p = sharePublic params p
performAction' (AddContact params) p = addContact params p
performAction' (AddNode name nodeType) p = addNode' name nodeType p
performAction' (UploadFile nodeType fileType fileFormat mName contents selection) p =
uploadFile' nodeType fileType fileFormat mName contents p selection
performAction' (UploadFile nodeType fileType fileFormat lang mName contents selection) p =
uploadFile' nodeType fileType fileFormat lang mName contents p selection
performAction' (UploadArbitraryFile fileFormat mName blob selection) p =
uploadArbitraryFile' fileFormat mName blob p selection
performAction' DownloadNode _ = liftEffect $ here.log "[performAction] DownloadNode"
......@@ -391,8 +391,8 @@ performAction = performAction' where
addContact params { nodeId: id, session } =
void $ Contact.contactReq session id params
uploadFile' nodeType fileType fileFormat mName contents { boxes: { errors, tasks }, nodeId: id, session } selection = do
eTask <- uploadFile { contents, fileType, fileFormat, id, nodeType, mName, selection, session }
uploadFile' nodeType fileType fileFormat lang mName contents { boxes: { errors, tasks }, nodeId: id, session } selection = do
eTask <- uploadFile { contents, fileType, fileFormat, lang, id, nodeType, mName, selection, session }
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[performAction] UploadFile, uploaded, task:" task
......
src/Gargantext/Components/Forest/Tree.purs
View file @ e13a1318
......@@ -345,8 +345,8 @@ addNode' name nodeType p@{ boxes: { errors, forestOpen }, session, tree: (NTree
liftEffect $ T.modify_ (openNodesInsert (mkNodeId session id)) forestOpen
refreshTree p
uploadFile' nodeType fileType fileFormat mName contents p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
eTask <- uploadFile { contents, fileFormat, fileType, id, mName, nodeType, selection, session }
uploadFile' nodeType fileType fileFormat lang mName contents p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
eTask <- uploadFile { contents, fileFormat, fileType, id, lang, mName, nodeType, selection, session }
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[uploadFile'] UploadFile, uploaded, task:" task
......@@ -399,8 +399,8 @@ performAction (SharePublic { params }) p = sharePublic para
performAction (AddContact params) p = addContact params p
performAction (AddNode name nodeType) p = addNode' name nodeType p
performAction UploadFrameCalc p = uploadFrameCalc' p
performAction (UploadFile nodeType fileType fileFormat mName contents selection) p =
uploadFile' nodeType fileType fileFormat mName contents p selection
performAction (UploadFile nodeType fileType fileFormat lang mName contents selection) p =
uploadFile' nodeType fileType fileFormat lang mName contents p selection
performAction (UploadArbitraryFile fileFormat mName blob selection) p =
uploadArbitraryFile' fileFormat mName blob p selection
performAction DownloadNode _ = liftEffect $ here.log "[performAction] DownloadNode"
......
src/Gargantext/Components/Forest/Tree/Node/Action.purs
View file @ e13a1318
......@@ -42,7 +42,7 @@ icon (ShareTeam _) = glyphiconNodeAction Share
icon (AddContact _) = glyphiconNodeAction Share
icon (SharePublic _ ) = glyphiconNodeAction (Publish { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (DoSearch _) = glyphiconNodeAction SearchBox
icon (UploadFile _ _ _ _ _ _) = glyphiconNodeAction Upload
icon (UploadFile _ _ _ _ _ _ _) = glyphiconNodeAction Upload
icon (UploadArbitraryFile _ _ _ _ ) = glyphiconNodeAction Upload
icon UploadFrameCalc = glyphiconNodeAction Upload
icon RefreshTree = glyphiconNodeAction Refresh
......@@ -66,7 +66,7 @@ text (ShareTeam _ ) = "Share with team !"
text (AddContact _ ) = "Add contact !"
text (SharePublic _ ) = "Publish !"
text (DoSearch _ ) = "Launch search !"
text (UploadFile _ _ _ _ _ _) = "Upload File !"
text (UploadFile _ _ _ _ _ _ _) = "Upload File !"
text (UploadArbitraryFile _ _ _ _) = "Upload arbitrary file !"
text UploadFrameCalc = "Upload frame calc"
text RefreshTree = "Refresh Tree !"
......
src/Gargantext/Components/Forest/Tree/Node/Action/Types.purs
View file @ e13a1318
module Gargantext.Components.Forest.Tree.Node.Action.Types where
import Gargantext.Prelude
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe)
import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams)
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (UpdateNodeParams)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileFormat, FileType, UploadFileBlob)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut)
import Gargantext.Components.Lang (Lang(..))
import Gargantext.Components.ListSelection.Types (Selection)
import Gargantext.Prelude
import Gargantext.Types as GT
data Action = AddNode String GT.NodeType
......@@ -16,7 +16,7 @@ data Action = AddNode String GT.NodeType
| RenameNode String
| UpdateNode UpdateNodeParams
| DoSearch GT.AsyncTaskWithType
| UploadFile GT.NodeType FileType FileFormat (Maybe String) String Selection
| UploadFile GT.NodeType FileType FileFormat Lang (Maybe String) String Selection
| UploadArbitraryFile FileFormat (Maybe String) UploadFileBlob Selection
| UploadFrameCalc
| DownloadNode
......@@ -42,8 +42,8 @@ instance Eq Action where
eq (RenameNode s1) (RenameNode s2) = eq s1 s2
eq (UpdateNode un1) (UpdateNode un2) = eq un1 un2
eq (DoSearch at1) (DoSearch at2) = eq at1 at2
eq (UploadFile nt1 ft1 ff1 s1 _ _) (UploadFile nt2 ft2 ff2 s2 _ _) =
(eq nt1 nt2) && (eq ft1 ft2) && (eq ff1 ff2) && (eq s1 s2)
eq (UploadFile nt1 ft1 ff1 l1 s1 _ _) (UploadFile nt2 ft2 ff2 l2 s2 _ _) =
(eq nt1 nt2) && (eq ft1 ft2) && (eq ff1 ff2) && (eq l1 l2) && (eq s1 s2)
eq (UploadArbitraryFile ff1 s1 _ _) (UploadArbitraryFile ff2 s2 _ _) = (eq ff1 ff2) && (eq s1 s2)
eq UploadFrameCalc UploadFrameCalc = true
eq DownloadNode DownloadNode = true
......@@ -68,7 +68,7 @@ instance Show Action where
show (AddContact _ ) = "AddContact"
show (SharePublic _ ) = "SharePublic"
show (DoSearch _ ) = "SearchQuery"
show (UploadFile _ _ _ _ _ _) = "UploadFile"
show (UploadFile _ _ _ _ _ _ _) = "UploadFile"
show (UploadArbitraryFile _ _ _ _) = "UploadArbitraryFile"
show UploadFrameCalc = "UploadFrameCalc"
show RefreshTree = "RefreshTree"
......
src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
View file @ e13a1318
......@@ -59,11 +59,15 @@ actionUploadCpt :: R.Component ActionUpload
actionUploadCpt = here.component "actionUpload" cpt where
cpt { nodeType: Corpus, dispatch, id, session } _ =
pure $ uploadFileView { dispatch, id, nodeType: GT.Corpus, session }
cpt { nodeType: NodeList, dispatch, id, session } _ =
pure $ uploadTermListView { dispatch, id, nodeType: GT.NodeList, session } []
cpt props@{ nodeType: NodeFrameCalc } _ = pure $ uploadFrameCalcView props []
cpt props@{ nodeType: Annuaire, dispatch, id, session } _ = do
cpt props@{ nodeType: Annuaire, dispatch, id, session } _ =
pure $ uploadListView { dispatch, id, nodeType: GT.Annuaire, session }
cpt props@{ nodeType: _ } _ = pure $ actionUploadOther props []
{-
......@@ -103,15 +107,15 @@ uploadFileViewCpt = here.component "uploadFileView" cpt
where
cpt { dispatch, id, nodeType, session } _ = do
-- mFile :: R.State (Maybe UploadFile) <- R.useState' Nothing
mFile <- T.useBox (Nothing :: Maybe UploadFile)
fileType <- T.useBox CSV
fileFormat <- T.useBox Plain
lang <- T.useBox EN
selection <- T.useBox ListSelection.MyListsFirst
mFile <- T.useBox (Nothing :: Maybe UploadFile)
fileType <- T.useBox CSV
fileFormat <- T.useBox Plain
lang <- T.useBox EN
selection <- T.useBox ListSelection.MyListsFirst
let setFileType' val = T.write_ val fileType
let setFileType' val = T.write_ val fileType
let setFileFormat' val = T.write_ val fileFormat
let setLang' val = T.write_ val lang
let setLang' val = T.write_ val lang
let bodies =
[ R2.row
......@@ -148,7 +152,8 @@ uploadFileViewCpt = here.component "uploadFileView" cpt
[ formChoiceSafe { items: [EN, FR, No_extraction, Universal]
, default: EN
, callback: setLang'
, print: show } []
, print: show
} []
]
]
, R2.row
......@@ -195,6 +200,7 @@ type UploadButtonProps =
uploadButton :: R2.Component UploadButtonProps
uploadButton = R.createElement uploadButtonCpt
uploadButtonCpt :: R.Component UploadButtonProps
uploadButtonCpt = here.component "uploadButton" cpt
where
......@@ -206,10 +212,11 @@ uploadButtonCpt = here.component "uploadButton" cpt
, nodeType
, selection
} _ = do
fileType' <- T.useLive T.unequal fileType
fileType' <- T.useLive T.unequal fileType
fileFormat' <- T.useLive T.unequal fileFormat
mFile' <- T.useLive T.unequal mFile
selection' <- T.useLive T.unequal selection
mFile' <- T.useLive T.unequal mFile
lang' <- T.useLive T.unequal lang
selection' <- T.useLive T.unequal selection
onPending /\ onPendingBox <- R2.useBox' false
let disabled = isNothing mFile' || onPending
......@@ -237,6 +244,7 @@ uploadButtonCpt = here.component "uploadButton" cpt
fileFormat'
fileType'
mFile'
lang'
selection'
onPendingBox
}
......@@ -246,7 +254,7 @@ uploadButtonCpt = here.component "uploadButton" cpt
where
onClick fileFormat' fileType' mFile' selection' onPendingBox e = do
onClick fileFormat' fileType' mFile' lang' selection' onPendingBox e = do
let { blob, name } = unsafePartial $ fromJust mFile'
T.write_ true onPendingBox
here.log2 "[uploadButton] fileType" fileType'
......@@ -258,7 +266,7 @@ uploadButtonCpt = here.component "uploadButton" cpt
contents <- case fileFormat' of
Plain -> readUFBAsText blob
ZIP -> readUFBAsBase64 blob
dispatch $ UploadFile nodeType fileType' fileFormat' (Just name) contents selection'
dispatch $ UploadFile nodeType fileType' fileFormat' lang' (Just name) contents selection'
liftEffect $ do
T.write_ Nothing mFile
T.write_ CSV fileType
......@@ -485,7 +493,7 @@ fileTypeViewCpt = here.component "fileTypeView" cpt
}) droppedFile
renderOption opt = H.option {} [ H.text $ show opt ]
panelFooter (DroppedFile { blob, fileType }) =
panelFooter (DroppedFile { blob, fileType, lang}) =
H.div {className: "card-footer"}
[
case fileType of
......@@ -496,7 +504,7 @@ fileTypeViewCpt = here.component "fileTypeView" cpt
T.write_ Nothing droppedFile
launchAff $ do
contents <- readUFBAsText blob
dispatch $ UploadFile nodeType ft Plain Nothing contents (SelectedLists [])
dispatch $ UploadFile nodeType ft Plain lang Nothing contents (SelectedLists [])
}
} [H.text "Upload"]
Nothing ->
......@@ -522,6 +530,7 @@ uploadFile :: { contents :: String
, fileFormat :: FileFormat
, fileType :: FileType
, id :: ID
, lang :: Lang
, nodeType :: GT.NodeType
, mName :: Maybe String
, selection :: ListSelection.Selection
......@@ -537,21 +546,24 @@ uploadFile session NodeList id JSON { mName, contents } = do
task <- post session url body
pure $ GT.AsyncTaskWithType { task, typ: GT.Form }
-}
uploadFile { contents, fileFormat, fileType, id, nodeType, mName, session } = do
uploadFile { contents, fileFormat, lang, fileType, id, nodeType, mName, session } = do
-- contents <- readAsText blob
eTask :: Either RESTError GT.AsyncTask <- postWwwUrlencoded session p body
pure $ (\task -> GT.AsyncTaskWithType { task, typ }) <$> eTask
--postMultipartFormData session p fileContents
where
bodyParams = [ Tuple "_wf_data" (Just contents)
, Tuple "_wf_filetype" (Just $ show fileType)
bodyParams = [ Tuple "_wf_data" (Just contents)
, Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_fileformat" (Just $ show fileFormat)
, Tuple "_wf_name" mName
, Tuple "_wf_lang" (Just $ show lang)
, Tuple "_wf_name" mName
]
csvBodyParams = [ Tuple "_wtf_data" (Just contents)
, Tuple "_wtf_filetype" (Just $ show NodeList)
csvBodyParams = [ Tuple "_wtf_data" (Just contents)
, Tuple "_wtf_filetype" (Just $ show NodeList)
, Tuple "_wtf_fileformat" (Just $ show fileFormat)
, Tuple "_wtf_name" mName ]
, Tuple "_wf_lang" (Just $ show lang)
, Tuple "_wtf_name" mName
]
(typ /\ p /\ body) = case nodeType of
Corpus -> GT.CorpusFormUpload /\ (GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.CorpusFormUpload) /\ bodyParams
......@@ -685,7 +697,7 @@ uploadTermButtonCpt = here.component "uploadTermButton" cpt
let {name, blob} = unsafePartial $ fromJust mFile'
void $ launchAff do
contents <- readUFBAsText blob
_ <- dispatch $ UploadFile nodeType uploadType' Plain (Just name) contents (SelectedLists [])
_ <- dispatch $ UploadFile nodeType uploadType' Plain EN (Just name) contents (SelectedLists [])
liftEffect $ do
T.write_ Nothing mFile
------------------------------------------------------------------------
......
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