Add addLanguageToCorpus function

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

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

src/Gargantext/API/Node/Corpus/Update.hs

+{-# 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'

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

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
     }
 
 ------------------------------------------------------------------------