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

Merge branch '311-tree-node-list-upload-file-as-json' of...

Merge branch '311-tree-node-list-upload-file-as-json' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge
parents aae0b63c 494295c0
...@@ -270,7 +270,7 @@ performAction = performAction' where ...@@ -270,7 +270,7 @@ 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 blob) p = uploadFile' nodeType fileType mName blob p performAction' (UploadFile nodeType fileType mName contents) p = uploadFile' nodeType fileType mName contents p
performAction' (UploadArbitraryFile mName blob) p = uploadArbitraryFile' mName blob p performAction' (UploadArbitraryFile mName blob) p = uploadArbitraryFile' mName blob p
performAction' DownloadNode _ = liftEffect $ log "[performAction] DownloadNode" performAction' DownloadNode _ = liftEffect $ log "[performAction] DownloadNode"
performAction' (MoveNode {params}) p = moveNode params p performAction' (MoveNode {params}) p = moveNode params p
...@@ -316,8 +316,8 @@ performAction = performAction' where ...@@ -316,8 +316,8 @@ performAction = performAction' where
addContact params p@{ nodeId: id } = addContact params p@{ nodeId: id } =
void $ Contact.contactReq p.session id params void $ Contact.contactReq p.session id params
uploadFile' nodeType fileType mName blob p@{ tasks, nodeId: id } = do uploadFile' nodeType fileType mName contents p@{ tasks, nodeId: id } = do
task <- uploadFile p.session nodeType id fileType {mName, blob} task <- uploadFile p.session nodeType id fileType {mName, contents}
liftEffect $ do liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
log2 "[performAction] UploadFile, uploaded, task:" task log2 "[performAction] UploadFile, uploaded, task:" task
......
...@@ -237,8 +237,8 @@ addNode' name nodeType p@{ forestOpen, tree: (NTree (LNode { id }) _) } = do ...@@ -237,8 +237,8 @@ addNode' name nodeType p@{ forestOpen, tree: (NTree (LNode { id }) _) } = do
liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session id)) forestOpen liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session id)) forestOpen
refreshTree p refreshTree p
uploadFile' nodeType fileType mName blob p@{ tasks, tree: (NTree (LNode { id }) _) } = do uploadFile' nodeType fileType mName contents p@{ tasks, tree: (NTree (LNode { id }) _) } = do
task <- uploadFile p.session nodeType id fileType {mName, blob} task <- uploadFile p.session nodeType id fileType {mName, contents}
liftEffect $ do liftEffect $ do
GAT.insert id task tasks GAT.insert id task tasks
log2 "[performAction] UploadFile, uploaded, task:" task log2 "[performAction] UploadFile, uploaded, task:" task
...@@ -276,7 +276,7 @@ performAction (ShareTeam username) p = shareTeam username p ...@@ -276,7 +276,7 @@ performAction (ShareTeam username) p = shareTeam username p
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 blob) p = uploadFile' nodeType fileType mName blob p performAction (UploadFile nodeType fileType mName contents) p = uploadFile' nodeType fileType mName contents p
performAction (UploadArbitraryFile mName blob) p = uploadArbitraryFile' mName blob p performAction (UploadArbitraryFile mName blob) p = uploadArbitraryFile' mName blob p
performAction DownloadNode _ = liftEffect $ log "[performAction] DownloadNode" performAction DownloadNode _ = liftEffect $ log "[performAction] DownloadNode"
performAction (MoveNode {params}) p = moveNode params p performAction (MoveNode {params}) p = moveNode params p
......
...@@ -28,7 +28,7 @@ data Action = AddNode String GT.NodeType ...@@ -28,7 +28,7 @@ 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) UploadFileBlob | UploadFile GT.NodeType FileType (Maybe String) String
| UploadArbitraryFile (Maybe String) UploadFileBlob | UploadArbitraryFile (Maybe String) UploadFileBlob
| DownloadNode | DownloadNode
| RefreshTree | RefreshTree
......
...@@ -20,16 +20,16 @@ import Reactix.DOM.HTML as H ...@@ -20,16 +20,16 @@ import Reactix.DOM.HTML as H
import Toestand as T import Toestand as T
import URI.Extra.QueryPairs as QP import URI.Extra.QueryPairs as QP
-- import Web.File.Blob (Blob) -- import Web.File.Blob (Blob)
import Web.File.FileReader.Aff (readAsDataURL, readAsText) import Web.File.FileReader.Aff (readAsDataURL)
import Gargantext.Prelude 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(..), UploadFileBlob(..)) import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..), 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.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, postWwwUrlencoded) import Gargantext.Sessions (Session, postWwwUrlencoded, post)
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
...@@ -79,12 +79,11 @@ instance Eq DroppedFile where ...@@ -79,12 +79,11 @@ instance Eq DroppedFile where
type FileHash = String type FileHash = String
type UploadFile = type UploadFile =
{ blob :: UploadFileBlob { blob :: UploadFileBlob
, name :: String , name :: String
} }
uploadFileView :: Record Props -> R.Element uploadFileView :: Record Props -> R.Element
uploadFileView props = R.createElement uploadFileViewCpt props [] uploadFileView props = R.createElement uploadFileViewCpt props []
...@@ -202,8 +201,9 @@ uploadButtonCpt = here.component "uploadButton" cpt ...@@ -202,8 +201,9 @@ uploadButtonCpt = here.component "uploadButton" cpt
case fileType' of case fileType' of
Arbitrary -> Arbitrary ->
dispatch $ UploadArbitraryFile (Just name) blob dispatch $ UploadArbitraryFile (Just name) blob
_ -> _ -> do
dispatch $ UploadFile nodeType fileType' (Just name) blob contents <- readUFBAsText blob
dispatch $ UploadFile nodeType fileType' (Just name) contents
liftEffect $ do liftEffect $ do
T.write_ Nothing mFile T.write_ Nothing mFile
T.write_ CSV fileType T.write_ CSV fileType
...@@ -288,7 +288,9 @@ fileTypeViewCpt = here.component "fileTypeView" cpt ...@@ -288,7 +288,9 @@ fileTypeViewCpt = here.component "fileTypeView" cpt
, type: "button" , type: "button"
, on: {click: \_ -> do , on: {click: \_ -> do
T.write_ Nothing droppedFile T.write_ Nothing droppedFile
launchAff $ dispatch $ UploadFile nodeType ft Nothing blob launchAff $ do
contents <- readUFBAsText blob
dispatch $ UploadFile nodeType ft Nothing contents
} }
} [H.text "Upload"] } [H.text "Upload"]
Nothing -> Nothing ->
...@@ -313,11 +315,19 @@ uploadFile :: Session ...@@ -313,11 +315,19 @@ uploadFile :: Session
-> GT.NodeType -> GT.NodeType
-> ID -> ID
-> FileType -> FileType
-> {blob :: UploadFileBlob, mName :: Maybe String} -> {contents :: String, mName :: Maybe String}
-> Aff GT.AsyncTaskWithType -> Aff GT.AsyncTaskWithType
uploadFile session nodeType id fileType {mName, blob: UploadFileBlob blob} = do uploadFile session NodeList id fileType { mName, contents } = do
contents <- readAsText blob let url = GR.NodeAPI NodeList (Just id) $ GT.asyncTaskTypePath GT.ListUpload
task <- postWwwUrlencoded session p (bodyParams contents) -- { input: { data: ..., filetype: "JSON", name: "..." } }
let body = { input: { data: contents
, filetype: "JSON"
, name: fromMaybe "" mName } }
task <- post session url body
pure $ GT.AsyncTaskWithType { task, typ: GT.Form }
uploadFile session nodeType id fileType { mName, contents } = do
-- contents <- readAsText blob
task <- postWwwUrlencoded session p bodyParams
pure $ GT.AsyncTaskWithType {task, typ: GT.Form} pure $ GT.AsyncTaskWithType {task, typ: GT.Form}
--postMultipartFormData session p fileContents --postMultipartFormData session p fileContents
where where
...@@ -326,10 +336,10 @@ uploadFile session nodeType id fileType {mName, blob: UploadFileBlob blob} = do ...@@ -326,10 +336,10 @@ uploadFile session nodeType id fileType {mName, blob: UploadFileBlob blob} = do
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 c = [ Tuple "_wf_data" (Just c) bodyParams = [ Tuple "_wf_data" (Just contents)
, Tuple "_wf_filetype" (Just $ show fileType) , Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_name" mName , Tuple "_wf_name" mName
] ]
uploadArbitraryFile :: Session uploadArbitraryFile :: Session
...@@ -366,20 +376,34 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt ...@@ -366,20 +376,34 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt
where where
cpt {dispatch, id, nodeType} _ = do cpt {dispatch, id, nodeType} _ = do
mFile <- T.useBox (Nothing :: Maybe UploadFile) mFile <- T.useBox (Nothing :: Maybe UploadFile)
uploadType <- T.useBox CSV
let body = H.input { type: "file" let input = H.input { type: "file"
, placeholder: "Choose file" , placeholder: "Choose file"
, on: {change: onChangeContents mFile} , on: {change: onChangeContents mFile}
} , className: "form-control"
}
let opt fileType = H.option { value: show fileType } [ H.text $ show fileType ]
let uploadTypeHtml = R2.select { className: "form-control"
, defaultValue: show JSON
, on: { change: onUploadTypeChange uploadType } } (opt <$> [ CSV, JSON ])
let footer = H.div {} [ uploadTermButton { dispatch let footer = H.div {} [ uploadTermButton { dispatch
, id , id
, mFile , mFile
, nodeType , nodeType
, uploadType
} }
] ]
pure $ panel [body] footer pure $ panel
[ H.form {}
[ R2.row [ R2.col 12 [ input ] ]
, R2.row [ R2.col 12 [ uploadTypeHtml ] ]
]
] footer
onChangeContents :: forall e. T.Box (Maybe UploadFile) onChangeContents :: forall e. T.Box (Maybe UploadFile)
-> E.SyntheticEvent_ e -> E.SyntheticEvent_ e
...@@ -396,12 +420,18 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt ...@@ -396,12 +420,18 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt
T.write_ (Just $ { blob: UploadFileBlob blob T.write_ (Just $ { blob: UploadFileBlob blob
, name }) mFile , name }) mFile
onUploadTypeChange uploadType e = do
case read (R.unsafeEventValue e) of
Nothing -> pure unit
Just fileType -> T.write_ fileType uploadType
type UploadTermButtonProps = type UploadTermButtonProps =
( dispatch :: Action -> Aff Unit ( dispatch :: Action -> Aff Unit
, id :: Int , id :: Int
, mFile :: T.Box (Maybe UploadFile) , mFile :: T.Box (Maybe UploadFile)
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, uploadType :: T.Box FileType
) )
uploadTermButton :: R2.Leaf UploadTermButtonProps uploadTermButton :: R2.Leaf UploadTermButtonProps
...@@ -412,21 +442,24 @@ uploadTermButtonCpt = here.component "uploadTermButton" cpt ...@@ -412,21 +442,24 @@ uploadTermButtonCpt = here.component "uploadTermButton" cpt
cpt { dispatch cpt { dispatch
, id , id
, mFile , mFile
, nodeType } _ = do , nodeType
, uploadType } _ = do
mFile' <- T.useLive T.unequal mFile mFile' <- T.useLive T.unequal mFile
uploadType' <- T.useLive T.unequal uploadType
let disabled = case mFile' of let disabled = case mFile' of
Nothing -> "1" Nothing -> "1"
Just _ -> "" Just _ -> ""
pure $ H.button { className: "btn btn-primary" pure $ H.button { className: "btn btn-primary"
, disabled , disabled
, on: {click: onClick mFile'} , on: { click: onClick mFile' uploadType' }
} [ H.text "Upload" ] } [ H.text "Upload" ]
where where
onClick mFile' e = do onClick mFile' uploadType' e = do
let {name, blob} = unsafePartial $ fromJust mFile' let {name, blob} = unsafePartial $ fromJust mFile'
void $ launchAff do void $ launchAff do
_ <- dispatch $ UploadFile nodeType CSV (Just name) blob contents <- readUFBAsText blob
_ <- dispatch $ UploadFile nodeType uploadType' (Just name) contents
liftEffect $ do liftEffect $ do
T.write_ Nothing mFile T.write_ Nothing mFile
...@@ -4,12 +4,14 @@ import Data.Generic.Rep (class Generic) ...@@ -4,12 +4,14 @@ import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Web.File.Blob (Blob, size) import Web.File.Blob (Blob, size)
import Web.File.FileReader.Aff (readAsText)
import Gargantext.Prelude import Gargantext.Prelude
data FileType = CSV | CSV_HAL | WOS | PresseRIS | Arbitrary data FileType = CSV | CSV_HAL | WOS | PresseRIS | Arbitrary | JSON
derive instance Generic FileType _ derive instance Generic FileType _
instance Eq FileType where instance Eq FileType where
...@@ -23,6 +25,7 @@ instance Read FileType where ...@@ -23,6 +25,7 @@ instance 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 "JSON" = Just JSON
read _ = Nothing read _ = Nothing
...@@ -30,3 +33,6 @@ newtype UploadFileBlob = UploadFileBlob Blob ...@@ -30,3 +33,6 @@ newtype UploadFileBlob = UploadFileBlob Blob
derive instance Generic UploadFileBlob _ derive instance Generic UploadFileBlob _
instance Eq UploadFileBlob where instance Eq UploadFileBlob where
eq (UploadFileBlob b1) (UploadFileBlob b2) = eq (size b1) (size b2) eq (UploadFileBlob b1) (UploadFileBlob b2) = eq (size b1) (size b2)
readUFBAsText :: UploadFileBlob -> Aff String
readUFBAsText (UploadFileBlob b) = readAsText b
...@@ -652,6 +652,7 @@ modeFromString _ = Nothing ...@@ -652,6 +652,7 @@ modeFromString _ = Nothing
data AsyncTaskType = AddNode data AsyncTaskType = AddNode
| Form -- this is file upload too | Form -- this is file upload too
| GraphRecompute | GraphRecompute
| ListUpload
| Query | Query
| UpdateNgramsCharts | UpdateNgramsCharts
| UpdateNode | UpdateNode
...@@ -669,6 +670,7 @@ asyncTaskTypePath :: AsyncTaskType -> String ...@@ -669,6 +670,7 @@ asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath AddNode = "async/nobody/" asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath Form = "add/form/async/" asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath GraphRecompute = "async/recompute/" asyncTaskTypePath GraphRecompute = "async/recompute/"
asyncTaskTypePath ListUpload = "add/form/async/"
asyncTaskTypePath Query = "query/" asyncTaskTypePath Query = "query/"
asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/" asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/"
asyncTaskTypePath UpdateNode = "update/" asyncTaskTypePath UpdateNode = "update/"
......
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