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
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Grégoire Locqueville
purescript-gargantext
Commits
b0608841
Commit
b0608841
authored
4 years ago
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Tree] async file upload -- first draft
parent
7e0f6430
Changes
5
Show whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
69 additions
and
48 deletions
+69
-48
Tree.purs
src/Gargantext/Components/Forest/Tree.purs
+11
-11
Action.purs
src/Gargantext/Components/Forest/Tree/Node/Action.purs
+2
-2
Upload.purs
...Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
+34
-31
Box.purs
src/Gargantext/Components/Forest/Tree/Node/Box.purs
+7
-3
Types.purs
src/Gargantext/Types.purs
+15
-1
No files found.
src/Gargantext/Components/Forest/Tree.purs
View file @
b0608841
module Gargantext.Components.Forest.Tree where
import Data.Array as A
import DOM.Simple.Console (log2)
import Data.Maybe (Maybe)
-- import Data.Newtype (class Newtype)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Data.Array as Array
import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan)
...
...
@@ -55,7 +55,7 @@ loadedTreeView reload p = R.createElement el p []
where
el = R.hooksComponent "LoadedTreeView" cpt
cpt {tree, mCurrentRoute, session, frontends} _ = do
treeState <- R.useState' {tree}
treeState <- R.useState' {tree
, asyncTasks: []
}
pure $ H.div {className: "tree"}
[ toHtml reload treeState session frontends mCurrentRoute ]
...
...
@@ -67,7 +67,7 @@ toHtml :: R.State Reload
-> Frontends
-> Maybe AppRoute
-> R.Element
toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _) session frontends mCurrentRoute = R.createElement el {} []
toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)
, asyncTasks
} /\ _) session frontends mCurrentRoute = R.createElement el {} []
where
el = R.hooksComponent "NodeView" cpt
pAction = performAction session reload treeState
...
...
@@ -79,7 +79,7 @@ toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _)
pure $ H.ul {}
[ H.li {}
( [ nodeMainSpan pAction {id, name, nodeType, mCurrentRoute} folderOpen session frontends ]
( [ nodeMainSpan pAction {id,
asyncTasks,
name, nodeType, mCurrentRoute} folderOpen session frontends ]
<> childNodes session frontends reload folderOpen mCurrentRoute ary
)
]
...
...
@@ -95,15 +95,15 @@ childNodes :: Session
childNodes _ _ _ _ _ [] = []
childNodes _ _ _ (false /\ _) _ _ = []
childNodes session frontends reload (true /\ _) mCurrentRoute ary =
map (\ctree -> childNode {tree: ctree}) $ sorted ary
map (\ctree -> childNode {tree: ctree
, asyncTasks: []
}) $ sorted ary
where
sorted :: Array FTree -> Array FTree
sorted = A
rray
.sortWith (\(NTree (LNode {id}) _) -> id)
sorted = A.sortWith (\(NTree (LNode {id}) _) -> id)
childNode :: Tree -> R.Element
childNode props = R.createElement el props []
el = R.hooksComponent "ChildNodeView" cpt
cpt {tree} _ = do
treeState <- R.useState' {tree}
treeState <- R.useState' {tree
, asyncTasks: []
}
pure $ toHtml reload treeState session frontends mCurrentRoute
...
...
@@ -124,7 +124,7 @@ performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTre
void $ createNode session id $ CreateValue {name, nodeType}
liftEffect $ setReload (_ + 1)
performAction session _ ({tree: NTree (LNode {id}) _} /\
_
) (UploadFile fileType contents) = do
hashes
<- uploadFile session id fileType contents
liftEffect $
log2 "uploaded:" hashes
performAction session _ ({tree: NTree (LNode {id}) _} /\
setTree
) (UploadFile fileType contents) = do
task
<- uploadFile session id fileType contents
liftEffect $
setTree $ \t@{asyncTasks} -> t { asyncTasks = A.cons task asyncTasks }
liftEffect $ log2 "uploaded, task:" task
This diff is collapsed.
Click to expand it.
src/Gargantext/Components/Forest/Tree/Node/Action.purs
View file @
b0608841
...
...
@@ -9,7 +9,7 @@ import Data.Newtype (class Newtype)
import Effect.Aff (Aff)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put, post, delete)
import Gargantext.Types (NodeType(..))
import Gargantext.Types (NodeType(..)
, AsyncTask(..)
)
import Prelude hiding (div)
data Action = Submit String
...
...
@@ -85,7 +85,7 @@ instance encodeJsonCreateValue :: EncodeJson CreateValue where
data NTree a = NTree a (Array (NTree a))
type FTree = NTree LNode
type Tree = { tree :: FTree }
type Tree = { tree :: FTree
, asyncTasks :: Array AsyncTask
}
instance ntreeFunctor :: Functor NTree where
map f (NTree x ary) = NTree (f x) (map (map f) ary)
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
View file @
b0608841
...
...
@@ -7,7 +7,6 @@ import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Effect.Uncurried (mkEffectFn1)
import Partial.Unsafe (unsafePartial)
import React.SyntheticEvent as E
import Reactix as R
...
...
@@ -19,7 +18,7 @@ import Web.File.FileReader.Aff (readAsText)
import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, postWwwUrlencoded)
import Gargantext.Types (class ToQuery, toQuery, NodeType(..))
import Gargantext.Types (class ToQuery, toQuery, NodeType(..)
, AsyncTask(..)
)
import Gargantext.Utils (id)
import Gargantext.Utils.Reactix as R2
...
...
@@ -44,16 +43,17 @@ uploadFileViewCpt d = R.hooksComponent "UploadFileView" cpt
, H.div {} [ H.input {type: "file", placeholder: "Choose file", on: {change: onChangeContents mContents}} ]
, H.div {}
[ R2.select {className: "col-md-12 form-control"
, onChange: onChangeFileType fileType}
, on: {change: onChangeFileType fileType}
}
(map renderOption [CSV, PresseRIS])
]
, H.div {}
[ uploadButton id mContents fileType ]
[ uploadButton
d
id mContents fileType ]
]
renderOption opt = H.option {} [ H.text $ show opt ]
onChangeContents (mContents /\ setMContents)
= mkEffectFn1 $ \e ->
do
onChangeContents (mContents /\ setMContents)
e =
do
blob <- R2.inputFileBlob e
E.preventDefault e
E.stopPropagation e
...
...
@@ -62,18 +62,18 @@ uploadFileViewCpt d = R.hooksComponent "UploadFileView" cpt
liftEffect $ do
setMContents $ const $ Just $ UploadFileContents contents
onChangeFileType (fileType /\ setFileType)
= mkEffectFn1 $ \e ->
do
onChangeFileType (fileType /\ setFileType)
e =
do
setFileType $ const $ unsafePartial $ fromJust $ readFileType $ R2.unsafeEventValue e
uploadButton ::
Int -> R.State (Maybe UploadFileContents) -> R.State FileType -> R.Element
uploadButton
id (mContents /\ setMContents) (fileType /\ setFileType) =
H.button {className: "btn btn-primary", disabled, onClick
} [ H.text "Upload" ]
uploadButton :: (Action -> Aff Unit) ->
Int -> R.State (Maybe UploadFileContents) -> R.State FileType -> R.Element
uploadButton d
id (mContents /\ setMContents) (fileType /\ setFileType) =
H.button {className: "btn btn-primary", disabled, on: {click: onClick}
} [ H.text "Upload" ]
where
disabled = case mContents of
Nothing -> "1"
Just _ -> ""
onClick = mkEffectFn1 $ \e ->
do
onClick e =
do
let contents = unsafePartial $ fromJust mContents
void $ launchAff do
_ <- d $ UploadFile fileType contents
...
...
@@ -115,9 +115,10 @@ fileTypeView d p (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) (_
[ H.h5 {} [H.text "Choose file type"] ]
, H.div {className: "col-md-2"}
[ H.a {className: "btn glyphitem glyphicon glyphicon-remove-circle"
, on
Click: mkEffectFn1 $
\_ -> do
, on
: {click:
\_ -> do
setDroppedFile $ const Nothing
setIsDragOver $ const false
}
, title: "Close"} []
]
]
...
...
@@ -125,11 +126,12 @@ fileTypeView d p (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) (_
panelBody =
H.div {className: "panel-body"}
[ R2.select {className: "col-md-12 form-control"
, onChange: onChange}
, on: {change: onChange}
}
(map renderOption [CSV, PresseRIS])
]
where
onChange
= mkEffectFn1 $ \e ->
onChange
e =
setDroppedFile $ const $ Just $ DroppedFile $ {contents, fileType: readFileType $ R2.unsafeEventValue e}
renderOption opt = H.option {} [ H.text $ show opt ]
panelFooter =
...
...
@@ -139,9 +141,10 @@ fileTypeView d p (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) (_
Just ft ->
H.button {className: "btn btn-success"
, type: "button"
, on
Click: mkEffectFn1 $
\_ -> do
, on
: {click:
\_ -> do
setDroppedFile $ const Nothing
launchAff $ d $ UploadFile ft contents
}
} [H.text "Upload"]
Nothing ->
H.button {className: "btn btn-success disabled"
...
...
@@ -164,9 +167,9 @@ instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where
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) ]
uploadFile :: Session -> ID -> FileType -> UploadFileContents -> Aff
(Array FileHash)
uploadFile :: Session -> ID -> FileType -> UploadFileContents -> Aff
AsyncTask
uploadFile session id fileType (UploadFileContents fileContents) =
postWwwUrlencoded session p fileContents
where
q = FileUploadQuery { fileType: fileType }
p = NodeAPI
Node (Just id) $ "add/file
" <> Q.print (toQuery q)
p = NodeAPI
Corpus (Just id) $ "add/file/async
" <> Q.print (toQuery q)
This diff is collapsed.
Click to expand it.
src/Gargantext/Components/Forest/Tree/Node/Box.purs
View file @
b0608841
...
...
@@ -19,10 +19,10 @@ import Gargantext.Ends (Frontends, url)
import Gargantext.Routes (AppRoute)
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (NodeType(..), NodePath(..), fldr)
import Gargantext.Types (NodeType(..), NodePath(..), fldr
, AsyncTask(..)
)
import Gargantext.Utils (glyphicon, glyphiconActive)
import Gargantext.Utils.Reactix as R2
import Prelude (Unit, bind, const, discard, identity, map, pure, show, void, ($), (<>), (==), (-), (+))
import Prelude (Unit, bind, const, discard, identity, map, pure, show, void, ($), (<
$>), (<
>), (==), (-), (+))
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
...
...
@@ -34,6 +34,7 @@ import Web.File.FileReader.Aff (readAsText)
-- Main Node
type NodeMainSpanProps =
( id :: ID
, asyncTasks :: Array AsyncTask
, name :: Name
, nodeType :: NodeType
, mCurrentRoute :: Maybe AppRoute
...
...
@@ -48,7 +49,7 @@ nodeMainSpan :: (Action -> Aff Unit)
nodeMainSpan d p folderOpen session frontends = R.createElement el p []
where
el = R.hooksComponent "NodeMainSpan" cpt
cpt props@{id, name, nodeType, mCurrentRoute} _ = do
cpt props@{id,
asyncTasks,
name, nodeType, mCurrentRoute} _ = do
-- only 1 popup at a time is allowed to be opened
popupOpen <- R.useState' (Nothing :: Maybe NodePopup)
popupPosition <- R.useState' (Nothing :: Maybe R2.Point)
...
...
@@ -65,6 +66,7 @@ nodeMainSpan d p folderOpen session frontends = R.createElement el p []
, popOverIcon showBox popupOpen popupPosition
, mNodePopupView props showBox popupOpen popupPosition
, fileTypeView d {id, nodeType} droppedFile isDragOver
, H.div {} (progressBar <$> asyncTasks)
]
where
SettingsBox {show: showBox} = settingsBox nodeType
...
...
@@ -131,6 +133,8 @@ nodeMainSpan d p folderOpen session frontends = R.createElement el p []
setIsDragOver $ const true
onDragLeave (_ /\ setIsDragOver) _ = setIsDragOver $ const false
progressBar (AsyncTask {id}) = H.div {className: "progress"} [ H.text id ]
{-
fldr nt open = if open
then "fa fa-globe" -- <> color nt
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Types.purs
View file @
b0608841
module Gargantext.Types where
import Prelude
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), jsonEmptyObject)
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (
.:), (
:=), (~>), jsonEmptyObject)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), maybe)
import Effect.Aff (Aff)
...
...
@@ -434,3 +434,17 @@ modeFromString "Sources" = Just Sources
modeFromString "Institutes" = Just Institutes
modeFromString "Terms" = Just Terms
modeFromString _ = Nothing
newtype AsyncTask = AsyncTask {
id :: String
, status :: String
}
derive instance genericAsyncTask :: Generic AsyncTask _
instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
decodeJson json = do
obj <- decodeJson json
id <- obj .: "id"
status <- obj .: "status"
pure $ AsyncTask {id, status}
This diff is collapsed.
Click to expand it.
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