[FIX] Patch Scores: Nothing Nothing case
[gargantext.git] / src / Gargantext / API / Node / Corpus / New.hs
index 4acf81b498d1059993d1854a6cd5858036d231db..13e6fd5de28e130dbc826bbd9fe441c654cb153e 100644 (file)
@@ -14,7 +14,6 @@ New corpus means either:
 
 {-# LANGUAGE TemplateHaskell    #-}
 {-# LANGUAGE TypeOperators      #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Gargantext.API.Node.Corpus.New
       where
@@ -22,35 +21,31 @@ module Gargantext.API.Node.Corpus.New
 import Control.Lens hiding (elements, Empty)
 import Data.Aeson
 import Data.Aeson.TH (deriveJSON)
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Base64 as BSB64
 import Data.Either
 import Data.Maybe (fromMaybe)
 import Data.Swagger
 import Data.Text (Text)
 import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
 import GHC.Generics (Generic)
 import Servant
-import Servant.Job.Core
-import Servant.Job.Types
 import Servant.Job.Utils (jsonOptions)
 -- import Servant.Multipart
 -- import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
-import Web.FormUrlEncoded          (FromForm)
 
 import Gargantext.Prelude
 
-import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import qualified Gargantext.API.Admin.Orchestrator.Types as T
-import Gargantext.API.Admin.Settings (HasSettings)
+import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Node.Corpus.New.File
+import Gargantext.API.Node.Types
 import Gargantext.Core (Lang(..){-, allLangs-})
+import Gargantext.Database.Action.Mail (sendMail)
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Action.Flow (FlowCmdM, flowCorpus, getDataText, flowDataText, TermType(..), DataOrigin(..){-, allDataOrigins-})
-import Gargantext.Database.Action.Flow.Utils (getUserId)
+import Gargantext.Database.Action.User (getUserId)
 import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..), UserId)
@@ -163,49 +158,6 @@ instance FromJSON WithQuery where
 instance ToSchema WithQuery where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wq_")
 
--------------------------------------------------------
-data NewWithForm = NewWithForm
-  { _wf_filetype :: !FileType
-  , _wf_data     :: !Text
-  , _wf_lang     :: !(Maybe Lang)
-  , _wf_name     :: !Text
-  } deriving (Eq, Show, Generic)
-
-makeLenses ''NewWithForm
-instance FromForm NewWithForm
-instance FromJSON NewWithForm where
-  parseJSON = genericParseJSON $ jsonOptions "_wf_"
-instance ToSchema NewWithForm where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
-
--------------------------------------------------------
-data NewWithFile = NewWithFile
-  { _wfi_b64_data :: !Text
-  , _wfi_lang     :: !(Maybe Lang)
-  , _wfi_name     :: !Text
-  } deriving (Eq, Show, Generic)
-
-makeLenses ''NewWithFile
-instance FromForm NewWithFile
-instance FromJSON NewWithFile where
-  parseJSON = genericParseJSON $ jsonOptions "_wfi_"
-instance ToSchema NewWithFile where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wfi_")
-
-instance GPU.SaveFile NewWithFile where
-  saveFile' fp (NewWithFile b64d _ _) = do
-    let eDecoded = BSB64.decode $ TE.encodeUtf8 b64d
-    case eDecoded of
-      Left err -> panic $ T.pack $ "Error decoding: " <> err
-      Right decoded -> BS.writeFile fp decoded
-    -- BS.writeFile fp $ BSB64.decodeLenient $ TE.encodeUtf8 b64d
-
---instance GPU.ReadFile NewWithFile where
---  readFile' = TIO.readFile
-
-------------------------------------------------------------------------
-type AsyncJobs event ctI input output =
-  AsyncJobsAPI' 'Unsafe 'Safe ctI '[JSON] Maybe event input output
 ------------------------------------------------------------------------
 
 type AddWithQuery = Summary "Add with Query to corpus endpoint"
@@ -233,9 +185,10 @@ addToCorpusWithQuery :: FlowCmdM env err m
                        => User
                        -> CorpusId
                        -> WithQuery
+                       -> Maybe Integer
                        -> (JobLog -> m ())
                        -> m JobLog
-addToCorpusWithQuery u cid (WithQuery q dbs l _nid) logStatus = do
+addToCorpusWithQuery user cid (WithQuery q dbs l _nid) maybeLimit logStatus = do
   -- TODO ...
   logStatus JobLog { _scst_succeeded = Just 0
                    , _scst_failed    = Just 0
@@ -247,7 +200,7 @@ addToCorpusWithQuery u cid (WithQuery q dbs l _nid) logStatus = do
   -- TODO if cid is folder -> create Corpus
   --      if cid is corpus -> add to corpus
   --      if cid is root   -> create corpus in Private
-  txts <- mapM (\db  -> getDataText db     (Multi l) q Nothing) [database2origin dbs]
+  txts <- mapM (\db  -> getDataText db (Multi l) q maybeLimit) [database2origin dbs]
 
   logStatus JobLog { _scst_succeeded = Just 2
                    , _scst_failed    = Just 0
@@ -255,8 +208,10 @@ addToCorpusWithQuery u cid (WithQuery q dbs l _nid) logStatus = do
                    , _scst_events    = Just []
                    }
 
-  cids <- mapM (\txt -> flowDataText u txt (Multi l) cid) txts
+  cids <- mapM (\txt -> flowDataText user txt (Multi l) cid) txts
   printDebug "corpus id" cids
+  printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
+  sendMail user
   -- TODO ...
   pure      JobLog { _scst_succeeded = Just 3
                    , _scst_failed    = Just 0
@@ -316,6 +271,9 @@ addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus = do
                      (map (map toHyperdataDocument) docs)
 
   printDebug "Extraction finished   : " cid
+  printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
+  sendMail user
+
   pure      JobLog { _scst_succeeded = Just 2
                    , _scst_failed    = Just 0
                    , _scst_remaining = Just 0
@@ -387,6 +345,10 @@ addToCorpusWithFile user cid nwf@(NewWithFile _d _l fName) logStatus = do
     _     -> pure ()
 
   printDebug "[addToCorpusWithFile] File upload to corpus finished: " cid
+
+  printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
+  sendMail user
+
   pure $ JobLog { _scst_succeeded = Just 1
                 , _scst_failed    = Just 0
                 , _scst_remaining = Just 0