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