[docs] Add new document (2)

* #174: add date field, adapt xhr with async route

packages.dhall

@@ -229,4 +229,3 @@ let additions =
       }
 
 in  upstream // overrides // additions
-

src/Gargantext/Components/DocsTable.purs

@@ -4,6 +4,7 @@ module Gargantext.Components.DocsTable where
 import Gargantext.Prelude
 
 import DOM.Simple.Event as DE
+import Data.Array (any)
 import Data.Array as A
 import Data.Either (Either)
 import Data.Generic.Rep (class Generic)
@@ -21,28 +22,29 @@ import Data.Symbol (SProxy(..))
 import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested ((/\))
 import Effect (Effect)
-import Effect.Aff (Aff, Milliseconds(..), delay, launchAff_)
+import Effect.Aff (Aff, launchAff_)
 import Effect.Class (liftEffect)
+import Effect.Timer (setTimeout)
 import Gargantext.Components.App.Data (Boxes)
 import Gargantext.Components.Bootstrap as B
 import Gargantext.Components.Bootstrap.Types (ComponentStatus(..))
 import Gargantext.Components.Category (rating)
 import Gargantext.Components.Category.Types (Star(..))
-import Gargantext.Components.DocsTable.DocumentFormCreation (documentFormCreation)
+import Gargantext.Components.DocsTable.DocumentFormCreation as DFC
 import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), Year, sampleData, showSource)
 import Gargantext.Components.Nodes.Lists.Types as NT
-import Gargantext.Components.Nodes.Texts.Types (SidePanelTriggers)
-import Gargantext.Components.Score as GCS
 import Gargantext.Components.Nodes.Texts.Types as TextsT
 import Gargantext.Components.Table as TT
 import Gargantext.Components.Table.Types as TT
 import Gargantext.Config.REST (RESTError, logRESTError)
+import Gargantext.Config.Utils (handleRESTError)
 import Gargantext.Ends (Frontends, url)
 import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..))
 import Gargantext.Routes (SessionRoute(NodeAPI))
 import Gargantext.Routes as Routes
 import Gargantext.Sessions (Session, sessionId, get, delete)
 import Gargantext.Types (ListId, NodeID, NodeType(..), OrderBy(..), SidePanelState(..), TabSubType, TabType, TableResult, showTabType')
+import Gargantext.Types as GT
 import Gargantext.Utils (sortWith, (?))
 import Gargantext.Utils.CacheAPI as GUC
 import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParam, mQueryParamS, queryParam, queryParamS)
@@ -148,14 +150,15 @@ docViewCpt = here.component "docView" cpt where
       T.modify_ not isDocumentModalVisibleBox
 
     -- @createDocumentCallback
-    -- @WIP: remote business for document creation
     createDocumentCallback <- pure $ \fdata -> launchAff_ do
 
-      liftEffect $ T.write_ true onDocumentCreationPendingBox
+      liftEffect $
+        T.write_ true onDocumentCreationPendingBox
 
-      delay $ Milliseconds 2000.0
+      eTask <- DFC.create session nodeId fdata
 
-      liftEffect $ T.write_ false onDocumentCreationPendingBox
+      handleRESTError boxes.errors eTask
+        \t -> liftEffect $ launchDocumentCreationProgress boxes session nodeId t
 
     -- Render
     pure $
@@ -206,13 +209,53 @@ docViewCpt = here.component "docView" cpt where
         , hasCollapsibleBackground: false
         }
         [
-          documentFormCreation
+          DFC.documentFormCreation
           { callback: createDocumentCallback
           , status: onDocumentCreationPending ? Deferred $ Enabled
           }
         ]
       ]
 
+launchDocumentCreationProgress ::
+     Boxes
+  -> Session
+  -> GT.ID
+  -> GT.AsyncTaskWithType
+  -> Effect Unit
+launchDocumentCreationProgress boxes session nodeId currentTask
+  = void $ setTimeout 1000 $
+      launchAff_ $ scanDocumentCreationProgress boxes session nodeId currentTask
+
+scanDocumentCreationProgress ::
+     Boxes
+  -> Session
+  -> GT.ID
+  -> GT.AsyncTaskWithType
+  -> Aff Unit
+scanDocumentCreationProgress boxes session nodeId currentTask = do
+
+  eTask <- DFC.createProgress session nodeId currentTask
+
+  handleRESTError boxes.errors eTask
+    \asyncProgress -> liftEffect do
+      let
+        GT.AsyncProgress { status } = asyncProgress
+        endingStatusList =
+          [ GT.IsFinished
+          , GT.IsKilled
+          , GT.IsFailure
+          ]
+        hasEndingStatus s = any (_ # s # eq) endingStatusList
+
+      if (hasEndingStatus status)
+      then
+        here.log2 "[DocsTables] NodeDocument task:" asyncProgress
+        -- @WIP: close modal, reload docs table
+      else
+        launchDocumentCreationProgress boxes session nodeId currentTask
+
+---------------------------------------------------
+
 type SearchBarProps =
   ( query :: T.Box Query )
 

src/Gargantext/Components/DocsTable/DocumentFormCreation.purs

 module Gargantext.Components.DocsTable.DocumentFormCreation
   ( documentFormCreation
   , FormData
+  , create, createProgress
   ) where
 
 import Gargantext.Prelude
@@ -8,18 +9,25 @@ import Gargantext.Prelude
 import DOM.Simple.Console (log3)
 import Data.Either (Either(..))
 import Data.Foldable (foldl, intercalate)
+import Data.Maybe (Maybe(..))
 import Effect (Effect)
+import Effect.Aff (Aff)
 import Gargantext.Components.Bootstrap as B
 import Gargantext.Components.Bootstrap.Types (ComponentStatus(..))
+import Gargantext.Config.REST (RESTError)
 import Gargantext.Hooks.FormValidation (VForm, useFormValidation)
 import Gargantext.Hooks.FormValidation.Unboxed as FV
 import Gargantext.Hooks.StateRecord (useStateRecord)
+import Gargantext.Routes as GR
+import Gargantext.Sessions (Session, post, get)
+import Gargantext.Types as GT
 import Gargantext.Utils (nbsp, (?))
 import Gargantext.Utils.Reactix as R2
 import Reactix as R
 import Reactix.DOM.HTML as H
-import Record (merge)
+import Record as Record
 import Record.Extra (pick)
+import Type.Proxy (Proxy(..))
 
 type Props =
   ( callback  :: Record FormData -> Effect Unit
@@ -30,7 +38,7 @@ type Props =
 type Options = ( | FormData )
 
 options :: Record Options
-options = merge {} defaultData
+options = Record.merge {} defaultData
 
 documentFormCreation :: forall r. R2.OptLeaf Options Props r
 documentFormCreation = R2.optLeaf component options
@@ -48,7 +56,7 @@ component = R.hooksComponent "documentFormCreation" cpt where
       result <- fv.try (\_ -> documentFormValidation state)
 
       case result of
-        Left err -> log3 "document form validation error" state err
+        Left err -> log3 "documentFormCreation validation error" state err
         Right _  -> props.callback state
 
     -- Render
@@ -128,13 +136,42 @@ component = R.hooksComponent "documentFormCreation" cpt where
           [
             B.formInput $
             { placeholder: "ex: author1, author2, …"
-            } `merge` bindStateKey "authors"
+            } `Record.merge` bindStateKey "authors"
           ,
             R2.if' (fv.hasError' "authors") $
               H.div { className: "form-group__error" }
               [ H.text "Please enter at least one author" ]
           ]
         ]
+      ,
+        -- Date
+        H.div
+        { className: intercalate " "
+            [ "form-group"
+            , (fv.hasError' "date") ?
+                "form-group--error" $
+                mempty
+            ]
+        }
+        [
+          H.div
+          { className: "form-group__label" }
+          [
+            H.label {} [ H.text $ "Date" ]
+          ]
+        ,
+          H.div
+          { className: "form-group__field" }
+          [
+            B.formInput $
+            { type: "date"
+            } `Record.merge` bindStateKey "date"
+          ,
+            R2.if' (fv.hasError' "date") $
+              H.div { className: "form-group__error" }
+              [ H.text "Please enter a valid date" ]
+          ]
+        ]
       ,
         -- Abstract
         H.div
@@ -143,7 +180,8 @@ component = R.hooksComponent "documentFormCreation" cpt where
             ]
         }
         [
-          H.div { className: "form-group__label" }
+          H.div
+          { className: "form-group__label" }
           [
             H.label {} [ H.text $ "Abstract" <> nbsp 1 ]
           ,
@@ -152,11 +190,12 @@ component = R.hooksComponent "documentFormCreation" cpt where
             [ H.text "optional" ]
           ]
         ,
-          H.div { className: "form-group__field" }
+          H.div
+          { className: "form-group__field" }
           [
             B.formTextarea $
             { rows: 5
-            } `merge` bindStateKey "abstract"
+            } `Record.merge` bindStateKey "abstract"
           ]
         ]
       ,
@@ -178,6 +217,7 @@ type FormData =
   ( title     :: String
   , source    :: String
   , authors   :: String
+  , date      :: String
   , abstract  :: String
   )
 
@@ -186,6 +226,7 @@ defaultData =
   { title     : ""
   , source    : ""
   , authors   : ""
+  , date      : ""
   , abstract  : ""
   }
 
@@ -196,4 +237,51 @@ documentFormValidation r = foldl append mempty rules
       [ FV.nonEmpty "title" r.title
       , FV.nonEmpty "source" r.source
       , FV.nonEmpty "authors" r.authors
+      , FV.date "date" r.date
       ]
+
+
+---------------------------------------------------
+
+create ::
+     Session
+  -> GT.ID
+  -> Record FormData
+  -> Aff (Either RESTError GT.AsyncTaskWithType)
+create session nodeId =
+      rename
+  >>> post session request
+  >=> case _ of
+    Left err   -> pure $ Left err
+    Right task -> pure $ Right $ GT.AsyncTaskWithType
+      { task
+      , typ: GT.NodeDocument
+      }
+
+  where
+
+    request = GR.NodeAPI GT.Node (Just nodeId)
+      (GT.asyncTaskTypePath GT.NodeDocument)
+
+    rename = Record.rename
+      (Proxy :: Proxy "source")
+      (Proxy :: Proxy "sources")
+
+createProgress ::
+    Session
+  -> GT.ID
+  -> GT.AsyncTaskWithType
+  -> Aff (Either RESTError GT.AsyncProgress)
+createProgress
+  session
+  nodeId
+  (GT.AsyncTaskWithType { task: GT.AsyncTask { id } })
+  =
+    get session request
+
+  where
+
+    request = GR.NodeAPI GT.Node (Just nodeId)
+      (GT.asyncTaskTypePath GT.NodeDocument <> pollParams)
+
+    pollParams = id <> "/poll?limit1"

src/Gargantext/Ends.purs

@@ -195,7 +195,7 @@ sessionPath (R.ChartHash { chartType, listId, tabType } i) =
     <> "&listType=" <> show MapTerm -- listId
     <> defaultListAddMaybe listId
 -- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i
-
+sessionPath (R.NodeAPI Phylo pId p) = "phyloscape?nodeId=" <> (show $ fromMaybe 0 pId) <> p
 
 ------- misc routing stuff
 

src/Gargantext/Hooks/FormValidation/Boxed.purs

@@ -3,7 +3,7 @@ module Gargantext.Hooks.FormValidation.Boxed
   , class NonEmpty, nonEmpty
   , class Minimum, minimum
   , class Maximum, maximum
-  , lowercase, uppercase, email
+  , lowercase, uppercase, email, date
   ) where
 
 import Gargantext.Prelude
@@ -14,7 +14,7 @@ import Data.String.Regex (test)
 import Data.Tuple.Nested ((/\))
 import Data.Validation.Semigroup (invalid)
 import Effect (Effect)
-import Gargantext.Hooks.FormValidation.Types (Field, VForm, emailPattern)
+import Gargantext.Hooks.FormValidation.Types (Field, VForm, emailPattern, datePattern)
 import Toestand as T
 
 class Eq a <= Equals a where
@@ -75,3 +75,9 @@ email field = T.read >=> case _ of
   input
     | (not $ test emailPattern input) -> pure $ invalid [ field /\ "email" ]
     | otherwise                       -> pure $ pure unit
+
+date :: Field -> T.Box String -> Effect VForm
+date field = T.read >=> case _ of
+  input
+    | (not $ test datePattern input) -> pure $ invalid [ field /\ "date" ]
+    | otherwise                      -> pure $ pure unit

src/Gargantext/Hooks/FormValidation/Types.js

@@ -8,3 +8,9 @@
  *  @type {RegExp}
  */
  exports.emailPattern = /[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?/;
+/**
+ *  Date Pattern
+ *  @link https://www.regextester.com/96683
+ *  @type {RegExp}
+ */
+exports.datePattern = /([12]\d{3}-(0[1-9]|1[0-2])-(0[1-9]|[12]\d|3[01]))/

src/Gargantext/Hooks/FormValidation/Types.purs

 module Gargantext.Hooks.FormValidation.Types
   ( VForm, EForm, Field
-  , emailPattern
+  , emailPattern, datePattern
   ) where
 
 import Gargantext.Prelude
@@ -11,6 +11,7 @@ import Data.Tuple (Tuple)
 import Data.Validation.Semigroup (V)
 
 foreign import emailPattern :: Regex
+foreign import datePattern :: Regex
 
 -- @TODO: types for errors (`Tuple Field String`)?
 

src/Gargantext/Hooks/FormValidation/Unboxed.purs

@@ -3,7 +3,7 @@ module Gargantext.Hooks.FormValidation.Unboxed
   , class NonEmpty, nonEmpty
   , class Minimum, minimum
   , class Maximum, maximum
-  , lowercase, uppercase, email
+  , lowercase, uppercase, email, date
   ) where
 
 import Gargantext.Prelude
@@ -14,7 +14,7 @@ import Data.String.Regex (test)
 import Data.Tuple.Nested ((/\))
 import Data.Validation.Semigroup (invalid)
 import Effect (Effect)
-import Gargantext.Hooks.FormValidation.Types (Field, VForm, emailPattern)
+import Gargantext.Hooks.FormValidation.Types (Field, VForm, emailPattern, datePattern)
 
 class Eq a <= Equals a where
   equals :: Field -> a -> a -> Effect VForm
@@ -63,3 +63,8 @@ email :: Field -> String -> Effect VForm
 email field input
   | (not $ test emailPattern input) = pure $ invalid [ field /\ "email" ]
   | otherwise                       = pure $ pure unit
+
+date :: Field -> String -> Effect VForm
+date field input
+  | (not $ test datePattern input) = pure $ invalid [ field /\ "date" ]
+  | otherwise                      = pure $ pure unit

src/Gargantext/Types.purs

@@ -658,6 +658,7 @@ data AsyncTaskType = AddNode
                    | GraphRecompute
                    | ListUpload
                    | ListCSVUpload  -- legacy v3 CSV upload for lists
+                   | NodeDocument
                    | Query
                    | UpdateNgramsCharts
                    | UpdateNode
@@ -678,6 +679,7 @@ asyncTaskTypePath CorpusFormUpload   = "add/form/async/"
 asyncTaskTypePath GraphRecompute     = "async/recompute/"
 asyncTaskTypePath ListUpload         = "add/form/async/"
 asyncTaskTypePath ListCSVUpload      = "csv/add/form/async/"
+asyncTaskTypePath NodeDocument       = "document/upload/async"
 asyncTaskTypePath Query              = "query/"
 asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/"
 asyncTaskTypePath UpdateNode         = "update/"