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 (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, 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               :> Get    '[JSON] (HashedResponse FacetTableResult)
  60             :<|> Summary "Table API (POST)"
  61               :> ReqBody '[JSON] TableQuery
  62               :> Post    '[JSON] FacetTableResult
  63             :<|> "hash" :>
  64                    Summary "Hash Table"
  65                 :> QueryParam "tabType" TabType
  66                 :> Get '[JSON] Text
  67
  68 data TableQuery = TableQuery
  69   { tq_offset  :: Int
  70   , tq_limit   :: Int
  71   , tq_orderBy :: OrderBy
  72   , tq_view    :: TabType
  73   , tq_query  :: Text
  74   } deriving (Generic)
  75
  76 type FacetTableResult = TableResult FacetDoc
  77
  78 $(deriveJSON (unPrefix "tq_") ''TableQuery)
  79
  80 instance ToSchema TableQuery where
  81   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tq_")
  82
  83 instance Arbitrary TableQuery where
  84   arbitrary = elements [TableQuery 0 10 DateAsc Docs "electrodes"]
  85
  86
  87 tableApi :: NodeId -> GargServer TableApi
  88 tableApi id' = getTableApi id'
  89           :<|> postTableApi id'
  90           :<|> getTableHashApi id'
  91
  92
  93 getTableApi :: NodeId -> Maybe TabType -> Cmd err (HashedResponse FacetTableResult)
  94 getTableApi cId tabType = do
  95   t <- getTable cId tabType Nothing Nothing Nothing
  96   pure $ constructHashedResponse t
  97
  98
  99 postTableApi :: NodeId -> TableQuery -> Cmd err FacetTableResult
 100 postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order)
 101 postTableApi cId (TableQuery o l order ft q) = case ft of
 102       Docs  -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order)
 103       Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
 104       x     -> panic $ "not implemented in tableApi " <> (cs $ show x)
 105
 106 getTableHashApi :: NodeId -> Maybe TabType -> Cmd err Text
 107 getTableHashApi cId tabType = do
 108   HashedResponse { hash = h } <- getTableApi cId tabType
 109   pure h
 110
 111 searchInCorpus' :: CorpusId
 112                 -> Bool
 113                 -> [Text]
 114                 -> Maybe Offset
 115                 -> Maybe Limit
 116                 -> Maybe OrderBy
 117                 -> Cmd err FacetTableResult
 118 searchInCorpus' cId t q o l order = do
 119   docs <- searchInCorpus cId t q o l order
 120   countAllDocs  <- searchCountInCorpus cId t q
 121   pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
 122
 123
 124 getTable :: NodeId -> Maybe TabType
 125          -> Maybe Offset  -> Maybe Limit
 126          -> Maybe OrderBy -> Cmd err FacetTableResult
 127 getTable cId ft o l order = do
 128   docs <- getTable' cId ft o l order
 129   -- TODO: Rewrite to use runCountOpaQuery and avoid (length allDocs)
 130   allDocs  <- getTable' cId ft Nothing Nothing Nothing
 131   pure $ TableResult { tr_docs = docs, tr_count = length allDocs }
 132
 133 getTable' :: NodeId -> Maybe TabType
 134          -> Maybe Offset  -> Maybe Limit
 135          -> Maybe OrderBy -> Cmd err [FacetDoc]
 136 getTable' cId ft o l order =
 137   case ft of
 138     (Just Docs)      -> runViewDocuments cId False o l order
 139     (Just Trash)     -> runViewDocuments cId True  o l order
 140     (Just MoreFav)   -> moreLike cId o l order IsFav
 141     (Just MoreTrash) -> moreLike cId o l order IsTrash
 142     x     -> panic $ "not implemented in getTable: " <> (cs $ show x)
 143
 144
 145 getPair :: ContactId -> Maybe TabType
 146          -> Maybe Offset  -> Maybe Limit
 147          -> Maybe OrderBy -> Cmd err [FacetDoc]
 148 getPair cId ft o l order =
 149   case ft of
 150     (Just Docs)  -> runViewAuthorsDoc cId False o l order
 151     (Just Trash) -> runViewAuthorsDoc cId True  o l order
 152     _     -> panic $ "not implemented: get Pairing" <> (cs $ show ft)
 153