Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
133
Issues
133
List
Board
Labels
Milestones
Merge Requests
1
Merge Requests
1
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
purescript-gargantext
Commits
2aa09c28
Commit
2aa09c28
authored
Mar 04, 2020
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Upload] add file name when uploading it
parent
aec09ff0
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
73 additions
and
46 deletions
+73
-46
Tree.purs
src/Gargantext/Components/Forest/Tree.purs
+3
-3
Action.purs
src/Gargantext/Components/Forest/Tree/Node/Action.purs
+5
-1
Upload.purs
...Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
+47
-36
Reactix.purs
src/Gargantext/Utils/Reactix.purs
+18
-6
No files found.
src/Gargantext/Components/Forest/Tree.purs
View file @
2aa09c28
...
@@ -173,7 +173,7 @@ performAction session (NTree (LNode {id}) _) (_ /\ setReload) (_ /\ setOpenNodes
...
@@ -173,7 +173,7 @@ performAction session (NTree (LNode {id}) _) (_ /\ setReload) (_ /\ setOpenNodes
setOpenNodes (Set.insert (mkNodeId session id))
setOpenNodes (Set.insert (mkNodeId session id))
setReload (_ + 1)
setReload (_ + 1)
performAction session (NTree (LNode {id}) _) _ _ (_ /\ setAsyncTasks) (UploadFile nodeType fileType contents) = do
performAction session (NTree (LNode {id}) _) _ _ (_ /\ setAsyncTasks) (UploadFile nodeType fileType
mName
contents) = do
task <- uploadFile session nodeType id fileType
contents
task <- uploadFile session nodeType id fileType
{mName, contents}
liftEffect $ setAsyncTasks $ A.cons task
liftEffect $ setAsyncTasks $ A.cons task
liftEffect $ log2 "uploaded, task:" task
liftEffect $ log2 "uploaded, task:" task
\ No newline at end of file
src/Gargantext/Components/Forest/Tree/Node/Action.purs
View file @
2aa09c28
...
@@ -18,7 +18,7 @@ data Action = CreateSubmit String GT.NodeType
...
@@ -18,7 +18,7 @@ data Action = CreateSubmit String GT.NodeType
| DeleteNode
| DeleteNode
| SearchQuery GT.AsyncTaskWithType
| SearchQuery GT.AsyncTaskWithType
| Submit String
| Submit String
| UploadFile GT.NodeType FileType UploadFileContents
| UploadFile GT.NodeType FileType
(Maybe String)
UploadFileContents
-----------------------------------------------------
-----------------------------------------------------
-- UploadFile Action
-- UploadFile Action
...
@@ -52,6 +52,10 @@ type ID = Int
...
@@ -52,6 +52,10 @@ type ID = Int
type Reload = Int
type Reload = Int
newtype UploadFileContents = UploadFileContents String
newtype UploadFileContents = UploadFileContents String
type UploadFile = {
contents :: UploadFileContents
, name :: String
}
createNode :: Session -> ID -> CreateValue -> Aff (Array ID)
createNode :: Session -> ID -> CreateValue -> Aff (Array ID)
createNode session parentId = post session $ NodeAPI GT.Node (Just parentId) ""
createNode session parentId = post session $ NodeAPI GT.Node (Just parentId) ""
...
...
src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
View file @
2aa09c28
...
@@ -14,6 +14,7 @@ import React.SyntheticEvent as E
...
@@ -14,6 +14,7 @@ import React.SyntheticEvent as E
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as QP
import URI.Extra.QueryPairs as QP
import Web.File.File as WF
import Web.File.FileReader.Aff (readAsText)
import Web.File.FileReader.Aff (readAsText)
import Gargantext.Prelude
import Gargantext.Prelude
...
@@ -42,14 +43,14 @@ uploadFileViewCpt :: R.Component Props
...
@@ -42,14 +43,14 @@ uploadFileViewCpt :: R.Component Props
uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
where
where
cpt {dispatch: d, id, nodeType} _ = do
cpt {dispatch: d, id, nodeType} _ = do
m
Contents :: R.State (Maybe UploadFileContents
) <- R.useState' Nothing
m
File :: R.State (Maybe UploadFile
) <- R.useState' Nothing
fileType :: R.State FileType <- R.useState' CSV
fileType :: R.State FileType <- R.useState' CSV
lang :: R.State (Maybe Lang) <- R.useState' (Just EN)
lang :: R.State (Maybe Lang) <- R.useState' (Just EN)
pure $ H.div {} [
pure $ H.div {} [
H.div {} [ H.input { type: "file"
H.div {} [ H.input { type: "file"
, placeholder: "Choose file"
, placeholder: "Choose file"
, on: {change: onChangeContents m
Contents
}
, on: {change: onChangeContents m
File
}
}
}
]
]
...
@@ -70,7 +71,7 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
...
@@ -70,7 +71,7 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
} (map renderOptionLang [EN, FR])
} (map renderOptionLang [EN, FR])
]
]
, H.div {} [ uploadButton {action: d, fileType, lang, id, m
Contents
, nodeType } ]
, H.div {} [ uploadButton {action: d, fileType, lang, id, m
File
, nodeType } ]
]
]
renderOptionFT :: FileType -> R.Element
renderOptionFT :: FileType -> R.Element
...
@@ -79,15 +80,17 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
...
@@ -79,15 +80,17 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
renderOptionLang :: Lang -> R.Element
renderOptionLang :: Lang -> R.Element
renderOptionLang opt = H.option {} [ H.text $ show opt ]
renderOptionLang opt = H.option {} [ H.text $ show opt ]
onChangeContents :: forall e. R.State (Maybe UploadFile
Contents
) -> E.SyntheticEvent_ e -> Effect Unit
onChangeContents :: forall e. R.State (Maybe UploadFile) -> E.SyntheticEvent_ e -> Effect Unit
onChangeContents (m
Contents /\ setMContents
) e = do
onChangeContents (m
File /\ setMFile
) e = do
blob <- R2.inputFileBlob
e
let mF = R2.inputFileNameWithBlob 0
e
E.preventDefault e
E.preventDefault e
E.stopPropagation e
E.stopPropagation e
void $ launchAff do
case mF of
contents <- readAsText blob
Nothing -> pure unit
liftEffect $ do
Just {blob, name} -> void $ launchAff do
setMContents $ const $ Just $ UploadFileContents contents
contents <- readAsText blob
liftEffect $ do
setMFile $ const $ Just $ {contents: UploadFileContents contents, name}
onChangeFileType :: forall e. R.State FileType -> e -> Effect Unit
onChangeFileType :: forall e. R.State FileType -> e -> Effect Unit
onChangeFileType (fileType /\ setFileType) e = do
onChangeFileType (fileType /\ setFileType) e = do
...
@@ -111,7 +114,7 @@ type UploadButtonProps =
...
@@ -111,7 +114,7 @@ type UploadButtonProps =
, fileType :: R.State FileType
, fileType :: R.State FileType
, id :: Int
, id :: Int
, lang :: R.State (Maybe Lang)
, lang :: R.State (Maybe Lang)
, m
Contents :: R.State (Maybe UploadFileContents
)
, m
File :: R.State (Maybe UploadFile
)
, nodeType :: GT.NodeType
, nodeType :: GT.NodeType
)
)
...
@@ -121,19 +124,19 @@ uploadButton props = R.createElement uploadButtonCpt props []
...
@@ -121,19 +124,19 @@ uploadButton props = R.createElement uploadButtonCpt props []
uploadButtonCpt :: R.Component UploadButtonProps
uploadButtonCpt :: R.Component UploadButtonProps
uploadButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadButton" cpt
uploadButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadButton" cpt
where
where
cpt {action, fileType: (fileType /\ setFileType), id, lang: (lang /\ setLang), m
Contents: (mContents /\ setMContents
), nodeType} _ = do
cpt {action, fileType: (fileType /\ setFileType), id, lang: (lang /\ setLang), m
File: (mFile /\ setMFile
), nodeType} _ = do
pure $ H.button {className: "btn btn-primary", disabled, on: {click: onClick}} [ H.text "Upload" ]
pure $ H.button {className: "btn btn-primary", disabled, on: {click: onClick}} [ H.text "Upload" ]
where
where
disabled = case m
Contents
of
disabled = case m
File
of
Nothing -> "1"
Nothing -> "1"
Just _ -> ""
Just _ -> ""
onClick e = do
onClick e = do
let
contents = unsafePartial $ fromJust mContents
let
{name, contents} = unsafePartial $ fromJust mFile
void $ launchAff do
void $ launchAff do
_ <- action $ UploadFile nodeType fileType contents
_ <- action $ UploadFile nodeType fileType
(Just name)
contents
liftEffect $ do
liftEffect $ do
setM
Contents
$ const $ Nothing
setM
File
$ const $ Nothing
setFileType $ const $ CSV
setFileType $ const $ CSV
setLang $ const $ Just EN
setLang $ const $ Just EN
...
@@ -204,7 +207,7 @@ fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt
...
@@ -204,7 +207,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 $ action $ UploadFile nodeType ft contents
launchAff $ action $ UploadFile nodeType ft
Nothing
contents
}
}
} [H.text "Upload"]
} [H.text "Upload"]
Nothing ->
Nothing ->
...
@@ -228,8 +231,13 @@ instance fileUploadQueryToQuery :: GT.ToQuery FileUploadQuery where
...
@@ -228,8 +231,13 @@ instance fileUploadQueryToQuery :: GT.ToQuery FileUploadQuery where
where pair :: forall a. Show a => String -> a -> Array (Tuple QP.Key (Maybe QP.Value))
where pair :: forall a. Show a => String -> a -> Array (Tuple QP.Key (Maybe QP.Value))
pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ]
pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ]
uploadFile :: Session -> GT.NodeType -> ID -> FileType -> UploadFileContents -> Aff GT.AsyncTaskWithType
uploadFile :: Session
uploadFile session nodeType id fileType (UploadFileContents fileContents) = do
-> GT.NodeType
-> ID
-> FileType
-> {contents :: UploadFileContents, mName :: Maybe String}
-> Aff GT.AsyncTaskWithType
uploadFile session nodeType id fileType {mName, contents: UploadFileContents contents} = do
task <- postWwwUrlencoded session p bodyParams
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
...
@@ -238,8 +246,9 @@ uploadFile session nodeType id fileType (UploadFileContents fileContents) = do
...
@@ -238,8 +246,9 @@ uploadFile session nodeType id fileType (UploadFileContents fileContents) = do
--p = NodeAPI GT.Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q)
--p = NodeAPI GT.Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q)
p = GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.Form
p = GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.Form
bodyParams = [
bodyParams = [
Tuple "_wf_data" (Just
fileC
ontents)
Tuple "_wf_data" (Just
c
ontents)
, Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_name" mName
]
]
uploadTermListView :: Record Props -> R.Element
uploadTermListView :: Record Props -> R.Element
...
@@ -249,34 +258,36 @@ uploadTermListViewCpt :: R.Component Props
...
@@ -249,34 +258,36 @@ uploadTermListViewCpt :: R.Component Props
uploadTermListViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadTermListView" cpt
uploadTermListViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadTermListView" cpt
where
where
cpt {dispatch, id, nodeType} _ = do
cpt {dispatch, id, nodeType} _ = do
m
Contents :: R.State (Maybe UploadFileContents
) <- R.useState' Nothing
m
File :: R.State (Maybe UploadFile
) <- R.useState' Nothing
pure $ H.div {} [
pure $ H.div {} [
H.div {} [ H.input { type: "file"
H.div {} [ H.input { type: "file"
, placeholder: "Choose file"
, placeholder: "Choose file"
, on: {change: onChangeContents m
Contents
}
, on: {change: onChangeContents m
File
}
}
}
]
]
, H.div {} [ uploadTermButton { dispatch, id, m
Contents
, nodeType } ]
, H.div {} [ uploadTermButton { dispatch, id, m
File
, nodeType } ]
]
]
onChangeContents :: forall e. R.State (Maybe UploadFile
Contents
) -> E.SyntheticEvent_ e -> Effect Unit
onChangeContents :: forall e. R.State (Maybe UploadFile) -> E.SyntheticEvent_ e -> Effect Unit
onChangeContents (m
Contents /\ setMContents
) e = do
onChangeContents (m
File /\ setMFile
) e = do
blob <- R2.inputFileBlob
e
let mF = R2.inputFileNameWithBlob 0
e
E.preventDefault e
E.preventDefault e
E.stopPropagation e
E.stopPropagation e
void $ launchAff do
case mF of
contents <- readAsText blob
Nothing -> pure unit
liftEffect $ do
Just {blob, name} -> void $ launchAff do
setMContents $ const $ Just $ UploadFileContents contents
contents <- readAsText blob
liftEffect $ do
setMFile $ const $ Just $ {contents: UploadFileContents contents, name}
type UploadTermButtonProps =
type UploadTermButtonProps =
(
(
dispatch :: Action -> Aff Unit
dispatch :: Action -> Aff Unit
, id :: Int
, id :: Int
, m
Contents :: R.State (Maybe UploadFileContents
)
, m
File :: R.State (Maybe UploadFile
)
, nodeType :: GT.NodeType
, nodeType :: GT.NodeType
)
)
...
@@ -286,19 +297,19 @@ uploadTermButton props = R.createElement uploadTermButtonCpt props []
...
@@ -286,19 +297,19 @@ uploadTermButton props = R.createElement uploadTermButtonCpt props []
uploadTermButtonCpt :: R.Component UploadTermButtonProps
uploadTermButtonCpt :: R.Component UploadTermButtonProps
uploadTermButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadTermButton" cpt
uploadTermButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadTermButton" cpt
where
where
cpt {dispatch, id, m
Contents: (mContents /\ setMContents
), nodeType} _ = do
cpt {dispatch, id, m
File: (mFile /\ setMFile
), nodeType} _ = do
pure $ H.button {className: "btn btn-primary", disabled, on: {click: onClick}} [ H.text "Upload" ]
pure $ H.button {className: "btn btn-primary", disabled, on: {click: onClick}} [ H.text "Upload" ]
where
where
disabled = case m
Contents
of
disabled = case m
File
of
Nothing -> "1"
Nothing -> "1"
Just _ -> ""
Just _ -> ""
onClick e = do
onClick e = do
let
contents = unsafePartial $ fromJust mContents
let
{name, contents} = unsafePartial $ fromJust mFile
void $ launchAff do
void $ launchAff do
_ <- dispatch $ UploadFile nodeType CSV contents
_ <- dispatch $ UploadFile nodeType CSV
(Just name)
contents
liftEffect $ do
liftEffect $ do
setM
Contents
$ const $ Nothing
setM
File
$ const $ Nothing
copyFromCorpusView :: Record Props -> R.Element
copyFromCorpusView :: Record Props -> R.Element
copyFromCorpusView props = R.createElement copyFromCorpusViewCpt props []
copyFromCorpusView props = R.createElement copyFromCorpusViewCpt props []
...
...
src/Gargantext/Utils/Reactix.purs
View file @
2aa09c28
...
@@ -34,7 +34,8 @@ import Reactix.React (react)
...
@@ -34,7 +34,8 @@ import Reactix.React (react)
import Reactix.SyntheticEvent as RE
import Reactix.SyntheticEvent as RE
import Reactix.Utils (currySecond, hook, tuple)
import Reactix.Utils (currySecond, hook, tuple)
import Unsafe.Coerce (unsafeCoerce)
import Unsafe.Coerce (unsafeCoerce)
import Web.File.File (toBlob)
import Web.File.Blob (Blob)
import Web.File.File as WF
import Web.File.FileList (FileList, item)
import Web.File.FileList (FileList, item)
import Web.HTML (window)
import Web.HTML (window)
import Web.HTML.Window (localStorage)
import Web.HTML.Window (localStorage)
...
@@ -221,17 +222,28 @@ useCache i f = do
...
@@ -221,17 +222,28 @@ useCache i f = do
R.unsafeHooksEffect (R.setRef oRef $ Just new)
R.unsafeHooksEffect (R.setRef oRef $ Just new)
pure new
pure new
inputFile :: forall e. Int -> e -> Maybe WF.File
inputFile n e = item n $ ((el .. "files") :: FileList)
where
el = e .. "target"
-- | Get blob from an 'onchange' e.target event
-- | Get blob from an 'onchange' e.target event
inputFileBlob e = unsafePartial $ do
inputFileBlob n e = unsafePartial $ do
let el = e .. "target"
let ff = fromJust $ inputFile n e
let ff = fromJust $ item 0 $ ((el .. "files") :: FileList)
pure $ WF.toBlob ff
pure $ toBlob ff
inputFileNameWithBlob :: forall e. Int -> e -> Maybe {blob :: Blob, name :: String}
inputFileNameWithBlob n e = case ff of
Nothing -> Nothing
Just f -> Just {blob: WF.toBlob f, name: WF.name f}
where
ff = inputFile n e
-- | Get blob from a drop event
-- | Get blob from a drop event
--dataTransferFileBlob :: forall e. DE.IsEvent e => RE.SyntheticEvent e -> Effect Blob
--dataTransferFileBlob :: forall e. DE.IsEvent e => RE.SyntheticEvent e -> Effect Blob
dataTransferFileBlob e = unsafePartial $ do
dataTransferFileBlob e = unsafePartial $ do
let ff = fromJust $ item 0 $ ((e .. "dataTransfer" .. "files") :: FileList)
let ff = fromJust $ item 0 $ ((e .. "dataTransfer" .. "files") :: FileList)
pure $ toBlob ff
pure $
WF.
toBlob ff
blur :: DOM.Element -> Effect Unit
blur :: DOM.Element -> Effect Unit
blur el = el ... "blur" $ []
blur el = el ... "blur" $ []
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment