]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/Table.hs
[FEAT] Implements log distributional function with accelerate (#50).
[gargantext.git] / src / Gargantext / API / Table.hs
1 {-|
2 Module : Gargantext.API.Node
3 Description : Server API
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10
11 -- TODO-ACCESS: CanGetNode
12 -- TODO-EVENTS: No events as this is a read only query.
13 Node API
14
15 -------------------------------------------------------------------
16 -- TODO-ACCESS: access by admin only.
17 -- At first let's just have an isAdmin check.
18 -- Later: check userId CanDeleteNodes Nothing
19 -- TODO-EVENTS: DeletedNodes [NodeId]
20 -- {"tag": "DeletedNodes", "nodes": [Int*]}
21
22
23 -}
24
25 {-# OPTIONS_GHC -fno-warn-orphans #-}
26
27 {-# LANGUAGE ScopedTypeVariables #-}
28 {-# LANGUAGE TemplateHaskell #-}
29 {-# LANGUAGE TypeOperators #-}
30
31 module Gargantext.API.Table
32 where
33
34 import Data.Aeson.TH (deriveJSON)
35 import Data.Maybe
36 import Data.Swagger
37 import Data.Text (Text())
38 import GHC.Generics (Generic)
39 import Servant
40 import Test.QuickCheck (elements)
41 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
42
43 import Gargantext.API.HashedResponse
44 import Gargantext.API.Ngrams.Types (TabType(..))
45 import Gargantext.API.Prelude (GargServer)
46 import Gargantext.Core.Types (Offset, Limit, TableResult(..))
47 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
48 import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
49 import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike)
50 import Gargantext.Database.Action.Search
51 import Gargantext.Database.Admin.Types.Node
52 import Gargantext.Database.Prelude -- (Cmd, CmdM)
53 import Gargantext.Prelude
54
55 ------------------------------------------------------------------------
56
57 type TableApi = Summary "Table API"
58 :> QueryParam "tabType" TabType
59 :> QueryParam "list" ListId
60 :> QueryParam "limit" Int
61 :> QueryParam "offset" Int
62 :> QueryParam "orderBy" OrderBy
63 :> QueryParam "query" Text
64 :> Get '[JSON] (HashedResponse FacetTableResult)
65 :<|> Summary "Table API (POST)"
66 :> ReqBody '[JSON] TableQuery
67 :> Post '[JSON] FacetTableResult
68 :<|> "hash" :>
69 Summary "Hash Table"
70 :> QueryParam "tabType" TabType
71 :> Get '[JSON] Text
72
73 data TableQuery = TableQuery
74 { tq_offset :: Int
75 , tq_limit :: Int
76 , tq_orderBy :: OrderBy
77 , tq_view :: TabType
78 , tq_query :: Text
79 } deriving (Generic)
80
81 type FacetTableResult = TableResult FacetDoc
82
83 $(deriveJSON (unPrefix "tq_") ''TableQuery)
84
85 instance ToSchema TableQuery where
86 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tq_")
87
88 instance Arbitrary TableQuery where
89 arbitrary = elements [TableQuery 0 10 DateAsc Docs "electrodes"]
90
91
92 tableApi :: NodeId -> GargServer TableApi
93 tableApi id' = getTableApi id'
94 :<|> postTableApi id'
95 :<|> getTableHashApi id'
96
97
98 getTableApi :: NodeId
99 -> Maybe TabType
100 -> Maybe ListId
101 -> Maybe Int
102 -> Maybe Int
103 -> Maybe OrderBy
104 -> Maybe Text
105 -> Cmd err (HashedResponse FacetTableResult)
106 getTableApi cId tabType _mListId mLimit mOffset mOrderBy mQuery = do
107 printDebug "[getTableApi] mQuery" mQuery
108 t <- getTable cId tabType mOffset mLimit mOrderBy mQuery
109 pure $ constructHashedResponse t
110
111 postTableApi :: NodeId -> TableQuery -> Cmd err FacetTableResult
112 postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing
113 postTableApi cId (TableQuery o l order ft q) = case ft of
114 Docs -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order)
115 Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
116 x -> panic $ "not implemented in tableApi " <> (cs $ show x)
117
118 getTableHashApi :: NodeId -> Maybe TabType -> Cmd err Text
119 getTableHashApi cId tabType = do
120 HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing
121 pure h
122
123 searchInCorpus' :: CorpusId
124 -> Bool
125 -> [Text]
126 -> Maybe Offset
127 -> Maybe Limit
128 -> Maybe OrderBy
129 -> Cmd err FacetTableResult
130 searchInCorpus' cId t q o l order = do
131 docs <- searchInCorpus cId t q o l order
132 countAllDocs <- searchCountInCorpus cId t q
133 pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
134
135
136 getTable :: NodeId
137 -> Maybe TabType
138 -> Maybe Offset
139 -> Maybe Limit
140 -> Maybe OrderBy
141 -> Maybe Text
142 -> Cmd err FacetTableResult
143 getTable cId ft o l order query = do
144 docs <- getTable' cId ft o l order query
145 docsCount <- runCountDocuments cId (ft == Just Trash) query
146 pure $ TableResult { tr_docs = docs, tr_count = docsCount }
147
148 getTable' :: NodeId
149 -> Maybe TabType
150 -> Maybe Offset
151 -> Maybe Limit
152 -> Maybe OrderBy
153 -> Maybe Text
154 -> Cmd err [FacetDoc]
155 getTable' cId ft o l order query =
156 case ft of
157 (Just Docs) -> runViewDocuments cId False o l order query
158 (Just Trash) -> runViewDocuments cId True o l order query
159 (Just MoreFav) -> moreLike cId o l order IsFav
160 (Just MoreTrash) -> moreLike cId o l order IsTrash
161 x -> panic $ "not implemented in getTable: " <> (cs $ show x)
162
163
164 getPair :: ContactId -> Maybe TabType
165 -> Maybe Offset -> Maybe Limit
166 -> Maybe OrderBy -> Cmd err [FacetDoc]
167 getPair cId ft o l order =
168 case ft of
169 (Just Docs) -> runViewAuthorsDoc cId False o l order
170 (Just Trash) -> runViewAuthorsDoc cId True o l order
171 _ -> panic $ "not implemented: get Pairing" <> (cs $ show ft)
172