]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/Table.hs
Merge branch 'dev-phylo' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantex...
[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 DataKinds #-}
28 {-# LANGUAGE DeriveGeneric #-}
29 {-# LANGUAGE FlexibleContexts #-}
30 {-# LANGUAGE FlexibleInstances #-}
31 {-# LANGUAGE NoImplicitPrelude #-}
32 {-# LANGUAGE OverloadedStrings #-}
33 {-# LANGUAGE RankNTypes #-}
34 {-# LANGUAGE ScopedTypeVariables #-}
35 {-# LANGUAGE TemplateHaskell #-}
36 {-# LANGUAGE TypeOperators #-}
37
38 module Gargantext.API.Table
39 where
40
41 import Data.Aeson.TH (deriveJSON)
42 import Data.Maybe
43 import Data.Swagger
44 import Data.Text (Text())
45 import GHC.Generics (Generic)
46 import Gargantext.API.Ngrams (TabType(..))
47 import Gargantext.Core.Types (Offset, Limit, TableResult(..))
48 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
49 import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..), runViewAuthorsDoc)
50 import Gargantext.Database.Learn (FavOrTrash(..), moreLike)
51 import Gargantext.Database.TextSearch
52 import Gargantext.Database.Types.Node
53 import Gargantext.Database.Utils -- (Cmd, CmdM)
54 import Gargantext.Prelude
55 import Servant
56 import Test.QuickCheck (elements)
57 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
58
59 ------------------------------------------------------------------------
60
61 type TableApi = Summary " Table API"
62 :> ReqBody '[JSON] TableQuery
63 :> Post '[JSON] FacetTableResult
64
65 data TableQuery = TableQuery
66 { tq_offset :: Int
67 , tq_limit :: Int
68 , tq_orderBy :: OrderBy
69 , tq_view :: TabType
70 , tq_query :: Text
71 } deriving (Generic)
72
73 type FacetTableResult = TableResult FacetDoc
74
75 $(deriveJSON (unPrefix "tq_") ''TableQuery)
76
77 instance ToSchema TableQuery where
78 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tq_")
79
80 instance Arbitrary TableQuery where
81 arbitrary = elements [TableQuery 0 10 DateAsc Docs "electrodes"]
82
83
84 tableApi :: NodeId -> TableQuery -> Cmd err FacetTableResult
85 tableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order)
86 tableApi cId (TableQuery o l order ft q) = case ft of
87 Docs -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order)
88 Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
89 x -> panic $ "not implemented in tableApi " <> (cs $ show x)
90
91 searchInCorpus' :: CorpusId
92 -> Bool
93 -> [Text]
94 -> Maybe Offset
95 -> Maybe Limit
96 -> Maybe OrderBy
97 -> Cmd err FacetTableResult
98 searchInCorpus' cId t q o l order = do
99 docs <- searchInCorpus cId t q o l order
100 countAllDocs <- searchCountInCorpus cId t q
101 pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
102
103
104 getTable :: NodeId -> Maybe TabType
105 -> Maybe Offset -> Maybe Limit
106 -> Maybe OrderBy -> Cmd err FacetTableResult
107 getTable cId ft o l order = do
108 docs <- getTable' cId ft o l order
109 -- TODO: Rewrite to use runCountOpaQuery and avoid (length allDocs)
110 allDocs <- getTable' cId ft Nothing Nothing Nothing
111 pure $ TableResult { tr_docs = docs, tr_count = length allDocs }
112
113 getTable' :: NodeId -> Maybe TabType
114 -> Maybe Offset -> Maybe Limit
115 -> Maybe OrderBy -> Cmd err [FacetDoc]
116 getTable' cId ft o l order =
117 case ft of
118 (Just Docs) -> runViewDocuments cId False o l order
119 (Just Trash) -> runViewDocuments cId True o l order
120 (Just MoreFav) -> moreLike cId o l order IsFav
121 (Just MoreTrash) -> moreLike cId o l order IsTrash
122 x -> panic $ "not implemented in getTable: " <> (cs $ show x)
123
124
125 getPair :: ContactId -> Maybe TabType
126 -> Maybe Offset -> Maybe Limit
127 -> Maybe OrderBy -> Cmd err [FacetDoc]
128 getPair cId ft o l order =
129 case ft of
130 (Just Docs) -> runViewAuthorsDoc cId False o l order
131 (Just Trash) -> runViewAuthorsDoc cId True o l order
132 _ -> panic $ "not implemented: get Pairing" <> (cs $ show ft)
133