Merge remote-tracking branch 'origin/dev-merge-nix-2' into dev-merge
[gargantext.git] / src / Gargantext / API / Node / DocumentUpload.hs
index 2d63efe39df9b50681702dc9ddcf3bc288037fe8..9d250ee7b8d6f8f0039a7d486ee2e40e1f11c149 100644 (file)
@@ -8,32 +8,35 @@ module Gargantext.API.Node.DocumentUpload where
 import Control.Lens (makeLenses, view)
 import Data.Aeson
 import Data.Swagger (ToSchema)
-import qualified Data.Text as T
-import Data.Time.Clock
-import Data.Time.Calendar
 import GHC.Generics (Generic)
 import Servant
 import Servant.Job.Async
+import qualified Data.Text as T
 
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Job (jobLogSuccess)
 import Gargantext.API.Prelude
 import Gargantext.Core (Lang(..))
-import Gargantext.Core.Text.Terms (TermType(..))
-import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Core.Text.Corpus.Parsers.Date (dateSplit)
 import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
-import Gargantext.Database.Action.Flow (flowDataText, DataText(..))
 import Gargantext.Database.Action.Flow.Types
+import Gargantext.Core.Text.Terms (TermType(..))
+import Gargantext.Database.Action.Flow (insertMasterDocs)
 import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
+import qualified Gargantext.Database.Query.Table.Node.Document.Add  as Doc  (add)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.Node (getClosestParentIdByType')
 import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus(..))
+
 
 data DocumentUpload = DocumentUpload
   { _du_abstract :: T.Text
   , _du_authors  :: T.Text
   , _du_sources  :: T.Text
-  , _du_title    :: T.Text }
+  , _du_title    :: T.Text 
+  , _du_date     :: T.Text 
+  }
   deriving (Generic)
 
 $(makeLenses ''DocumentUpload)
@@ -66,29 +69,40 @@ api :: UserId -> NodeId -> GargServer API
 api uId nId =
   serveJobsAPI $
     JobFunction (\q log' -> do
-      documentUpload uId nId q (liftBase . log')
+      documentUploadAsync uId nId q (liftBase . log')
     )
 
-documentUpload :: (FlowCmdM env err m)
+documentUploadAsync :: (FlowCmdM env err m)
                => UserId
                -> NodeId
                -> DocumentUpload
                -> (JobLog -> m ())
                -> m JobLog
-documentUpload uId nId doc logStatus = do
+documentUploadAsync _uId nId doc logStatus = do
   let jl = JobLog { _scst_succeeded = Just 0
                   , _scst_failed    = Just 0
                   , _scst_remaining = Just 1
                   , _scst_events    = Just [] }
   logStatus jl
+  docIds <- documentUpload nId doc
+  printDebug "documentUploadAsync" docIds
+  pure $ jobLogSuccess jl
 
+
+
+documentUpload :: (FlowCmdM env err m)
+               => NodeId
+               -> DocumentUpload
+               -> m [DocId]
+documentUpload nId doc = do
   mcId <- getClosestParentIdByType' nId NodeCorpus
   let cId = case mcId of
         Just c  -> c
         Nothing -> panic $ T.pack $ "[G.A.N.DU] Node has no corpus parent: " <> show nId
-
-  (year, month, day) <- liftBase $ getCurrentTime >>= return . toGregorian . utctDay
-  let nowS = T.pack $ show year <> "-" <> show month <> "-" <> show day
+  (theFullDate, (year, month, day)) <- liftBase $ dateSplit EN 
+                                                        $ Just
+                                                        $ view du_date doc <> "T:0:0:0"
 
   let hd = HyperdataDocument { _hd_bdd = Nothing
                              , _hd_doi = Nothing
@@ -99,17 +113,19 @@ documentUpload uId nId doc logStatus = do
                              , _hd_title = Just $ view du_title doc
                              , _hd_authors = Just $ view du_authors doc
                              , _hd_institutes = Nothing
-                             , _hd_source = Just $ view du_sources doc
-                             , _hd_abstract = Just $ view du_abstract doc
-                             , _hd_publication_date = Just nowS
-                             , _hd_publication_year = Just $ fromIntegral year
-                             , _hd_publication_month = Just month
-                             , _hd_publication_day = Just day
-                             , _hd_publication_hour = Nothing
+                             , _hd_source             = Just $ view du_sources doc
+                             , _hd_abstract           = Just $ view du_abstract doc
+                             , _hd_publication_date   = fmap (T.pack . show) theFullDate
+                             , _hd_publication_year   = year
+                             , _hd_publication_month  = month
+                             , _hd_publication_day    = day
+                             , _hd_publication_hour   = Nothing
                              , _hd_publication_minute = Nothing
                              , _hd_publication_second = Nothing
                              , _hd_language_iso2 = Just $ T.pack $ show EN }
+  
+  docIds <- insertMasterDocs (Nothing :: Maybe HyperdataCorpus) (Multi EN) [hd]
+  _ <- Doc.add cId docIds
+  pure docIds
 
-  _ <- flowDataText (RootId (NodeId uId)) (DataNew [[hd]]) (Multi EN) cId Nothing
 
-  pure $ jobLogSuccess jl