Table.hs 6.09 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
{-|
Module      : Gargantext.API.Node
Description : Server API
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX


-- TODO-ACCESS: CanGetNode
-- TODO-EVENTS: No events as this is a read only query.
Node API

-------------------------------------------------------------------
-- TODO-ACCESS: access by admin only.
--              At first let's just have an isAdmin check.
--              Later: check userId CanDeleteNodes Nothing
-- TODO-EVENTS: DeletedNodes [NodeId]
--              {"tag": "DeletedNodes", "nodes": [Int*]}


-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeOperators        #-}

module Gargantext.API.Table
  where

import Data.Aeson.TH (deriveJSON)
import Data.Maybe
import Data.Swagger
import Data.Text (Text())
import GHC.Generics (Generic)
39 40 41 42
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)

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 49 50
import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike)
import Gargantext.Database.Action.Search
import Gargantext.Database.Admin.Types.Node
51
import Gargantext.Database.Prelude -- (Cmd, CmdM)
52
import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
53 54 55
import Gargantext.Prelude

------------------------------------------------------------------------
56

57 58
type TableApi = Summary "Table API"
              :> QueryParam "tabType" TabType
59 60 61 62 63
              :> QueryParam "list" ListId
              :> QueryParam "limit" Int
              :> QueryParam "offset" Int
              :> QueryParam "orderBy" OrderBy
              :> QueryParam "query" Text
64
              :> QueryParam "year" Text
65
              :> Get    '[JSON] (HashedResponse FacetTableResult)
66
            :<|> Summary "Table API (POST)"
67
              :> ReqBody '[JSON] TableQuery
68
              :> Post    '[JSON] FacetTableResult
69 70
            :<|> "hash" :>
                   Summary "Hash Table"
71 72
                :> QueryParam "tabType" TabType
                :> Get '[JSON] Text
73 74

data TableQuery = TableQuery
Alexandre Delanoë's avatar
Alexandre Delanoë committed
75 76 77 78
  { tq_offset  :: Int
  , tq_limit   :: Int
  , tq_orderBy :: OrderBy
  , tq_view    :: TabType
79
  , tq_query   :: Text
80 81
  } deriving (Generic)

82
type FacetTableResult = TableResult FacetDoc
83

84 85 86
$(deriveJSON (unPrefix "tq_") ''TableQuery)

instance ToSchema TableQuery where
87
  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tq_")
88 89

instance Arbitrary TableQuery where
90 91 92 93 94
  arbitrary = elements [TableQuery { tq_offset = 0
                                   , tq_limit = 10
                                   , tq_orderBy = DateAsc
                                   , tq_view = Docs
                                   , tq_query = "electrodes" }]
95 96


97 98 99
tableApi :: NodeId -> GargServer TableApi
tableApi id' = getTableApi id'
          :<|> postTableApi id'
100
          :<|> getTableHashApi id'
101 102


103 104 105 106 107 108 109
getTableApi :: NodeId
            -> Maybe TabType
            -> Maybe ListId
            -> Maybe Int
            -> Maybe Int
            -> Maybe OrderBy
            -> Maybe Text
110
            -> Maybe Text
111
            -> Cmd err (HashedResponse FacetTableResult)
112
getTableApi cId tabType _mListId mLimit mOffset mOrderBy mQuery mYear = do
113
  printDebug "[getTableApi] mQuery" mQuery
114 115
  printDebug "[getTableApi] mYear" mYear
  t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear
116
  pure $ constructHashedResponse t
117 118

postTableApi :: NodeId -> TableQuery -> Cmd err FacetTableResult
119
postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing Nothing
120
postTableApi cId (TableQuery o l order ft q) = case ft of
121 122
      Docs  -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order)
      Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
123
      x     -> panic $ "not implemented in tableApi " <> (cs $ show x)
124

125 126
getTableHashApi :: NodeId -> Maybe TabType -> Cmd err Text
getTableHashApi cId tabType = do
127
  HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing Nothing
128
  pure h
129

130 131 132 133 134 135
searchInCorpus' :: CorpusId
                -> Bool
                -> [Text]
                -> Maybe Offset
                -> Maybe Limit
                -> Maybe OrderBy
136
                -> Cmd err FacetTableResult
137
searchInCorpus' cId t q o l order = do
138
  docs          <- searchInCorpus cId t q o l order
139 140
  countAllDocs  <- searchCountInCorpus cId t q
  pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
141 142


143 144 145 146 147 148
getTable :: NodeId
         -> Maybe TabType
         -> Maybe Offset
         -> Maybe Limit
         -> Maybe OrderBy
         -> Maybe Text
149
         -> Maybe Text
150
         -> Cmd err FacetTableResult
151 152 153
getTable cId ft o l order query year = do
  docs      <- getTable' cId ft o l order query year
  docsCount <- runCountDocuments cId (ft == Just Trash) query year
154
  pure $ TableResult { tr_docs = docs, tr_count = docsCount }
155

156 157 158 159 160 161
getTable' :: NodeId
          -> Maybe TabType
          -> Maybe Offset
          -> Maybe Limit
          -> Maybe OrderBy
          -> Maybe Text
162
          -> Maybe Text
163
          -> Cmd err [FacetDoc]
164
getTable' cId ft o l order query year =
165
  case ft of
166 167
    (Just Docs)      -> runViewDocuments cId False o l order query year 
    (Just Trash)     -> runViewDocuments cId True  o l order query year
168 169
    (Just MoreFav)   -> moreLike cId o l order IsFav
    (Just MoreTrash) -> moreLike cId o l order IsTrash
Alexandre Delanoë's avatar
Alexandre Delanoë committed
170
    x     -> panic $ "not implemented in getTable: " <> (cs $ show x)
171

172 173

getPair :: ContactId -> Maybe TabType
174 175
         -> Maybe Offset  -> Maybe Limit
         -> Maybe OrderBy -> Cmd err [FacetDoc]
176
getPair cId ft o l order =
177 178 179
  case ft of
    (Just Docs)  -> runViewAuthorsDoc cId False o l order
    (Just Trash) -> runViewAuthorsDoc cId True  o l order
Alexandre Delanoë's avatar
Alexandre Delanoë committed
180
    _     -> panic $ "not implemented: get Pairing" <> (cs $ show ft)
181