[Tree] async file upload -- first draft

src/Gargantext/Components/Forest/Tree.purs

 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

src/Gargantext/Components/Forest/Tree/Node/Action.purs

@@ -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)

src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs

@@ -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)

src/Gargantext/Components/Forest/Tree/Node/Box.purs

@@ -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

src/Gargantext/Types.purs

 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}