Commit fa6012c6 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-merge' into dev

parents b0afd439 28e0d4d7
...@@ -283,10 +283,10 @@ performAction = performAction' where ...@@ -283,10 +283,10 @@ performAction = performAction' where
performAction' (SharePublic { params }) p = sharePublic params p performAction' (SharePublic { params }) p = sharePublic params p
performAction' (AddContact params) p = addContact params p performAction' (AddContact params) p = addContact params p
performAction' (AddNode name nodeType) p = addNode' name nodeType p performAction' (AddNode name nodeType) p = addNode' name nodeType p
performAction' (UploadFile nodeType fileType mName contents selection) p = performAction' (UploadFile nodeType fileType fileFormat mName contents selection) p =
uploadFile' nodeType fileType mName contents p selection uploadFile' nodeType fileType fileFormat mName contents p selection
performAction' (UploadArbitraryFile mName blob selection) p = performAction' (UploadArbitraryFile fileFormat mName blob selection) p =
uploadArbitraryFile' mName blob p selection uploadArbitraryFile' fileFormat mName blob p selection
performAction' DownloadNode _ = liftEffect $ here.log "[performAction] DownloadNode" performAction' DownloadNode _ = liftEffect $ here.log "[performAction] DownloadNode"
performAction' (MoveNode {params}) p = moveNode params p performAction' (MoveNode {params}) p = moveNode params p
performAction' (MergeNode {params}) p = mergeNode params p performAction' (MergeNode {params}) p = mergeNode params p
...@@ -333,14 +333,14 @@ performAction = performAction' where ...@@ -333,14 +333,14 @@ performAction = performAction' where
addContact params { nodeId: id, session } = addContact params { nodeId: id, session } =
void $ Contact.contactReq session id params void $ Contact.contactReq session id params
uploadFile' nodeType fileType mName contents { boxes: { errors, tasks }, nodeId: id, session } selection = do uploadFile' nodeType fileType fileFormat mName contents { boxes: { errors, tasks }, nodeId: id, session } selection = do
eTask <- uploadFile { contents, fileType, id, nodeType, mName, selection, session } eTask <- uploadFile { contents, fileType, fileFormat, id, nodeType, mName, selection, session }
handleRESTError errors eTask $ \task -> liftEffect $ do handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[performAction] UploadFile, uploaded, task:" task here.log2 "[performAction] UploadFile, uploaded, task:" task
uploadArbitraryFile' mName blob { boxes: { errors, tasks }, nodeId: id, session } selection = do uploadArbitraryFile' fileFormat mName blob { boxes: { errors, tasks }, nodeId: id, session } selection = do
eTask <- uploadArbitraryFile session id { blob, mName } selection eTask <- uploadArbitraryFile session id { blob, fileFormat, mName } selection
handleRESTError errors eTask $ \task -> liftEffect $ do handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[performAction] UploadArbitraryFile, uploaded, task:" task here.log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
......
...@@ -271,14 +271,14 @@ addNode' name nodeType p@{ boxes: { errors, forestOpen }, session, tree: (NTree ...@@ -271,14 +271,14 @@ addNode' name nodeType p@{ boxes: { errors, forestOpen }, session, tree: (NTree
liftEffect $ T.modify_ (openNodesInsert (mkNodeId session id)) forestOpen liftEffect $ T.modify_ (openNodesInsert (mkNodeId session id)) forestOpen
refreshTree p refreshTree p
uploadFile' nodeType fileType mName contents p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do uploadFile' nodeType fileType fileFormat mName contents p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
eTask <- uploadFile { contents, fileType, id, mName, nodeType, selection, session } eTask <- uploadFile { contents, fileFormat, fileType, id, mName, nodeType, selection, session }
handleRESTError errors eTask $ \task -> liftEffect $ do handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[uploadFile'] UploadFile, uploaded, task:" task here.log2 "[uploadFile'] UploadFile, uploaded, task:" task
uploadArbitraryFile' mName blob p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do uploadArbitraryFile' fileFormat mName blob p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
eTask <- uploadArbitraryFile session id { blob, mName } selection eTask <- uploadArbitraryFile session id { blob, fileFormat, mName } selection
handleRESTError errors eTask $ \task -> liftEffect $ do handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
here.log2 "[uploadArbitraryFile'] UploadArbitraryFile, uploaded, task:" task here.log2 "[uploadArbitraryFile'] UploadArbitraryFile, uploaded, task:" task
...@@ -325,10 +325,10 @@ performAction (SharePublic { params }) p = sharePublic para ...@@ -325,10 +325,10 @@ performAction (SharePublic { params }) p = sharePublic para
performAction (AddContact params) p = addContact params p performAction (AddContact params) p = addContact params p
performAction (AddNode name nodeType) p = addNode' name nodeType p performAction (AddNode name nodeType) p = addNode' name nodeType p
performAction UploadFrameCalc p = uploadFrameCalc' p performAction UploadFrameCalc p = uploadFrameCalc' p
performAction (UploadFile nodeType fileType mName contents selection) p = performAction (UploadFile nodeType fileType fileFormat mName contents selection) p =
uploadFile' nodeType fileType mName contents p selection uploadFile' nodeType fileType fileFormat mName contents p selection
performAction (UploadArbitraryFile mName blob selection) p = performAction (UploadArbitraryFile fileFormat mName blob selection) p =
uploadArbitraryFile' mName blob p selection uploadArbitraryFile' fileFormat mName blob p selection
performAction DownloadNode _ = liftEffect $ here.log "[performAction] DownloadNode" performAction DownloadNode _ = liftEffect $ here.log "[performAction] DownloadNode"
performAction (MoveNode {params}) p = moveNode params p performAction (MoveNode {params}) p = moveNode params p
performAction (MergeNode {params}) p = mergeNode params p performAction (MergeNode {params}) p = mergeNode params p
......
...@@ -34,48 +34,48 @@ setTreeOut a _ = a ...@@ -34,48 +34,48 @@ setTreeOut a _ = a
----------------------------------------------------------------------- -----------------------------------------------------------------------
icon :: Action -> String icon :: Action -> String
icon (AddNode _ _) = glyphiconNodeAction (Add []) icon (AddNode _ _) = glyphiconNodeAction (Add [])
icon (DeleteNode _) = glyphiconNodeAction Delete icon (DeleteNode _) = glyphiconNodeAction Delete
icon (RenameNode _) = glyphiconNodeAction Config icon (RenameNode _) = glyphiconNodeAction Config
icon (UpdateNode _) = glyphiconNodeAction Refresh icon (UpdateNode _) = glyphiconNodeAction Refresh
icon (ShareTeam _) = glyphiconNodeAction Share icon (ShareTeam _) = glyphiconNodeAction Share
icon (AddContact _) = glyphiconNodeAction Share icon (AddContact _) = glyphiconNodeAction Share
icon (SharePublic _ ) = glyphiconNodeAction (Publish { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }}) icon (SharePublic _ ) = glyphiconNodeAction (Publish { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (DoSearch _) = glyphiconNodeAction SearchBox icon (DoSearch _) = glyphiconNodeAction SearchBox
icon (UploadFile _ _ _ _ _) = glyphiconNodeAction Upload icon (UploadFile _ _ _ _ _ _) = glyphiconNodeAction Upload
icon (UploadArbitraryFile _ _ _ ) = glyphiconNodeAction Upload icon (UploadArbitraryFile _ _ _ _ ) = glyphiconNodeAction Upload
icon UploadFrameCalc = glyphiconNodeAction Upload icon UploadFrameCalc = glyphiconNodeAction Upload
icon RefreshTree = glyphiconNodeAction Refresh icon RefreshTree = glyphiconNodeAction Refresh
icon ClosePopover = glyphiconNodeAction CloseNodePopover icon ClosePopover = glyphiconNodeAction CloseNodePopover
icon DownloadNode = glyphiconNodeAction Download icon DownloadNode = glyphiconNodeAction Download
icon (MoveNode _ ) = glyphiconNodeAction (Move { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }}) icon (MoveNode _ ) = glyphiconNodeAction (Move { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (MergeNode _ ) = glyphiconNodeAction (Merge { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }}) icon (MergeNode _ ) = glyphiconNodeAction (Merge { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (LinkNode _ ) = glyphiconNodeAction (Link { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }}) icon (LinkNode _ ) = glyphiconNodeAction (Link { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (DocumentsFromWriteNodes _) = glyphiconNodeAction (WriteNodesDocuments) icon (DocumentsFromWriteNodes _) = glyphiconNodeAction (WriteNodesDocuments)
icon NoAction = "hand-o-right" icon NoAction = "hand-o-right"
-- icon _ = "hand-o-right" -- icon _ = "hand-o-right"
text :: Action -> String text :: Action -> String
text (AddNode _ _ ) = "Add !" text (AddNode _ _ ) = "Add !"
text (DeleteNode _ ) = "Delete !" text (DeleteNode _ ) = "Delete !"
text (RenameNode _ ) = "Rename !" text (RenameNode _ ) = "Rename !"
text (UpdateNode _ ) = "Update !" text (UpdateNode _ ) = "Update !"
text (ShareTeam _ ) = "Share with team !" text (ShareTeam _ ) = "Share with team !"
text (AddContact _ ) = "Add contact !" text (AddContact _ ) = "Add contact !"
text (SharePublic _ ) = "Publish !" text (SharePublic _ ) = "Publish !"
text (DoSearch _ ) = "Launch search !" text (DoSearch _ ) = "Launch search !"
text (UploadFile _ _ _ _ _) = "Upload File !" text (UploadFile _ _ _ _ _ _) = "Upload File !"
text (UploadArbitraryFile _ _ _) = "Upload arbitrary file !" text (UploadArbitraryFile _ _ _ _) = "Upload arbitrary file !"
text UploadFrameCalc = "Upload frame calc" text UploadFrameCalc = "Upload frame calc"
text RefreshTree = "Refresh Tree !" text RefreshTree = "Refresh Tree !"
text ClosePopover = "Close Popover !" text ClosePopover = "Close Popover !"
text DownloadNode = "Download !" text DownloadNode = "Download !"
text (MoveNode _ ) = "Move !" text (MoveNode _ ) = "Move !"
text (MergeNode _ ) = "Merge !" text (MergeNode _ ) = "Merge !"
text (LinkNode _ ) = "Link !" text (LinkNode _ ) = "Link !"
text (DocumentsFromWriteNodes _ ) = "Documents from Write Nodes !" text (DocumentsFromWriteNodes _ ) = "Documents from Write Nodes !"
text NoAction = "No Action" text NoAction = "No Action"
----------------------------------------------------------------------- -----------------------------------------------------------------------
...@@ -6,7 +6,7 @@ import Data.Generic.Rep (class Generic) ...@@ -6,7 +6,7 @@ import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe) import Data.Maybe (Maybe)
import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams) 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.Update.Types (UpdateNodeParams)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileBlob) 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.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut)
import Gargantext.Components.ListSelection.Types (Selection) import Gargantext.Components.ListSelection.Types (Selection)
import Gargantext.Types as GT import Gargantext.Types as GT
...@@ -16,8 +16,8 @@ data Action = AddNode String GT.NodeType ...@@ -16,8 +16,8 @@ data Action = AddNode String GT.NodeType
| RenameNode String | RenameNode String
| UpdateNode UpdateNodeParams | UpdateNode UpdateNodeParams
| DoSearch GT.AsyncTaskWithType | DoSearch GT.AsyncTaskWithType
| UploadFile GT.NodeType FileType (Maybe String) String Selection | UploadFile GT.NodeType FileType FileFormat (Maybe String) String Selection
| UploadArbitraryFile (Maybe String) UploadFileBlob Selection | UploadArbitraryFile FileFormat (Maybe String) UploadFileBlob Selection
| UploadFrameCalc | UploadFrameCalc
| DownloadNode | DownloadNode
| RefreshTree | RefreshTree
...@@ -42,9 +42,9 @@ instance Eq Action where ...@@ -42,9 +42,9 @@ instance Eq Action where
eq (RenameNode s1) (RenameNode s2) = eq s1 s2 eq (RenameNode s1) (RenameNode s2) = eq s1 s2
eq (UpdateNode un1) (UpdateNode un2) = eq un1 un2 eq (UpdateNode un1) (UpdateNode un2) = eq un1 un2
eq (DoSearch at1) (DoSearch at2) = eq at1 at2 eq (DoSearch at1) (DoSearch at2) = eq at1 at2
eq (UploadFile nt1 ft1 s1 _ _) (UploadFile nt2 ft2 s2 _ _) = eq (UploadFile nt1 ft1 ff1 s1 _ _) (UploadFile nt2 ft2 ff2 s2 _ _) =
(eq nt1 nt2) && (eq ft1 ft2) && (eq s1 s2) (eq nt1 nt2) && (eq ft1 ft2) && (eq ff1 ff2) && (eq s1 s2)
eq (UploadArbitraryFile s1 _ _) (UploadArbitraryFile s2 _ _) = eq s1 s2 eq (UploadArbitraryFile ff1 s1 _ _) (UploadArbitraryFile ff2 s2 _ _) = (eq ff1 ff2) && (eq s1 s2)
eq UploadFrameCalc UploadFrameCalc = true eq UploadFrameCalc UploadFrameCalc = true
eq DownloadNode DownloadNode = true eq DownloadNode DownloadNode = true
eq RefreshTree RefreshTree = true eq RefreshTree RefreshTree = true
...@@ -60,22 +60,22 @@ instance Eq Action where ...@@ -60,22 +60,22 @@ instance Eq Action where
eq _ _ = false eq _ _ = false
instance Show Action where instance Show Action where
show (AddNode _ _ ) = "AddNode" show (AddNode _ _ ) = "AddNode"
show (DeleteNode _ ) = "DeleteNode" show (DeleteNode _ ) = "DeleteNode"
show (RenameNode _ ) = "RenameNode" show (RenameNode _ ) = "RenameNode"
show (UpdateNode _ ) = "UpdateNode" show (UpdateNode _ ) = "UpdateNode"
show (ShareTeam _ ) = "ShareTeam" show (ShareTeam _ ) = "ShareTeam"
show (AddContact _ ) = "AddContact" show (AddContact _ ) = "AddContact"
show (SharePublic _ ) = "SharePublic" show (SharePublic _ ) = "SharePublic"
show (DoSearch _ ) = "SearchQuery" show (DoSearch _ ) = "SearchQuery"
show (UploadFile _ _ _ _ _) = "UploadFile" show (UploadFile _ _ _ _ _ _) = "UploadFile"
show (UploadArbitraryFile _ _ _) = "UploadArbitraryFile" show (UploadArbitraryFile _ _ _ _) = "UploadArbitraryFile"
show UploadFrameCalc = "UploadFrameCalc" show UploadFrameCalc = "UploadFrameCalc"
show RefreshTree = "RefreshTree" show RefreshTree = "RefreshTree"
show ClosePopover = "ClosePopover" show ClosePopover = "ClosePopover"
show DownloadNode = "Download" show DownloadNode = "Download"
show (MoveNode _ ) = "MoveNode" show (MoveNode _ ) = "MoveNode"
show (MergeNode _ ) = "MergeNode" show (MergeNode _ ) = "MergeNode"
show (LinkNode _ ) = "LinkNode" show (LinkNode _ ) = "LinkNode"
show (DocumentsFromWriteNodes _ ) = "DocumentsFromWriteNodes" show (DocumentsFromWriteNodes _ ) = "DocumentsFromWriteNodes"
show NoAction = "NoAction" show NoAction = "NoAction"
...@@ -2,6 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Action.Upload where ...@@ -2,6 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Action.Upload where
import Gargantext.Prelude import Gargantext.Prelude
import Affjax.RequestBody (blob)
import Data.Either (Either, fromRight') import Data.Either (Either, fromRight')
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Foldable (intercalate) import Data.Foldable (intercalate)
...@@ -17,7 +18,7 @@ import Effect.Aff (Aff, launchAff) ...@@ -17,7 +18,7 @@ import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Components.Forest.Tree.Node.Action (Props) import Gargantext.Components.Forest.Tree.Node.Action (Props)
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..), readUFBAsBase64, readUFBAsText) import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileFormat(..), FileType(..), UploadFileBlob(..), readUFBAsBase64, readUFBAsText)
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, formChoiceSafe, panel) import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, formChoiceSafe, panel)
import Gargantext.Components.Lang (Lang(..)) import Gargantext.Components.Lang (Lang(..))
import Gargantext.Components.ListSelection as ListSelection import Gargantext.Components.ListSelection as ListSelection
...@@ -99,10 +100,12 @@ uploadFileViewCpt = here.component "uploadFileView" cpt ...@@ -99,10 +100,12 @@ uploadFileViewCpt = here.component "uploadFileView" cpt
-- mFile :: R.State (Maybe UploadFile) <- R.useState' Nothing -- mFile :: R.State (Maybe UploadFile) <- R.useState' Nothing
mFile <- T.useBox (Nothing :: Maybe UploadFile) mFile <- T.useBox (Nothing :: Maybe UploadFile)
fileType <- T.useBox CSV fileType <- T.useBox CSV
fileFormat <- T.useBox Plain
lang <- T.useBox EN lang <- T.useBox EN
selection <- T.useBox ListSelection.MyListsFirst 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 = let bodies =
...@@ -124,11 +127,15 @@ uploadFileViewCpt = here.component "uploadFileView" cpt ...@@ -124,11 +127,15 @@ uploadFileViewCpt = here.component "uploadFileView" cpt
, WOS , WOS
, PresseRIS , PresseRIS
, Arbitrary , Arbitrary
, ZIP
] ]
, default: CSV , default: CSV
, callback: setFileType' , callback: setFileType'
, print: show } [] , print: show } []
, formChoiceSafe { items: [ Plain
, ZIP ]
, default: Plain
, callback: setFileFormat'
, print: show } []
] ]
] ]
, R2.row , R2.row
...@@ -146,6 +153,7 @@ uploadFileViewCpt = here.component "uploadFileView" cpt ...@@ -146,6 +153,7 @@ uploadFileViewCpt = here.component "uploadFileView" cpt
] ]
let footer = H.div {} [ uploadButton { dispatch let footer = H.div {} [ uploadButton { dispatch
, fileFormat
, fileType , fileType
, lang , lang
, mFile , mFile
...@@ -170,12 +178,13 @@ uploadFileViewCpt = here.component "uploadFileView" cpt ...@@ -170,12 +178,13 @@ uploadFileViewCpt = here.component "uploadFileView" cpt
type UploadButtonProps = type UploadButtonProps =
( dispatch :: Action -> Aff Unit ( dispatch :: Action -> Aff Unit
, fileType :: T.Box FileType , fileFormat :: T.Box FileFormat
, lang :: T.Box Lang , fileType :: T.Box FileType
, mFile :: T.Box (Maybe UploadFile) , lang :: T.Box Lang
, nodeType :: GT.NodeType , mFile :: T.Box (Maybe UploadFile)
, selection :: T.Box ListSelection.Selection , nodeType :: GT.NodeType
, selection :: T.Box ListSelection.Selection
) )
uploadButton :: R2.Component UploadButtonProps uploadButton :: R2.Component UploadButtonProps
...@@ -184,6 +193,7 @@ uploadButtonCpt :: R.Component UploadButtonProps ...@@ -184,6 +193,7 @@ uploadButtonCpt :: R.Component UploadButtonProps
uploadButtonCpt = here.component "uploadButton" cpt uploadButtonCpt = here.component "uploadButton" cpt
where where
cpt { dispatch cpt { dispatch
, fileFormat
, fileType , fileType
, lang , lang
, mFile , mFile
...@@ -191,6 +201,7 @@ uploadButtonCpt = here.component "uploadButton" cpt ...@@ -191,6 +201,7 @@ uploadButtonCpt = here.component "uploadButton" cpt
, selection , selection
} _ = do } _ = 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 mFile' <- T.useLive T.unequal mFile
selection' <- T.useLive T.unequal selection selection' <- T.useLive T.unequal selection
onPending /\ onPendingBox <- R2.useBox' false onPending /\ onPendingBox <- R2.useBox' false
...@@ -217,6 +228,7 @@ uploadButtonCpt = here.component "uploadButton" cpt ...@@ -217,6 +228,7 @@ uploadButtonCpt = here.component "uploadButton" cpt
, disabled , disabled
, style : { width: "100%" } , style : { width: "100%" }
, on: { click: onClick , on: { click: onClick
fileFormat'
fileType' fileType'
mFile' mFile'
selection' selection'
...@@ -228,25 +240,23 @@ uploadButtonCpt = here.component "uploadButton" cpt ...@@ -228,25 +240,23 @@ uploadButtonCpt = here.component "uploadButton" cpt
where where
onClick fileType' mFile' selection' onPendingBox e = do onClick fileFormat' fileType' mFile' selection' onPendingBox e = do
let { blob, name } = unsafePartial $ fromJust mFile' let { blob, name } = unsafePartial $ fromJust mFile'
T.write_ true onPendingBox T.write_ true onPendingBox
here.log2 "[uploadButton] fileType" fileType' here.log2 "[uploadButton] fileType" fileType'
void $ launchAff do void $ launchAff do
case fileType' of case fileType' of
Arbitrary -> Arbitrary ->
dispatch $ UploadArbitraryFile (Just name) blob selection' dispatch $ UploadArbitraryFile fileFormat' (Just name) blob selection'
ZIP -> do
liftEffect $ here.log "[uploadButton] reading base64"
contents <- readUFBAsBase64 blob
liftEffect $ here.log "[uploadButton] base64 read"
dispatch $ UploadFile nodeType fileType' (Just name) contents selection'
_ -> do _ -> do
contents <- readUFBAsText blob contents <- case fileFormat' of
dispatch $ UploadFile nodeType fileType' (Just name) contents selection' Plain -> readUFBAsText blob
ZIP -> readUFBAsBase64 blob
dispatch $ UploadFile nodeType fileType' fileFormat' (Just name) contents selection'
liftEffect $ do liftEffect $ do
T.write_ Nothing mFile T.write_ Nothing mFile
T.write_ CSV fileType T.write_ CSV fileType
T.write_ Plain fileFormat
T.write_ EN lang T.write_ EN lang
T.write_ false onPendingBox T.write_ false onPendingBox
dispatch ClosePopover dispatch ClosePopover
...@@ -331,7 +341,7 @@ fileTypeViewCpt = here.component "fileTypeView" cpt ...@@ -331,7 +341,7 @@ fileTypeViewCpt = here.component "fileTypeView" cpt
T.write_ Nothing droppedFile T.write_ Nothing droppedFile
launchAff $ do launchAff $ do
contents <- readUFBAsText blob contents <- readUFBAsText blob
dispatch $ UploadFile nodeType ft Nothing contents (SelectedLists []) dispatch $ UploadFile nodeType ft Plain Nothing contents (SelectedLists [])
} }
} [H.text "Upload"] } [H.text "Upload"]
Nothing -> Nothing ->
...@@ -354,6 +364,7 @@ instance GT.ToQuery FileUploadQuery where ...@@ -354,6 +364,7 @@ instance GT.ToQuery FileUploadQuery where
pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ] pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ]
uploadFile :: { contents :: String uploadFile :: { contents :: String
, fileFormat :: FileFormat
, fileType :: FileType , fileType :: FileType
, id :: ID , id :: ID
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
...@@ -371,7 +382,7 @@ uploadFile session NodeList id JSON { mName, contents } = do ...@@ -371,7 +382,7 @@ uploadFile session NodeList id JSON { mName, contents } = do
task <- post session url body task <- post session url body
pure $ GT.AsyncTaskWithType { task, typ: GT.Form } pure $ GT.AsyncTaskWithType { task, typ: GT.Form }
-} -}
uploadFile { contents, fileType, id, nodeType, mName, session } = do uploadFile { contents, fileFormat, fileType, id, nodeType, mName, session } = do
-- contents <- readAsText blob -- contents <- readAsText blob
eTask :: Either RESTError GT.AsyncTask <- postWwwUrlencoded session p body eTask :: Either RESTError GT.AsyncTask <- postWwwUrlencoded session p body
pure $ (\task -> GT.AsyncTaskWithType { task, typ }) <$> eTask pure $ (\task -> GT.AsyncTaskWithType { task, typ }) <$> eTask
...@@ -379,10 +390,12 @@ uploadFile { contents, fileType, id, nodeType, mName, session } = do ...@@ -379,10 +390,12 @@ uploadFile { contents, fileType, id, nodeType, mName, session } = do
where where
bodyParams = [ Tuple "_wf_data" (Just contents) bodyParams = [ Tuple "_wf_data" (Just contents)
, Tuple "_wf_filetype" (Just $ show fileType) , Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_fileformat" (Just $ show fileFormat)
, Tuple "_wf_name" mName , Tuple "_wf_name" mName
] ]
csvBodyParams = [ Tuple "_wtf_data" (Just contents) csvBodyParams = [ Tuple "_wtf_data" (Just contents)
, Tuple "_wtf_filetype" (Just $ show NodeList) , Tuple "_wtf_filetype" (Just $ show NodeList)
, Tuple "_wtf_fileformat" (Just $ show fileFormat)
, Tuple "_wtf_name" mName ] , Tuple "_wtf_name" mName ]
(typ /\ p /\ body) = case nodeType of (typ /\ p /\ body) = case nodeType of
...@@ -397,19 +410,20 @@ uploadFile { contents, fileType, id, nodeType, mName, session } = do ...@@ -397,19 +410,20 @@ uploadFile { contents, fileType, id, nodeType, mName, session } = do
uploadArbitraryFile :: Session uploadArbitraryFile :: Session
-> ID -> ID
-> {blob :: UploadFileBlob, mName :: Maybe String} -> {blob :: UploadFileBlob, fileFormat :: FileFormat, mName :: Maybe String}
-> ListSelection.Selection -> ListSelection.Selection
-> AffRESTError GT.AsyncTaskWithType -> AffRESTError GT.AsyncTaskWithType
uploadArbitraryFile session id {mName, blob: UploadFileBlob blob} selection = do uploadArbitraryFile session id { fileFormat, mName, blob: UploadFileBlob blob } selection = do
contents <- readAsDataURL blob contents <- readAsDataURL blob
uploadArbitraryData session id mName contents uploadArbitraryData session id fileFormat mName contents
uploadArbitraryData :: Session uploadArbitraryData :: Session
-> ID -> ID
-> FileFormat
-> Maybe String -> Maybe String
-> String -> String
-> AffRESTError GT.AsyncTaskWithType -> AffRESTError GT.AsyncTaskWithType
uploadArbitraryData session id mName contents' = do uploadArbitraryData session id fileFormat mName contents' = do
let re = fromRight' (\_ -> unsafeCrashWith "Unexpected Left") $ DSR.regex "data:.*;base64," DSRF.noFlags let re = fromRight' (\_ -> unsafeCrashWith "Unexpected Left") $ DSR.regex "data:.*;base64," DSRF.noFlags
contents = DSR.replace re "" contents' contents = DSR.replace re "" contents'
eTask :: Either RESTError GT.AsyncTask <- postWwwUrlencoded session p (bodyParams contents) eTask :: Either RESTError GT.AsyncTask <- postWwwUrlencoded session p (bodyParams contents)
...@@ -418,6 +432,7 @@ uploadArbitraryData session id mName contents' = do ...@@ -418,6 +432,7 @@ uploadArbitraryData session id mName contents' = do
p = GR.NodeAPI GT.Node (Just id) $ GT.asyncTaskTypePath GT.UploadFile p = GR.NodeAPI GT.Node (Just id) $ GT.asyncTaskTypePath GT.UploadFile
bodyParams c = [ Tuple "_wfi_b64_data" (Just c) bodyParams c = [ Tuple "_wfi_b64_data" (Just c)
, Tuple "_wfi_fileformat" (Just $ show fileFormat)
, Tuple "_wfi_name" mName , Tuple "_wfi_name" mName
] ]
...@@ -515,7 +530,7 @@ uploadTermButtonCpt = here.component "uploadTermButton" cpt ...@@ -515,7 +530,7 @@ uploadTermButtonCpt = here.component "uploadTermButton" cpt
let {name, blob} = unsafePartial $ fromJust mFile' let {name, blob} = unsafePartial $ fromJust mFile'
void $ launchAff do void $ launchAff do
contents <- readUFBAsText blob contents <- readUFBAsText blob
_ <- dispatch $ UploadFile nodeType uploadType' (Just name) contents (SelectedLists []) _ <- dispatch $ UploadFile nodeType uploadType' Plain (Just name) contents (SelectedLists [])
liftEffect $ do liftEffect $ do
T.write_ Nothing mFile T.write_ Nothing mFile
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
...@@ -13,7 +13,7 @@ import Web.File.Blob (Blob, size) ...@@ -13,7 +13,7 @@ import Web.File.Blob (Blob, size)
import Web.File.FileReader.Aff (readAsArrayBuffer, readAsText) import Web.File.FileReader.Aff (readAsArrayBuffer, readAsText)
data FileType = CSV | CSV_HAL | WOS | PresseRIS | Arbitrary | JSON | ZIP data FileType = CSV | CSV_HAL | WOS | PresseRIS | Arbitrary | JSON
derive instance Generic FileType _ derive instance Generic FileType _
instance Eq FileType where eq = genericEq instance Eq FileType where eq = genericEq
...@@ -26,9 +26,18 @@ instance Read FileType where ...@@ -26,9 +26,18 @@ instance Read FileType where
read "PresseRIS" = Just PresseRIS read "PresseRIS" = Just PresseRIS
read "WOS" = Just WOS read "WOS" = Just WOS
read "JSON" = Just JSON read "JSON" = Just JSON
read "ZIP" = Just ZIP
read _ = Nothing read _ = Nothing
data FileFormat = Plain | ZIP
derive instance Generic FileFormat _
instance Eq FileFormat where eq = genericEq
instance Show FileFormat where show = genericShow
instance Read FileFormat where
read :: String -> Maybe FileFormat
read "Plain" = Just Plain
read "ZIP" = Just ZIP
read _ = Nothing
newtype UploadFileBlob = UploadFileBlob Blob newtype UploadFileBlob = UploadFileBlob Blob
derive instance Generic UploadFileBlob _ derive instance Generic UploadFileBlob _
......
...@@ -18,6 +18,7 @@ import Reactix as R ...@@ -18,6 +18,7 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryData) import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryData)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileFormat(..))
import Gargantext.Components.GraphExplorer.API (cloneGraph) import Gargantext.Components.GraphExplorer.API (cloneGraph)
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Utils as GEU import Gargantext.Components.GraphExplorer.Utils as GEU
...@@ -99,7 +100,7 @@ cameraButton { id ...@@ -99,7 +100,7 @@ cameraButton { id
case eClonedGraphId of case eClonedGraphId of
Left err -> liftEffect $ log2 "[cameraButton] RESTError" err Left err -> liftEffect $ log2 "[cameraButton] RESTError" err
Right clonedGraphId -> do Right clonedGraphId -> do
eRet <- uploadArbitraryData session clonedGraphId (Just $ nowStr <> "-" <> "screenshot.png") screen eRet <- uploadArbitraryData session clonedGraphId Plain (Just $ nowStr <> "-" <> "screenshot.png") screen
case eRet of case eRet of
Left err -> liftEffect $ log2 "[cameraButton] RESTError" err Left err -> liftEffect $ log2 "[cameraButton] RESTError" err
Right _ret -> do Right _ret -> do
......
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