Commit b0608841 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[Tree] async file upload -- first draft

parent 7e0f6430
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 = Array.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
......@@ -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)
......
......@@ -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,24 +62,24 @@ 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" ]
where
disabled = case mContents of
Nothing -> "1"
Just _ -> ""
onClick = mkEffectFn1 $ \e -> do
let contents = unsafePartial $ fromJust mContents
void $ launchAff do
_ <- d $ UploadFile fileType contents
liftEffect $ do
setMContents $ const $ Nothing
setFileType $ const $ CSV
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 e = do
let contents = unsafePartial $ fromJust mContents
void $ launchAff do
_ <- d $ UploadFile fileType contents
liftEffect $ do
setMContents $ const $ Nothing
setFileType $ const $ CSV
-- START File Type View
type FileTypeProps =
......@@ -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"
, onClick: mkEffectFn1 $ \_ -> do
setDroppedFile $ const Nothing
setIsDragOver $ const false
, 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"
, onClick: mkEffectFn1 $ \_ -> do
setDroppedFile $ const Nothing
launchAff $ d $ UploadFile ft contents
, 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)
......@@ -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
......
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}
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