{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.API.Node.Corpus.New
where
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)
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"
=> 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
-- 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
, _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
(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
_ -> 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