Commit 750a8661 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[MERGE]

parents c04f9e84 b454c023
{ {
"name": "Gargantext", "name": "Gargantext",
"version": "0.0.1.7.3", "version": "0.0.1.7.4",
"scripts": { "scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall", "rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall", "rebuild-set": "spago psc-package-insdhall",
......
...@@ -19,6 +19,7 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts (annuaireUserLayout, u ...@@ -19,6 +19,7 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts (annuaireUserLayout, u
import Gargantext.Components.Nodes.Corpus (corpusLayout) import Gargantext.Components.Nodes.Corpus (corpusLayout)
import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout) import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout)
import Gargantext.Components.Nodes.Corpus.Document (documentLayout) import Gargantext.Components.Nodes.Corpus.Document (documentLayout)
import Gargantext.Components.Nodes.File (fileLayout)
import Gargantext.Components.Nodes.Frame (frameLayout) import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Home (homeLayout) import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Components.Nodes.Lists (listsLayout) import Gargantext.Components.Nodes.Lists (listsLayout)
...@@ -80,6 +81,7 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where ...@@ -80,6 +81,7 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
Team sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session } Team sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
RouteFrameWrite sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session } RouteFrameWrite sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session }
RouteFrameCalc sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session } RouteFrameCalc sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session }
RouteFile sid nodeId -> withSession sid $ \session -> forested $ fileLayout { nodeId, session }
Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session } Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { nodeId, session, frontends } Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { nodeId, session, frontends }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session } Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session }
......
...@@ -26,7 +26,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), re ...@@ -26,7 +26,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), re
import Gargantext.Components.Forest.Tree.Node.Action.Share as Share import Gargantext.Components.Forest.Tree.Node.Action.Share as Share
import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest) import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile) import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..)) import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Components.Forest.Tree.Node.Tools.Task (Tasks, tasksStruct) import Gargantext.Components.Forest.Tree.Node.Tools.Task (Tasks, tasksStruct)
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
...@@ -338,12 +338,21 @@ performAction (AddNode name nodeType) p@{ openNodes: (_ /\ setOpenNodes) ...@@ -338,12 +338,21 @@ performAction (AddNode name nodeType) p@{ openNodes: (_ /\ setOpenNodes)
performAction RefreshTree p performAction RefreshTree p
------- -------
performAction (UploadFile nodeType fileType mName contents) { session performAction (UploadFile nodeType fileType mName blob) { session
, tasks: { onTaskAdd } , tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _) , tree: (NTree (LNode {id}) _)
} = } =
do do
task <- uploadFile session nodeType id fileType {mName, contents} task <- uploadFile session nodeType id fileType {mName, blob}
liftEffect $ onTaskAdd task
liftEffect $ log2 "Uploaded, task:" task
performAction (UploadArbitraryFile nodeType mName blob) { session
, tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _)
} =
do
task <- uploadArbitraryFile session nodeType id { blob, mName }
liftEffect $ onTaskAdd task liftEffect $ onTaskAdd task
liftEffect $ log2 "Uploaded, task:" task liftEffect $ log2 "Uploaded, task:" task
......
...@@ -13,7 +13,7 @@ import Web.File.FileReader.Aff (readAsText) ...@@ -13,7 +13,7 @@ import Web.File.FileReader.Aff (readAsText)
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox) import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileContents(..)) import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), fileTypeView) import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), fileTypeView)
import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView) import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
import Gargantext.Components.Forest.Tree.Node.Box.Types (CommonProps) import Gargantext.Components.Forest.Tree.Node.Box.Types (CommonProps)
...@@ -122,8 +122,9 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, handed, session } = R.createEl ...@@ -122,8 +122,9 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, handed, session } = R.createEl
folderIcon nodeType folderOpen'@(open /\ _) = folderIcon nodeType folderOpen'@(open /\ _) =
H.a { className: "folder-icon" H.a { className: "folder-icon"
, onClick: R2.effToggler folderOpen' , onClick: R2.effToggler folderOpen'
} } [
[ H.i {className: GT.fldr nodeType open} [] ] H.i {className: GT.fldr nodeType open} []
]
popOverIcon = H.a { className: "settings fa fa-cog" } [] popOverIcon = H.a { className: "settings fa fa-cog" } []
...@@ -151,11 +152,11 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, handed, session } = R.createEl ...@@ -151,11 +152,11 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, handed, session } = R.createEl
E.stopPropagation e E.stopPropagation e
blob <- R2.dataTransferFileBlob e blob <- R2.dataTransferFileBlob e
void $ launchAff do void $ launchAff do
contents <- readAsText blob --contents <- readAsText blob
liftEffect $ setDroppedFile liftEffect $ setDroppedFile
$ const $ const
$ Just $ Just
$ DroppedFile { contents: (UploadFileContents contents) $ DroppedFile { blob: (UploadFileBlob blob)
, fileType: Just CSV , fileType: Just CSV
, lang : EN , lang : EN
} }
......
...@@ -7,7 +7,7 @@ import Gargantext.Sessions (Session) ...@@ -7,7 +7,7 @@ import Gargantext.Sessions (Session)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut, SubTreeParams(..)) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut, SubTreeParams(..))
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), glyphiconNodeAction) import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), glyphiconNodeAction)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileContents) import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileBlob)
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.Contact.Types (AddContactParams) import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams)
...@@ -24,7 +24,8 @@ data Action = AddNode String GT.NodeType ...@@ -24,7 +24,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) UploadFileContents | UploadFile GT.NodeType FileType (Maybe String) UploadFileBlob
| UploadArbitraryFile GT.NodeType (Maybe String) UploadFileBlob
| DownloadNode | DownloadNode
| RefreshTree | RefreshTree
...@@ -54,57 +55,60 @@ setTreeOut a _ = a ...@@ -54,57 +55,60 @@ setTreeOut a _ = a
instance showShow :: Show Action where instance showShow :: 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 RefreshTree = "RefreshTree" show (UploadArbitraryFile _ _ _) = "UploadArbitraryFile"
show DownloadNode = "Download" show RefreshTree = "RefreshTree"
show (MoveNode _ ) = "MoveNode" show DownloadNode = "Download"
show (MergeNode _ ) = "MergeNode" show (MoveNode _ ) = "MoveNode"
show (LinkNode _ ) = "LinkNode" show (MergeNode _ ) = "MergeNode"
show NoAction = "NoAction" show (LinkNode _ ) = "LinkNode"
show NoAction = "NoAction"
----------------------------------------------------------------------- -----------------------------------------------------------------------
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 RefreshTree = glyphiconNodeAction Refresh icon (UploadArbitraryFile _ _ _ ) = glyphiconNodeAction Upload
icon DownloadNode = glyphiconNodeAction Download icon RefreshTree = glyphiconNodeAction Refresh
icon (MoveNode _ ) = glyphiconNodeAction (Move { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }}) icon DownloadNode = glyphiconNodeAction Download
icon (MergeNode _ ) = glyphiconNodeAction (Merge { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }}) icon (MoveNode _ ) = glyphiconNodeAction (Move { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (LinkNode _ ) = glyphiconNodeAction (Link { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }}) icon (MergeNode _ ) = glyphiconNodeAction (Merge { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (LinkNode _ ) = glyphiconNodeAction (Link { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
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 RefreshTree = "Refresh Tree !" text (UploadArbitraryFile _ _ _) = "Upload arbitrary file !"
text DownloadNode = "Download !" text RefreshTree = "Refresh Tree !"
text (MoveNode _ ) = "Move !" text DownloadNode = "Download !"
text (MergeNode _ ) = "Merge !" text (MoveNode _ ) = "Move !"
text (LinkNode _ ) = "Link !" text (MergeNode _ ) = "Merge !"
text NoAction = "No Action" text (LinkNode _ ) = "Link !"
text NoAction = "No Action"
----------------------------------------------------------------------- -----------------------------------------------------------------------
module Gargantext.Components.Forest.Tree.Node.Action.Upload where module Gargantext.Components.Forest.Tree.Node.Action.Upload where
import Data.Either (fromRight)
import Data.Maybe (Maybe(..), fromJust, fromMaybe) import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.String.Regex as DSR
import Data.String.Regex.Flags as DSRF
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff, throwError)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception (error)
import Partial.Unsafe (unsafePartial)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as QP
import Web.File.Blob (Blob)
import Web.File.FileReader.Aff (readAsDataURL, readAsText)
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), Props) import Gargantext.Components.Forest.Tree.Node.Action (Action(..), Props)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileContents(..)) import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..))
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.Prelude (class Show, Unit, discard, bind, const, id, map, pure, show, unit, void, ($), read)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, postWwwUrlencoded) import Gargantext.Sessions (Session, postWwwUrlencoded)
import Gargantext.Types (NodeType(..), ID) import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial) import Gargantext.Utils.String as GUS
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as QP
import Web.File.FileReader.Aff (readAsText)
-- UploadFile Action -- UploadFile Action
...@@ -45,7 +54,7 @@ actionUpload _ _ _ _ = ...@@ -45,7 +54,7 @@ actionUpload _ _ _ _ =
-- file upload types -- file upload types
data DroppedFile = data DroppedFile =
DroppedFile { contents :: UploadFileContents DroppedFile { blob :: UploadFileBlob
, fileType :: Maybe FileType , fileType :: Maybe FileType
, lang :: Lang , lang :: Lang
} }
...@@ -54,7 +63,7 @@ type FileHash = String ...@@ -54,7 +63,7 @@ type FileHash = String
type UploadFile = type UploadFile =
{ contents :: UploadFileContents { blob :: UploadFileBlob
, name :: String , name :: String
} }
...@@ -81,6 +90,7 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt ...@@ -81,6 +90,7 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
, CSV_HAL , CSV_HAL
, WOS , WOS
, PresseRIS , PresseRIS
, Arbitrary
] CSV setFileType ] CSV setFileType
] ]
...@@ -112,20 +122,10 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt ...@@ -112,20 +122,10 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
case mF of case mF of
Nothing -> pure unit Nothing -> pure unit
Just {blob, name} -> void $ launchAff do Just {blob, name} -> void $ launchAff do
contents <- readAsText blob --contents <- readAsText blob
--contents <- readAsDataURL blob
liftEffect $ do liftEffect $ do
setMFile $ const $ Just $ {contents: UploadFileContents contents, name} setMFile $ const $ Just $ {blob: UploadFileBlob blob, name}
onChangeFileType :: forall e
. R.State FileType
-> e
-> Effect Unit
onChangeFileType (fileType /\ setFileType) e = do
setFileType $ const
$ unsafePartial
$ fromJust
$ read
$ R2.unsafeEventValue e
type UploadButtonProps = type UploadButtonProps =
...@@ -162,9 +162,14 @@ uploadButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadButton" cpt ...@@ -162,9 +162,14 @@ uploadButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadButton" cpt
Just _ -> "" Just _ -> ""
onClick e = do onClick e = do
let {name, contents} = unsafePartial $ fromJust mFile let { blob, name } = unsafePartial $ fromJust mFile
log2 "[uploadButton] fileType" fileType
void $ launchAff do void $ launchAff do
_ <- dispatch $ UploadFile nodeType fileType (Just name) contents case fileType of
Arbitrary ->
dispatch $ UploadArbitraryFile nodeType (Just name) blob
_ ->
dispatch $ UploadFile nodeType fileType (Just name) blob
liftEffect $ do liftEffect $ do
setMFile $ const $ Nothing setMFile $ const $ Nothing
setFileType $ const $ CSV setFileType $ const $ CSV
...@@ -186,7 +191,7 @@ fileTypeViewCpt :: R.Component FileTypeProps ...@@ -186,7 +191,7 @@ fileTypeViewCpt :: R.Component FileTypeProps
fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt
where where
cpt { dispatch cpt { dispatch
, droppedFile: Just (DroppedFile {contents, fileType}) /\ setDroppedFile , droppedFile: Just (DroppedFile {blob, fileType}) /\ setDroppedFile
, isDragOver: (_ /\ setIsDragOver) , isDragOver: (_ /\ setIsDragOver)
, nodeType , nodeType
} _ = pure } _ = pure
...@@ -229,7 +234,7 @@ fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt ...@@ -229,7 +234,7 @@ fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt
] ]
where where
onChange e l = onChange e l =
setDroppedFile $ const $ Just $ DroppedFile $ { contents setDroppedFile $ const $ Just $ DroppedFile $ { blob
, fileType: read $ R2.unsafeEventValue e , fileType: read $ R2.unsafeEventValue e
, lang : fromMaybe EN $ read $ R2.unsafeEventValue l , lang : fromMaybe EN $ read $ R2.unsafeEventValue l
} }
...@@ -244,7 +249,7 @@ fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt ...@@ -244,7 +249,7 @@ fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt
, type: "button" , type: "button"
, on: {click: \_ -> do , on: {click: \_ -> do
setDroppedFile $ const Nothing setDroppedFile $ const Nothing
launchAff $ dispatch $ UploadFile nodeType ft Nothing contents launchAff $ dispatch $ UploadFile nodeType ft Nothing blob
} }
} [H.text "Upload"] } [H.text "Upload"]
Nothing -> Nothing ->
...@@ -272,24 +277,47 @@ uploadFile :: Session ...@@ -272,24 +277,47 @@ uploadFile :: Session
-> GT.NodeType -> GT.NodeType
-> ID -> ID
-> FileType -> FileType
-> {contents :: UploadFileContents, mName :: Maybe String} -> {blob :: UploadFileBlob, mName :: Maybe String}
-> Aff GT.AsyncTaskWithType -> Aff GT.AsyncTaskWithType
uploadFile session nodeType id fileType {mName, contents: UploadFileContents contents} = do uploadFile session nodeType id fileType {mName, blob: UploadFileBlob blob} = do
task <- postWwwUrlencoded session p bodyParams contents <- readAsText blob
pure $ GT.AsyncTaskWithType {task, typ: GT.Form} task <- postWwwUrlencoded session p (bodyParams contents)
pure $ GT.AsyncTaskWithType {task, typ: GT.Form}
--postMultipartFormData session p fileContents --postMultipartFormData session p fileContents
where where
q = FileUploadQuery { fileType: fileType }
--p = NodeAPI GT.Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q)
p = case nodeType of p = case nodeType of
Corpus -> GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.Form Corpus -> GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.Form
Annuaire -> GR.NodeAPI nodeType (Just id) "annuaire" Annuaire -> GR.NodeAPI nodeType (Just id) "annuaire"
_ -> GR.NodeAPI nodeType (Just id) "" _ -> GR.NodeAPI nodeType (Just id) ""
bodyParams = [ Tuple "_wf_data" (Just contents) bodyParams c = [ Tuple "_wf_data" (Just c)
, Tuple "_wf_filetype" (Just $ show fileType) , Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_name" mName , Tuple "_wf_name" mName
] ]
uploadArbitraryFile :: Session
-> GT.NodeType
-> ID
-> {blob :: UploadFileBlob, mName :: Maybe String}
-> Aff GT.AsyncTaskWithType
uploadArbitraryFile session nodeType id {mName, blob: UploadFileBlob blob} = do
if nodeType == Corpus then
pure unit
else
throwError $ error $ "[uploadArbitraryFile] NodeType " <> (show nodeType) <> " not supported"
contents' <- readAsDataURL blob
let re = unsafePartial $ fromRight $ DSR.regex "data:.*;base64," DSRF.noFlags
contents = DSR.replace re "" contents'
task <- postWwwUrlencoded session p (bodyParams contents)
pure $ GT.AsyncTaskWithType { task, typ: GT.Form }
where
p = GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.UploadFile
bodyParams c = [ Tuple "_wfi_b64_data" (Just c)
, Tuple "_wfi_name" mName
]
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -325,9 +353,9 @@ uploadTermListViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadTermListView" cpt ...@@ -325,9 +353,9 @@ uploadTermListViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadTermListView" cpt
case mF of case mF of
Nothing -> pure unit Nothing -> pure unit
Just {blob, name} -> void $ launchAff do Just {blob, name} -> void $ launchAff do
contents <- readAsText blob --contents <- readAsText blob
liftEffect $ do liftEffect $ do
setMFile $ const $ Just $ { contents: UploadFileContents contents setMFile $ const $ Just $ { blob: UploadFileBlob blob
, name , name
} }
...@@ -353,9 +381,9 @@ uploadTermButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadTermButton" cpt ...@@ -353,9 +381,9 @@ uploadTermButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadTermButton" cpt
Just _ -> "" Just _ -> ""
onClick e = do onClick e = do
let {name, contents} = unsafePartial $ fromJust mFile let {name, blob} = unsafePartial $ fromJust mFile
void $ launchAff do void $ launchAff do
_ <- dispatch $ UploadFile nodeType CSV (Just name) contents _ <- dispatch $ UploadFile nodeType CSV (Just name) blob
liftEffect $ do liftEffect $ do
setMFile $ const $ Nothing setMFile $ const $ Nothing
......
...@@ -4,10 +4,12 @@ import Data.Generic.Rep (class Generic) ...@@ -4,10 +4,12 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Web.File.Blob (Blob)
import Gargantext.Prelude (class Read, class Show, class Eq) import Gargantext.Prelude (class Read, class Show, class Eq)
data FileType = CSV | CSV_HAL | WOS | PresseRIS data FileType = CSV | CSV_HAL | WOS | PresseRIS | Arbitrary
derive instance genericFileType :: Generic FileType _ derive instance genericFileType :: Generic FileType _
...@@ -23,9 +25,8 @@ instance readFileType :: Read FileType where ...@@ -23,9 +25,8 @@ instance readFileType :: Read FileType where
read "CSV_HAL" = Just CSV_HAL read "CSV_HAL" = Just CSV_HAL
read "PresseRIS" = Just PresseRIS read "PresseRIS" = Just PresseRIS
read "WOS" = Just WOS read "WOS" = Just WOS
read "Arbitrary" = Just Arbitrary
read _ = Nothing read _ = Nothing
newtype UploadFileContents = UploadFileContents String newtype UploadFileBlob = UploadFileBlob Blob
...@@ -303,6 +303,14 @@ settingsBox NodeFrameCalc = ...@@ -303,6 +303,14 @@ settingsBox NodeFrameCalc =
} }
settingsBox NodeFile =
SettingsBox { show: true
, edit: true
, doc: Documentation NodeFile
, buttons: [ Delete ]
}
settingsBox _ = settingsBox _ =
SettingsBox { show : false SettingsBox { show : false
, edit : false , edit : false
......
...@@ -164,7 +164,7 @@ formChoice :: forall a b c d ...@@ -164,7 +164,7 @@ formChoice :: forall a b c d
formChoice nodeTypes defaultNodeType setNodeType = formChoice nodeTypes defaultNodeType setNodeType =
H.div { className: "form-group"} H.div { className: "form-group"}
[ R2.select { className: "form-control" [ R2.select { className: "form-control"
, on: { change: \_ -> setNodeType , on: { change: setNodeType
<<< const <<< const
<<< fromMaybe defaultNodeType <<< fromMaybe defaultNodeType
<<< read <<< read
......
module Gargantext.Components.Nodes.File where
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Maybe (Maybe(..))
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types as T
newtype HyperdataFile = HyperdataFile {
mime :: String
, name :: String
, path :: String
}
instance decodeHyperdataFile :: DecodeJson HyperdataFile where
decodeJson json = do
obj <- decodeJson json
mime <- obj .: "mime"
name <- obj .: "name"
path <- obj .: "path"
pure $ HyperdataFile {
mime
, name
, path
}
newtype File = File {
id :: Int
, date :: String
, hyperdata :: HyperdataFile
, name :: String
}
instance decodeFile :: DecodeJson File where
decodeJson json = do
obj <- decodeJson json
id <- obj .: "id"
date <- obj .: "date"
hyperdata' <- obj .: "hyperdata"
hyperdata <- decodeJson hyperdata'
name <- obj .: "name"
pure $ File {
id
, date
, hyperdata
, name
}
type FileLayoutProps = (
nodeId :: Int
, session :: Session
)
fileLayout :: Record FileLayoutProps -> R.Element
fileLayout props = R.createElement fileLayoutCpt props []
fileLayoutCpt :: R.Component FileLayoutProps
fileLayoutCpt = R.hooksComponent "G.C.N.F.fileLayout" cpt
where
cpt { nodeId, session } _ = do
useLoader { nodeId } (loadFile session) $ \loaded ->
fileLayoutLoaded { loaded, nodeId, session }
type LoadFileProps = (
nodeId :: Int
)
loadFile :: Session -> Record LoadFileProps -> Aff File
loadFile session { nodeId } = get session $ NodeAPI T.Node (Just nodeId) ""
type FileLayoutLoadedProps = (
loaded :: File
| FileLayoutProps
)
fileLayoutLoaded :: Record FileLayoutLoadedProps -> R.Element
fileLayoutLoaded props = R.createElement fileLayoutLoadedCpt props []
fileLayoutLoadedCpt :: R.Component FileLayoutLoadedProps
fileLayoutLoadedCpt = R.hooksComponent "G.C.N.F.fileLayoutLoaded" cpt
where
cpt { loaded: File { hyperdata: HyperdataFile hyperdata }, nodeId, session } _ = do
R.useEffect' $ do
log2 "[fileLayoutLoaded] hyperdata" hyperdata
pure $ H.div { className: "col-md-12" } [
H.div { className: "row" } [
H.h2 {} [ H.text hyperdata.name ]
]
, H.div { className: "row" } [
H.div { className: "btn btn-default" } [
H.a { href: "/api/v1.0/node/" <> show nodeId <> "/file/download"
, target: "_blank"
} [ H.text "Download" ]
]
]
]
...@@ -33,6 +33,7 @@ router = oneOf ...@@ -33,6 +33,7 @@ router = oneOf
, RouteFrameWrite <$> (route "write" *> sid) <*> int , RouteFrameWrite <$> (route "write" *> sid) <*> int
, RouteFrameCalc <$> (route "calc" *> sid) <*> int , RouteFrameCalc <$> (route "calc" *> sid) <*> int
, RouteFile <$> (route "file" *> sid) <*> int
, Home <$ lit "" , Home <$ lit ""
] ]
where where
......
...@@ -27,6 +27,7 @@ data AppRoute ...@@ -27,6 +27,7 @@ data AppRoute
| ContactPage SessionId Int Int | ContactPage SessionId Int Int
| RouteFrameWrite SessionId Int | RouteFrameWrite SessionId Int
| RouteFrameCalc SessionId Int | RouteFrameCalc SessionId Int
| RouteFile SessionId Int
derive instance eqAppRoute :: Eq AppRoute derive instance eqAppRoute :: Eq AppRoute
...@@ -74,6 +75,7 @@ instance showAppRoute :: Show AppRoute where ...@@ -74,6 +75,7 @@ instance showAppRoute :: Show AppRoute where
show (ContactPage s a i) = "Contact" <> show a <> "::" <> show i <> " (" <> show s <> ")" show (ContactPage s a i) = "Contact" <> show a <> "::" <> show i <> " (" <> show s <> ")"
show (RouteFrameWrite s i) = "write" <> show i <> " (" <> show s <> ")" show (RouteFrameWrite s i) = "write" <> show i <> " (" <> show s <> ")"
show (RouteFrameCalc s i) = "calc" <> show i <> " (" <> show s <> ")" show (RouteFrameCalc s i) = "calc" <> show i <> " (" <> show s <> ")"
show (RouteFile s i) = "file" <> show i <> " (" <> show s <> ")"
appPath :: AppRoute -> String appPath :: AppRoute -> String
...@@ -94,8 +96,9 @@ appPath (Lists s i) = "lists/" <> show s <> "/" <> show i ...@@ -94,8 +96,9 @@ appPath (Lists s i) = "lists/" <> show s <> "/" <> show i
appPath (Annuaire s i) = "annuaire/" <> show s <> "/" <> show i appPath (Annuaire s i) = "annuaire/" <> show s <> "/" <> show i
appPath (UserPage s i) = "user/" <> show s <> "/" <> show i appPath (UserPage s i) = "user/" <> show s <> "/" <> show i
appPath (ContactPage s a i) = "annuaire/" <> show s <> "/" <> show a <> "/contact/" <> show i appPath (ContactPage s a i) = "annuaire/" <> show s <> "/" <> show a <> "/contact/" <> show i
appPath (RouteFrameWrite s i) = "write/" <> show s <> "/" <> show i appPath (RouteFrameWrite s i) = "write/" <> show s <> "/" <> show i
appPath (RouteFrameCalc s i) = "calc/" <> show s <> "/" <> show i appPath (RouteFrameCalc s i) = "calc/" <> show s <> "/" <> show i
appPath (RouteFile s i) = "file/" <> show s <> "/" <> show i
nodeTypeAppRoute :: NodeType -> SessionId -> Int -> Maybe AppRoute nodeTypeAppRoute :: NodeType -> SessionId -> Int -> Maybe AppRoute
nodeTypeAppRoute GT.Annuaire s i = Just $ Annuaire s i nodeTypeAppRoute GT.Annuaire s i = Just $ Annuaire s i
......
...@@ -166,36 +166,38 @@ data NodeType = NodeUser ...@@ -166,36 +166,38 @@ data NodeType = NodeUser
| NodeFrameWrite | NodeFrameWrite
| NodeFrameCalc | NodeFrameCalc
| NodePublic NodeType | NodePublic NodeType
| NodeFile
derive instance eqNodeType :: Eq NodeType derive instance eqNodeType :: Eq NodeType
instance showNodeType :: Show NodeType where instance showNodeType :: Show NodeType where
show NodeUser = "NodeUser" show NodeUser = "NodeUser"
show Folder = "NodeFolder" show Folder = "NodeFolder"
show FolderPrivate = "NodeFolderPrivate" -- Node Private Worktop show FolderPrivate = "NodeFolderPrivate" -- Node Private Worktop
show FolderShared = "NodeFolderShared" -- Node Share Worktop show FolderShared = "NodeFolderShared" -- Node Share Worktop
show FolderPublic = "NodeFolderPublic" -- Node Public Worktop show FolderPublic = "NodeFolderPublic" -- Node Public Worktop
show Annuaire = "NodeAnnuaire" show Annuaire = "NodeAnnuaire"
show NodeContact = "NodeContact" show NodeContact = "NodeContact"
show Corpus = "NodeCorpus" show Corpus = "NodeCorpus"
show Dashboard = "NodeDashboard" show Dashboard = "NodeDashboard"
show Url_Document = "NodeDocument" show Url_Document = "NodeDocument"
show Error = "NodeError" show Error = "NodeError"
show Graph = "NodeGraph" show Graph = "NodeGraph"
show Phylo = "NodePhylo" show Phylo = "NodePhylo"
show Individu = "NodeIndividu" show Individu = "NodeIndividu"
show Node = "Node" show Node = "Node"
show Nodes = "Nodes" show Nodes = "Nodes"
show Tree = "NodeTree" show Tree = "NodeTree"
show Team = "NodeTeam" show Team = "NodeTeam"
show NodeList = "NodeList" show NodeList = "NodeList"
show Texts = "NodeTexts" show Texts = "NodeTexts"
show NodeFrameWrite = "NodeFrameWrite" show NodeFrameWrite = "NodeFrameWrite"
show NodeFrameCalc = "NodeFrameCalc" show NodeFrameCalc = "NodeFrameCalc"
show (NodePublic nt) = "NodePublic" <> show nt show (NodePublic nt) = "NodePublic" <> show nt
show NodeFile = "NodeFile"
instance readNodeType :: Read NodeType where instance readNodeType :: Read NodeType where
...@@ -204,25 +206,26 @@ instance readNodeType :: Read NodeType where ...@@ -204,25 +206,26 @@ instance readNodeType :: Read NodeType where
read "NodeFolderPrivate" = Just FolderPrivate read "NodeFolderPrivate" = Just FolderPrivate
read "NodeFolderShared" = Just FolderShared read "NodeFolderShared" = Just FolderShared
read "NodeFolderPublic" = Just FolderPublic read "NodeFolderPublic" = Just FolderPublic
read "NodeAnnuaire" = Just Annuaire read "NodeAnnuaire" = Just Annuaire
read "NodeDashboard" = Just Dashboard read "NodeDashboard" = Just Dashboard
read "Document" = Just Url_Document read "Document" = Just Url_Document
read "NodeGraph" = Just Graph read "NodeGraph" = Just Graph
read "NodePhylo" = Just Phylo read "NodePhylo" = Just Phylo
read "Individu" = Just Individu read "Individu" = Just Individu
read "Node" = Just Node read "Node" = Just Node
read "Nodes" = Just Nodes read "Nodes" = Just Nodes
read "NodeCorpus" = Just Corpus read "NodeCorpus" = Just Corpus
read "NodeContact" = Just NodeContact read "NodeContact" = Just NodeContact
read "Tree" = Just Tree read "Tree" = Just Tree
read "NodeTeam" = Just Team read "NodeTeam" = Just Team
read "NodeList" = Just NodeList read "NodeList" = Just NodeList
read "NodeTexts" = Just Texts read "NodeTexts" = Just Texts
read "Annuaire" = Just Annuaire read "Annuaire" = Just Annuaire
read "NodeFrameWrite" = Just NodeFrameWrite read "NodeFrameWrite" = Just NodeFrameWrite
read "NodeFrameCalc" = Just NodeFrameCalc read "NodeFrameCalc" = Just NodeFrameCalc
read "NodeFile" = Just NodeFile
-- TODO NodePublic read ? -- TODO NodePublic read ?
read _ = Nothing read _ = Nothing
fldr :: NodeType -> Boolean -> String fldr :: NodeType -> Boolean -> String
...@@ -253,6 +256,7 @@ fldr Graph _ = "fa fa-hubzilla" ...@@ -253,6 +256,7 @@ fldr Graph _ = "fa fa-hubzilla"
fldr Texts _ = "fa fa-newspaper-o" fldr Texts _ = "fa fa-newspaper-o"
fldr Dashboard _ = "fa fa-signal" fldr Dashboard _ = "fa fa-signal"
fldr NodeList _ = "fa fa-list" fldr NodeList _ = "fa fa-list"
fldr NodeFile _ = "fa fa-file" -- TODO depending on mime type we can use fa-file-image etc
fldr Annuaire true = "fa fa-address-card-o" fldr Annuaire true = "fa fa-address-card-o"
fldr Annuaire false = "fa fa-address-card" fldr Annuaire false = "fa fa-address-card"
...@@ -299,29 +303,30 @@ instance encodeJsonNodeType :: EncodeJson NodeType where ...@@ -299,29 +303,30 @@ instance encodeJsonNodeType :: EncodeJson NodeType where
encodeJson nodeType = encodeJson $ show nodeType encodeJson nodeType = encodeJson $ show nodeType
nodeTypePath :: NodeType -> String nodeTypePath :: NodeType -> String
nodeTypePath Folder = "folder" nodeTypePath Folder = "folder"
nodeTypePath FolderPrivate = "folderPrivate" nodeTypePath FolderPrivate = "folderPrivate"
nodeTypePath FolderShared = "folderShared" nodeTypePath FolderShared = "folderShared"
nodeTypePath FolderPublic = "folderPublic" nodeTypePath FolderPublic = "folderPublic"
nodeTypePath Annuaire = "annuaire" nodeTypePath Annuaire = "annuaire"
nodeTypePath Corpus = "corpus" nodeTypePath Corpus = "corpus"
nodeTypePath Dashboard = "dashboard" nodeTypePath Dashboard = "dashboard"
nodeTypePath Url_Document = "document" nodeTypePath Url_Document = "document"
nodeTypePath Error = "ErrorNodeType" nodeTypePath Error = "ErrorNodeType"
nodeTypePath Graph = "graph" nodeTypePath Graph = "graph"
nodeTypePath Phylo = "phylo" nodeTypePath Phylo = "phylo"
nodeTypePath Individu = "individu" nodeTypePath Individu = "individu"
nodeTypePath Node = "node" nodeTypePath Node = "node"
nodeTypePath Nodes = "nodes" nodeTypePath Nodes = "nodes"
nodeTypePath NodeUser = "user" nodeTypePath NodeUser = "user"
nodeTypePath NodeContact = "contact" nodeTypePath NodeContact = "contact"
nodeTypePath Tree = "tree" nodeTypePath Tree = "tree"
nodeTypePath NodeList = "lists" nodeTypePath NodeList = "lists"
nodeTypePath Texts = "texts" nodeTypePath Texts = "texts"
nodeTypePath Team = "team" nodeTypePath Team = "team"
nodeTypePath NodeFrameWrite = "write" nodeTypePath NodeFrameWrite = "write"
nodeTypePath NodeFrameCalc = "calc" nodeTypePath NodeFrameCalc = "calc"
nodeTypePath (NodePublic nt) = nodeTypePath nt nodeTypePath (NodePublic nt) = nodeTypePath nt
nodeTypePath NodeFile = "file"
------------------------------------------------------------ ------------------------------------------------------------
...@@ -577,6 +582,7 @@ modeFromString _ = Nothing ...@@ -577,6 +582,7 @@ modeFromString _ = Nothing
-- corresponds to /add/form/async or /add/query/async -- corresponds to /add/form/async or /add/query/async
data AsyncTaskType = Form data AsyncTaskType = Form
| UploadFile
| GraphT | GraphT
| Query | Query
| AddNode | AddNode
...@@ -594,16 +600,18 @@ instance decodeJsonAsyncTaskType :: DecodeJson AsyncTaskType where ...@@ -594,16 +600,18 @@ instance decodeJsonAsyncTaskType :: DecodeJson AsyncTaskType where
obj <- decodeJson json obj <- decodeJson json
case obj of case obj of
"Form" -> pure Form "Form" -> pure Form
"UploadFile" -> pure UploadFile
"GraphT" -> pure GraphT "GraphT" -> pure GraphT
"Query" -> pure Query "Query" -> pure Query
"AddNode" -> pure AddNode "AddNode" -> pure AddNode
s -> Left ("Unknown string " <> s) s -> Left ("Unknown string " <> s)
asyncTaskTypePath :: AsyncTaskType -> String asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath Form = "add/form/async/" asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath Query = "query/" asyncTaskTypePath UploadFile = "add/file/async/"
asyncTaskTypePath GraphT = "async/" asyncTaskTypePath Query = "query/"
asyncTaskTypePath AddNode = "async/nobody/" asyncTaskTypePath GraphT = "async/"
asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath UpdateNode = "update/" asyncTaskTypePath UpdateNode = "update/"
......
exports._btoa = function(s) {
return btoa(unescape(encodeURIComponent(s)));
}
module Gargantext.Utils.String where
import Data.Function.Uncurried (Fn1, runFn1)
foreign import _btoa :: Fn1 String String
btoa :: String -> String
btoa = runFn1 _btoa
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