]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/Export.hs
Merge branch 'dev-phylo' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantex...
[gargantext.git] / src / Gargantext / API / Export.hs
1 {-|
2 Module : Gargantext.API.Export
3 Description : Get Metrics from Storage (Database like)
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10 Main exports of Gargantext:
11 - corpus
12 - document and ngrams
13 - lists
14
15 -}
16
17
18 {-# LANGUAGE DataKinds #-}
19 {-# LANGUAGE DeriveGeneric #-}
20 {-# LANGUAGE FlexibleContexts #-}
21 {-# LANGUAGE NoImplicitPrelude #-}
22 {-# LANGUAGE OverloadedStrings #-}
23 {-# LANGUAGE RankNTypes #-}
24 {-# LANGUAGE TemplateHaskell #-}
25 {-# LANGUAGE TypeOperators #-}
26
27 module Gargantext.API.Export
28 where
29
30 import Data.Aeson.TH (deriveJSON)
31 import Data.Map (Map)
32 import Data.Set (Set)
33 import Data.Maybe (fromMaybe)
34 import Data.Swagger
35 import Data.Text (Text)
36 import GHC.Generics (Generic)
37 import Gargantext.API.Ngrams
38 import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo)
39 import Gargantext.API.Types (GargNoServer)
40 import Gargantext.Core.Types --
41 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
42 import Gargantext.Database.Config (userMaster)
43 import Gargantext.Database.Metrics.NgramsByNode (getNgramsByNodeOnlyUser)
44 import Gargantext.Database.Node.Select (selectNodesWithUsername)
45 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
46 import Gargantext.Database.Schema.Node (defaultList, HasNodeError)
47 import Gargantext.Database.Schema.NodeNode (selectDocNodes)
48 import Gargantext.Database.Types.Node (Node, HyperdataDocument(..), NodeId, ListId, CorpusId)
49 import Gargantext.Database.Utils (Cmd)
50 import Gargantext.Prelude
51 import Gargantext.Prelude.Utils (sha)
52 import Servant
53 import qualified Data.Map as Map
54 import qualified Data.Set as Set
55 import qualified Data.List as List
56
57
58 -- Corpus Export
59 data Corpus =
60 Corpus { _c_corpus :: [Document]
61 , _c_hash :: Hash
62 } deriving (Generic)
63
64 -- | Document Export
65 data Document =
66 Document { _d_document :: Node HyperdataDocument
67 , _d_ngrams :: Ngrams
68 , _d_hash :: Hash
69 } deriving (Generic)
70
71 data Ngrams =
72 Ngrams { _ng_ngrams :: [Text]
73 , _ng_hash :: Hash
74 } deriving (Generic)
75
76 type Hash = Text
77 -------
78 instance ToSchema Corpus where
79 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_c_")
80
81 instance ToSchema Document where
82 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_d_")
83
84 instance ToSchema Ngrams where
85 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ng_")
86
87 -------
88 instance ToParamSchema Corpus where
89 toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
90
91 instance ToParamSchema Document where
92 toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
93
94 instance ToParamSchema Ngrams where
95 toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
96 --------------------------------------------------
97 type API = Summary "Corpus Export"
98 :> "export"
99 :> QueryParam "listId" ListId
100 :> QueryParam "ngramsType" NgramsType
101 :> Get '[JSON] Corpus
102
103 --------------------------------------------------
104 getCorpus :: CorpusId
105 -> Maybe ListId
106 -> Maybe NgramsType
107 -> GargNoServer Corpus
108 getCorpus cId lId nt' = do
109
110 let
111 nt = case nt' of
112 Nothing -> NgramsTerms
113 Just t -> t
114
115 ns <- Map.fromList
116 <$> map (\n -> (_node_id n, n))
117 <$> selectDocNodes cId
118 repo <- getRepo
119 ngs <- getNodeNgrams cId lId nt repo
120 let -- uniqId is hash computed already for each document imported in database
121 r = Map.intersectionWith (\a b -> Document a (Ngrams (Set.toList b) (ng_hash b)) (d_hash a b)
122 ) ns ngs
123 where
124 ng_hash b = sha $ List.foldl (\x y -> x<>y) "" $ List.sort $ Set.toList b
125 d_hash a b = sha $ (fromMaybe "" (_hyperdataDocument_uniqId $ _node_hyperdata a))
126 <> (ng_hash b)
127
128 pure $ Corpus (Map.elems r) (sha $ List.foldl (\a b -> a<>b) ""
129 $ List.map _d_hash $ Map.elems r
130 )
131
132 getNodeNgrams :: HasNodeError err
133 => CorpusId
134 -> Maybe ListId
135 -> NgramsType
136 -> NgramsRepo
137 -> Cmd err (Map NodeId (Set Text))
138 getNodeNgrams cId lId' nt repo = do
139 lId <- case lId' of
140 Nothing -> defaultList cId
141 Just l -> pure l
142
143 lIds <- selectNodesWithUsername NodeList userMaster
144 let ngs = filterListWithRoot GraphTerm $ mapTermListRoot [lId] nt repo
145 r <- getNgramsByNodeOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
146 pure r
147
148
149 $(deriveJSON (unPrefix "_c_") ''Corpus)
150 $(deriveJSON (unPrefix "_d_") ''Document)
151 $(deriveJSON (unPrefix "_ng_") ''Ngrams)
152
153
154 -- TODO
155 -- Exports List
156 -- Version number of the list
157
158