diff --git a/gargantext.cabal b/gargantext.cabal
index 55e893da46fae2e9c8bd690ecf2f4db0733fb66e..cd402b8f50531bd69c72d0265f0df901aca2d22b 100644
--- a/gargantext.cabal
+++ b/gargantext.cabal
@@ -44,6 +44,7 @@ library
Gargantext.API.Node
Gargantext.API.Node.Corpus.New
Gargantext.API.Node.Corpus.Types
+ Gargantext.API.Node.Corpus.Update
Gargantext.API.Node.File
Gargantext.API.Node.Share
Gargantext.API.Prelude
diff --git a/src/Gargantext/API/Node/Corpus/New.hs b/src/Gargantext/API/Node/Corpus/New.hs
index 74b64df74569b6de417d0286cf07a8ed6b76891a..0b2cfd255c99563902561a365d060f66d2bccad3 100644
--- a/src/Gargantext/API/Node/Corpus/New.hs
+++ b/src/Gargantext/API/Node/Corpus/New.hs
@@ -14,6 +14,7 @@ New corpus means either:
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ViewPatterns #-}
module Gargantext.API.Node.Corpus.New
where
@@ -26,7 +27,6 @@ import Data.Aeson.TH (deriveJSON)
import qualified Data.ByteString.Base64 as BSB64
import Data.Conduit.Internal (zipSources)
import Data.Either
-import Data.Maybe (fromMaybe)
import Data.Swagger
import Data.Text (Text)
import qualified Data.Text as T
@@ -43,8 +43,9 @@ import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Node.Corpus.New.Types
import Gargantext.API.Node.Corpus.Searx
import Gargantext.API.Node.Corpus.Types
+import Gargantext.API.Node.Corpus.Update (addLanguageToCorpus)
import Gargantext.API.Node.Types
-import Gargantext.Core (Lang(..))
+import Gargantext.Core (Lang(..), withDefaultLanguage)
import Gargantext.Core.Text.List.Social (FlowSocialListWith(..))
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
@@ -205,10 +206,7 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
-- printDebug "[addToCorpusWithQuery] datafield" datafield
-- printDebug "[addToCorpusWithQuery] flowListWith" flw
- -- TODO: update Node Corpus with the Lang
- -- n <- getNode cid
- -- let n.wq_lang = l
- -- saveNode n
+ addLanguageToCorpus cid l
case datafield of
Just Web -> do
@@ -265,15 +263,12 @@ addToCorpusWithForm :: (FlowCmdM env err m, MonadJobStatus m)
-> NewWithForm
-> JobHandle m
-> m ()
-addToCorpusWithForm user cid (NewWithForm ft ff d l _n sel) jobHandle = do
+addToCorpusWithForm user cid (NewWithForm ft ff d (withDefaultLanguage -> l) _n sel) jobHandle = do
-- printDebug "[addToCorpusWithForm] Parsing corpus: " cid
-- printDebug "[addToCorpusWithForm] fileType" ft
-- printDebug "[addToCorpusWithForm] fileFormat" ff
- -- TODO: update Node Corpus with the Lang
- -- n <- getNode cid
- -- let n.wq_lang = l
- -- saveNode n
+ addLanguageToCorpus cid l
limit' <- view $ hasConfig . gc_max_docs_parsers
let limit = fromIntegral limit' :: Integer
@@ -322,7 +317,7 @@ addToCorpusWithForm user cid (NewWithForm ft ff d l _n sel) jobHandle = do
_cid' <- flowCorpus user
(Right [cid])
- (Multi $ fromMaybe EN l)
+ (Multi l)
(Just sel)
--(Just $ fromIntegral $ length docs, docsC')
(mCount, transPipe liftBase docsC') -- TODO fix number of docs
@@ -378,12 +373,9 @@ addToCorpusWithFile :: (HasSettings env, FlowCmdM env err m, MonadJobStatus m)
-> NewWithFile
-> JobHandle m
-> m ()
-addToCorpusWithFile user cid nwf@(NewWithFile _d _l fName) jobHandle = do
+addToCorpusWithFile user cid nwf@(NewWithFile _d (withDefaultLanguage -> l) fName) jobHandle = do
- -- TODO: update Node Corpus with the Lang
- -- n <- getNode cid
- -- let n.wq_lang = l
- -- saveNode n
+ addLanguageToCorpus cid l
printDebug "[addToCorpusWithFile] Uploading file to corpus: " cid
markStarted 1 jobHandle
diff --git a/src/Gargantext/API/Node/Corpus/Update.hs b/src/Gargantext/API/Node/Corpus/Update.hs
new file mode 100644
index 0000000000000000000000000000000000000000..71ed1b32e8f662157d7f2ad60fbdb7875a391b07
--- /dev/null
+++ b/src/Gargantext/API/Node/Corpus/Update.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE TypeApplications #-}
+module Gargantext.API.Node.Corpus.Update
+ ( addLanguageToCorpus )
+ where
+
+import Gargantext.Core
+import Gargantext.Database.Action.Flow.Types
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Prelude
+import Gargantext.Utils.Jobs
+import Gargantext.Database.Admin.Types.Hyperdata.Corpus
+import Gargantext.Database.Query.Table.Node
+import Data.Proxy
+import Control.Lens
+import Gargantext.Database.Schema.Node (node_hyperdata)
+import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
+import Control.Monad
+
+-- | Updates the 'HyperdataCorpus' with the input 'Lang'.
+addLanguageToCorpus :: (FlowCmdM env err m, MonadJobStatus m)
+ => CorpusId
+ -> Lang
+ -> m ()
+addLanguageToCorpus cId lang = do
+ hyperNode <- getNodeWith cId (Proxy @HyperdataCorpus)
+ let hyperNode' = hyperNode & over node_hyperdata (\corpus -> corpus { _hc_lang = lang })
+ void $ updateHyperdata cId hyperNode'
diff --git a/src/Gargantext/Core.hs b/src/Gargantext/Core.hs
index 2d00efa54edb0b2fc72c6b8c9c736a1549580018..40c596162a5e1c4a3293ec51890b59bbdeb90d4d 100644
--- a/src/Gargantext/Core.hs
+++ b/src/Gargantext/Core.hs
@@ -17,6 +17,7 @@ module Gargantext.Core
import Data.Aeson
import Data.Either(Either(Left))
import Data.Hashable (Hashable)
+import Data.Maybe (fromMaybe)
import Data.Morpheus.Types (GQLType)
import Data.Swagger
import Data.Text (Text, pack)
@@ -58,6 +59,15 @@ data Lang = All
| ZH
deriving (Show, Eq, Ord, Enum, Bounded, Generic, GQLType)
+-- | Defaults to 'EN' in all those places where a language is mandatory,
+-- but an optional one has been passed.
+withDefaultLanguage :: Maybe Lang -> Lang
+withDefaultLanguage = fromMaybe defaultLanguage
+
+-- | The default 'Lang'.
+defaultLanguage :: Lang
+defaultLanguage = EN
+
instance ToJSON Lang
instance FromJSON Lang
instance ToSchema Lang where
diff --git a/src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs b/src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs
index 42fc33cc1623b8ddd5430d2d6bf428af090dc737..e37e7865fe763b1744e3d6e4996df9700f82b74b 100644
--- a/src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs
+++ b/src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs
@@ -22,16 +22,18 @@ module Gargantext.Database.Admin.Types.Hyperdata.Corpus
where
import Gargantext.Prelude
-import Gargantext.Core (Lang)
+import Gargantext.Core (Lang, defaultLanguage)
import Gargantext.Database.Admin.Types.Hyperdata.CorpusField
import Gargantext.Database.Admin.Types.Hyperdata.Prelude
import PUBMED.Types (APIKey)
------------------------------------------------------------------------
data HyperdataCorpus =
- HyperdataCorpus { _hc_fields :: ![HyperdataField CorpusField]
+ HyperdataCorpus { _hc_fields :: [HyperdataField CorpusField]
, _hc_pubmed_api_key :: Maybe APIKey
- , _hc_lang :: Maybe Lang
+ -- | The language for the corpus. It defaults to
+ -- 'defaultLanguage' if we don't know which language it is.
+ , _hc_lang :: !Lang
}
deriving (Generic)
@@ -47,7 +49,7 @@ defaultHyperdataCorpus =
(JsonField "Title" "Descr" "Bool query" "Authors")
]
, _hc_pubmed_api_key = Nothing
- , _hc_lang = Nothing
+ , _hc_lang = defaultLanguage
}
------------------------------------------------------------------------