[OPTIM + FIX] TFICF
[gargantext.git] / src / Gargantext / API / Node / Corpus / Export.hs
index dc33ef6661a0d4d2ae9f40878f3854a6ce02d4bc..85ba9b247847acf8a0daa55f51f537811732af43 100644 (file)
@@ -13,34 +13,25 @@ Main exports of Gargantext:
 - lists
 -}
 
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE TypeOperators     #-}
 
 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)
@@ -48,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 (sha)
+import Servant
+import qualified Data.List as List
+import qualified Data.Map as Map
+import qualified Data.Set as Set
 
 
 -- Corpus Export
@@ -103,6 +97,7 @@ type API = Summary "Corpus Export"
             :> Get '[JSON] Corpus
 
 --------------------------------------------------
+-- | Hashes are ordered by Set
 getCorpus :: CorpusId
           -> Maybe ListId
           -> Maybe NgramsType
@@ -120,15 +115,14 @@ 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) (ng_hash 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
-            ng_hash b   = sha $ List.foldl (\x y -> x<>y) "" $ List.sort $ Set.toList b
-            d_hash  a b = sha $ (fromMaybe "" (_hyperdataDocument_uniqId $ _node_hyperdata a))
-                             <> (ng_hash b)
-
-  pure $ Corpus (Map.elems r) (sha $ List.foldl (\a b -> a<>b) ""
-                                   $ List.map _d_hash $ Map.elems r
+            d_hash  a b = hash [ fromMaybe "" (_hd_uniqId $ _node_hyperdata a)
+                                       , hash b
+                                       ]
+  pure $ Corpus (Map.elems r) (hash $ List.map _d_hash
+                                            $ Map.elems r
                               )
 
 getNodeNgrams :: HasNodeError err
@@ -143,7 +137,7 @@ getNodeNgrams cId lId' nt repo = do
     Just  l -> pure l
 
   lIds <- selectNodesWithUsername NodeList userMaster
-  let ngs = filterListWithRoot GraphTerm $ mapTermListRoot [lId] nt repo
+  let ngs = filterListWithRoot MapTerm $ mapTermListRoot [lId] nt repo
   r <- getNgramsByNodeOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
   pure r