[OPTIM + FIX] TFICF
[gargantext.git] / src / Gargantext / API / Node / Corpus / Export.hs
index dbcdcf81ecbd7fc590c6f191284d38d78d9123ee..85ba9b247847acf8a0daa55f51f537811732af43 100644 (file)
@@ -19,22 +19,19 @@ Main exports of Gargantext:
 module Gargantext.API.Node.Corpus.Export
   where
 
+
 import Data.Aeson.TH (deriveJSON)
-import qualified Data.List as List
-import qualified Data.Map as Map
 import Data.Map (Map)
 import Data.Maybe (fromMaybe)
 import Data.Set (Set)
-import qualified Data.Set as Set
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
-import Servant
-
 import Gargantext.API.Ngrams
 import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo)
 import Gargantext.API.Prelude (GargNoServer)
-import Gargantext.Core.Types --
+import Gargantext.Prelude.Crypto.Hash (hash)
+import Gargantext.Core.Types
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Action.Metrics.NgramsByNode (getNgramsByNodeOnlyUser)
 import Gargantext.Database.Admin.Config (userMaster)
@@ -42,13 +39,16 @@ import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
 import Gargantext.Database.Admin.Types.Node (Node, NodeId, ListId, CorpusId)
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Query.Table.Node
-import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
 import Gargantext.Database.Query.Table.NodeNode (selectDocNodes)
-import Gargantext.Database.Schema.Node (_node_id, _node_hyperdata)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
+import Gargantext.Database.Schema.Node (_node_id, _node_hyperdata)
 import Gargantext.Prelude
-import Gargantext.Prelude.Utils (hashFromSet, hashFromList)
+import Servant
+import qualified Data.List as List
+import qualified Data.Map as Map
+import qualified Data.Set as Set
 
 
 -- Corpus Export
@@ -115,13 +115,13 @@ getCorpus cId lId nt' = do
   repo <- getRepo
   ngs  <- getNodeNgrams cId lId nt repo
   let  -- uniqId is hash computed already for each document imported in database
-    r = Map.intersectionWith (\a b -> Document a (Ngrams (Set.toList b) (hashFromSet b)) (d_hash a b)
+    r = Map.intersectionWith (\a b -> Document a (Ngrams (Set.toList b) (hash b)) (d_hash a b)
                              ) ns ngs
           where
-            d_hash  a b = hashFromList [ fromMaybe "" (_hd_uniqId $ _node_hyperdata a)
-                                       , hashFromSet b
+            d_hash  a b = hash [ fromMaybe "" (_hd_uniqId $ _node_hyperdata a)
+                                       , hash b
                                        ]
-  pure $ Corpus (Map.elems r) (hashFromList $ List.map _d_hash
+  pure $ Corpus (Map.elems r) (hash $ List.map _d_hash
                                             $ Map.elems r
                               )