Add test for adding language to Corpus

gargantext.cabal

@@ -58,6 +58,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
@@ -175,7 +176,6 @@ library
       Gargantext.API.Node.Corpus.New.File
       Gargantext.API.Node.Corpus.New.Types
       Gargantext.API.Node.Corpus.Searx
-      Gargantext.API.Node.Corpus.Update
       Gargantext.API.Node.Document.Export
       Gargantext.API.Node.Document.Export.Types
       Gargantext.API.Node.DocumentsFromWriteNodes

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

@@ -7,17 +7,18 @@ import Control.Lens
 import Control.Monad
 import Data.Proxy
 import Gargantext.Core
-import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus
 import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node
+import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
 import Gargantext.Utils.Jobs
 
 -- | Updates the 'HyperdataCorpus' with the input 'Lang'.
-addLanguageToCorpus :: (FlowCmdM env err m, MonadJobStatus m)
+addLanguageToCorpus :: (HasNodeError err, DbCmd' env err m, MonadJobStatus m)
                     => CorpusId
                     -> Lang
                     -> m ()

src/Gargantext/Database/Query/Table/Node.hs

@@ -260,7 +260,7 @@ getNode nId = do
     Just  r -> pure r
 
 getNodeWith :: (HasNodeError err, JSONB a)
-            => NodeId -> proxy a -> Cmd err (Node a)
+            => NodeId -> proxy a -> DBCmd err (Node a)
 getNodeWith nId _ = do
   maybeNode <- headMay <$> runOpaQuery (selectNode (pgNodeId nId))
   case maybeNode of

test/Database/Operations.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE TypeApplications     #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans      #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Database.Operations (
    tests
@@ -44,6 +45,13 @@ import Test.Hspec
 import Test.QuickCheck.Monadic
 import Test.Tasty.HUnit hiding (assert)
 import Test.Tasty.QuickCheck
+import Gargantext.API.Node.Corpus.Update
+import Gargantext.Core
+import Gargantext.Utils.Jobs
+import qualified Gargantext.API.Admin.EnvTypes as EnvTypes
+import Gargantext.API.Admin.EnvTypes
+import Gargantext.API.Prelude
+import Gargantext.API.Admin.Orchestrator.Types
 
 -- | Keeps a log of usernames we have already generated, so that our
 -- roundtrip tests won't fail.
@@ -89,6 +97,21 @@ newtype TestMonad a = TestMonad { runTestMonad :: ReaderT TestEnv IO a }
            , MonadIO
            )
 
+instance MonadJobStatus TestMonad where
+  type JobHandle      TestMonad = EnvTypes.ConcreteJobHandle GargError
+  type JobType        TestMonad = GargJob
+  type JobOutputType  TestMonad = JobLog
+  type JobEventType   TestMonad = JobLog
+
+  getLatestJobStatus _  = TestMonad (pure noJobLog)
+  withTracer _ jh n     = n jh
+  markStarted _ _       = TestMonad $ pure ()
+  markProgress _ _      = TestMonad $ pure ()
+  markFailure _ _ _     = TestMonad $ pure ()
+  markComplete _        = TestMonad $ pure ()
+  markFailed _ _        = TestMonad $ pure ()
+  addMoreSteps _ _      = TestMonad $ pure ()
+
 data DBHandle = DBHandle {
     _DBHandle :: Pool PG.Connection
   , _DBTmp    :: Tmp.DB
@@ -158,6 +181,7 @@ tests = sequential $ aroundAll withTestDB $ describe "Database" $ do
       it "Read/Write roundtrip" prop_userCreationRoundtrip
     describe "Corpus creation" $ do
       it "Simple write/read" corpusReadWrite01
+      it "Can add language to Corpus" corpusAddLanguage
 
 data ExpectedActual a =
     Expected a
@@ -224,5 +248,15 @@ corpusReadWrite01 env = do
     [corpusId] <- mk (Just "Test_Corpus") (Nothing :: Maybe HyperdataCorpus) parentId uid
     liftIO $ corpusId `shouldBe` NodeId 409
     -- Retrieve the corpus by Id
-    [corpusId'] <- getCorporaWithParentId parentId
-    liftIO $ corpusId `shouldBe` (_node_id corpusId')
+    [corpus] <- getCorporaWithParentId parentId
+    liftIO $ corpusId `shouldBe` (_node_id corpus)
+
+corpusAddLanguage :: TestEnv -> Assertion
+corpusAddLanguage env = do
+  flip runReaderT env $ runTestMonad $ do
+    parentId <- getRootId (UserName "alfredo")
+    [corpus] <- getCorporaWithParentId parentId
+    liftIO $ (_hc_lang . _node_hyperdata $ corpus) `shouldBe` Just EN -- defaults to English
+    addLanguageToCorpus (_node_id corpus) IT
+    [corpus'] <- getCorporaWithParentId parentId
+    liftIO $ (_hc_lang . _node_hyperdata $ corpus') `shouldBe` Just IT