Test that importing and exporting nested ngrams in JSON roundtrips

src/Gargantext/Core/Text/Ngrams.hs

@@ -40,6 +40,7 @@ import Text.Read (read)
 data NgramsType = Authors | Institutes | Sources | NgramsTerms
   deriving (Eq, Show, Read, Ord, Enum, Bounded, Generic)
 
+instance NFData NgramsType
 instance Serialise NgramsType
 instance FromJSON NgramsType
   where

test/Test/API/Routes.hs

@@ -31,6 +31,7 @@ module Test.API.Routes (
   , get_corpus_sqlite_export
   , addTeamMember
   , importCorpus
+  , get_list_json
   ) where
 
 import Data.Text.Encoding qualified as TE
@@ -39,13 +40,13 @@ import Gargantext.API.Admin.Auth.Types (AuthRequest, AuthResponse, Token)
 import Gargantext.API.Errors
 import Gargantext.API.HashedResponse (HashedResponse)
 import Gargantext.API.Ngrams.List.Types (WithJsonFile, WithTextFile)
-import Gargantext.API.Ngrams.Types ( NgramsTable, NgramsTablePatch, OrderBy, TabType, Versioned, VersionedWithCount )
+import Gargantext.API.Ngrams.Types
 import Gargantext.API.Node.Corpus.Export.Types (CorpusSQLite)
 import Gargantext.API.Node.Share.Types (ShareNodeParams(..))
 import Gargantext.API.Routes.Client
 import Gargantext.API.Routes.Named
 import Gargantext.API.Routes.Named.Corpus (CorpusExportAPI(corpusSQLiteEp))
-import Gargantext.API.Routes.Named.List (updateListJSONEp, updateListTSVEp)
+import Gargantext.API.Routes.Named.List (updateListJSONEp, updateListTSVEp, listJSONEp, getListEp)
 import Gargantext.API.Routes.Named.Node hiding (treeAPI)
 import Gargantext.API.Routes.Named.Private hiding (tableNgramsAPI)
 import Gargantext.API.Routes.Named.Publish (PublishAPI(..), PublishRequest(..))
@@ -401,3 +402,21 @@ importCorpus (toServantToken -> token) corpusId params =
                & ($ corpusId)
                & workerAPIPost
                & (\submitForm -> submitForm params)
+
+get_list_json :: Token
+              -> ListId
+              -> ClientM (Headers '[Header "Content-Disposition" Text] NgramsList)
+get_list_json (toServantToken -> token) lId =
+  clientRoutes & apiWithCustomErrorScheme
+               & ($ GES_new)
+               & backendAPI
+               & backendAPI'
+               & mkBackEndAPI
+               & gargAPIVersion
+               & gargPrivateAPI
+               & mkPrivateAPI
+               & ($ token)
+               & listGetAPI
+               & getListEp
+               & ($ lId)
+               & listJSONEp

test/Test/API/UpdateList.hs

@@ -66,9 +66,10 @@ import Network.Wai.Handler.Warp qualified as Wai
 import Paths_gargantext (getDataFileName)
 import Prelude qualified
 import Servant.Client.Streaming
+import Servant.API qualified as Servant
 import System.FilePath
 import Test.API.Prelude (checkEither, newCorpusForUser, newPrivateFolderForUser, alice)
-import Test.API.Routes (mkUrl, gqlUrl, get_table_ngrams, put_table_ngrams, toServantToken, clientRoutes, get_table, update_node, add_form_to_list, add_tsv_to_list)
+import Test.API.Routes (mkUrl, gqlUrl, get_table_ngrams, put_table_ngrams, toServantToken, clientRoutes, get_table, update_node, add_form_to_list, add_tsv_to_list, get_list_json)
 import Test.API.Setup (withTestDBAndPort, dbEnvSetup, SpecContext (..))
 import Test.Database.Types
 import Test.Hspec
@@ -77,6 +78,9 @@ import Test.Hspec.Wai.JSON (json)
 import Test.Types (JobPollHandle(..))
 import Test.Utils (pollUntilWorkFinished, protectedJSON, withValidLogin, isJobFinished)
 import Text.Printf (printf)
+import qualified Data.Text.Encoding as TE
+import qualified Data.ByteString as BIO
+import Control.Lens (view)
 
 
 uploadJSONList :: LogConfig
@@ -87,25 +91,24 @@ uploadJSONList :: LogConfig
                -> ClientEnv
                -> WaiSession () ListId
 uploadJSONList log_cfg port token cId pathToNgrams clientEnv = do
+  simpleNgrams' <- liftIO (BIO.readFile =<< getDataFileName pathToNgrams)
+  uploadJSONListBS log_cfg port token cId simpleNgrams' clientEnv
+
+uploadJSONListBS :: LogConfig
+                 -> Wai.Port
+                 -> Token
+                 -> CorpusId
+                 -> ByteString
+                 -> ClientEnv
+                 -> WaiSession () ListId
+uploadJSONListBS log_cfg port token cId blob clientEnv = do
   ([listId] :: [NodeId]) <- protectedJSON token "POST" (mkUrl port ("/node/" <> build cId)) [aesonQQ|{"pn_typename":"NodeList","pn_name":"Testing"}|]
   -- Upload the JSON doc
-  simpleNgrams' <- liftIO (TIO.readFile =<< getDataFileName pathToNgrams)
-  -- let (Just simpleNgrams) = JSON.decode $ BSL.fromStrict $ encodeUtf8 simpleNgrams'
-  -- let jsonFileFormData = [ (T.pack "_wjf_data", simpleNgrams)
-  --                        , ("_wjf_filetype", "JSON")
-  --                        , ("_wjf_name", "simple_ngrams.json")
-  --                        ]
-  let params = WithJsonFile { _wjf_data = simpleNgrams'
+  let params = WithJsonFile { _wjf_data = TE.decodeUtf8 blob
                             , _wjf_name = "simple_ngrams.json" }
-  -- let url         = "/lists/"  +|listId|+ "/add/form/async"
-  -- let mkPollUrl j = "/corpus/" +|listId|+ "/add/form/async/" +|_jph_id j|+ "/poll?limit=1"
-  -- (j :: JobPollHandle) <- postJSONUrlEncoded token (mkUrl port url) (urlEncodeFormStable $ toForm jsonFileFormData)
-  -- j' <- pollUntilFinished token port mkPollUrl j
   ji <- checkEither $ liftIO $ runClientM (add_form_to_list token listId params) clientEnv
-  -- liftIO (_jph_status j' `shouldBe` "IsFinished")
   ji' <- pollUntilWorkFinished log_cfg port ji
   liftIO $ ji' `shouldSatisfy` isJobFinished
-  
   pure listId
 
 -- | Compares the ngrams returned via the input IO action with the ones provided as
@@ -498,6 +501,113 @@ tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
                                             ) clientEnv
               length (_ne_occurrences fortran_ngram') `shouldBe` 1
 
+    describe "Importing and exporting nested terms" $ do
+      -- As per #498, we want to test that even in the present of deep
+      -- nested hierarchy of ngrams, we can import and export them and we should
+      -- end up with the ngrams hierarchy we started from. In other terms, a
+      -- roundtrip property should be satisfied.
+      it "should roundtrip for JSON" $ \(SpecContext testEnv port app _) -> do
+        cId <- newCorpusForUser testEnv "alice"
+        cId2 <- newCorpusForUser testEnv "alice"
+        let log_cfg = (test_config testEnv) ^. gc_logging
+        withApplication app $ do
+          withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
+            -- Import the initial terms
+            let (Right initialTerms) = JSON.eitherDecode @NgramsList $ [json|
+                  {
+                    "Authors": {
+                      "version": 11,
+                      "data": {}
+                    },
+                    "Institutes": {
+                      "version": 11,
+                      "data": {}
+                    },
+                    "Sources": {
+                      "version": 11,
+                      "data": {}
+                    },
+                    "NgramsTerms": {
+                      "version": 11,
+                      "data": {
+                        "boss ds-1": {
+                          "root": "guitar effects",
+                          "parent": "distortions",
+                          "size": 1,
+                          "list": "MapTerm",
+                          "children": []
+                        },
+                        "distortions": {
+                          "root": "guitar effects",
+                          "parent": "guitar effects",
+                          "size": 1,
+                          "list": "MapTerm",
+                          "children": [
+                            "boss ds-1",
+                            "rat"
+                          ]
+                        },
+                        "guitar effects": {
+                          "size": 1,
+                          "list": "MapTerm",
+                          "children": [
+                            "distortions",
+                            "overdrives"
+                          ]
+                        },
+                        "guitar pedals": {
+                          "root": "guitar effects",
+                          "parent": "overdrives",
+                          "size": 1,
+                          "list": "MapTerm",
+                          "children": [
+                            "tube screamers"
+                          ]
+                        },
+                        "overdrives": {
+                          "root": "guitar effects",
+                          "parent": "guitar effects",
+                          "size": 1,
+                          "list": "MapTerm",
+                          "children": [
+                            "guitar pedals"
+                          ]
+                        },
+                        "rat": {
+                          "root": "guitar effects",
+                          "parent": "distortions",
+                          "size": 1,
+                          "list": "MapTerm",
+                          "children": []
+                        },
+                        "tube screamers": {
+                          "root": "guitar effects",
+                          "parent": "guitar pedals",
+                          "size": 1,
+                          "list": "MapTerm",
+                          "children": []
+                        }
+                      }
+                    }
+                  }
+                |]
+            listId <- uploadJSONListBS log_cfg port token cId (BL.toStrict $ JSON.encode initialTerms) clientEnv
+            -- Export them.
+            exported <- Servant.getResponse <$> (checkEither $ liftIO $ runClientM (get_list_json token listId) clientEnv)
+
+            let initialNgrams  = view v_data <$> Map.lookup NgramsTerms initialTerms
+            let exportedNgrams = view v_data <$> Map.lookup NgramsTerms exported
+            liftIO $ exportedNgrams `shouldBe` initialNgrams
+
+            -- now we import them again, but this time on a different corpus, so that we don't
+            -- get conflicts and the occurrences count won't get messed up. Dealing with conflicts
+            -- is a separate type of test.
+            listId2 <- uploadJSONListBS log_cfg port token cId2 (BL.toStrict $ JSON.encode exported) clientEnv
+            -- Export them again.
+            exported2 <- Servant.getResponse <$> (checkEither $ liftIO $ runClientM (get_list_json token listId2) clientEnv)
+            let exportedNgrams2 = view v_data <$> Map.lookup NgramsTerms exported2
+            liftIO $ exportedNgrams `shouldBe` exportedNgrams2
+
 createDocsList :: FilePath
                -> TestEnv
                -> Int