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               :> 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   docsCount <- runCountDocuments cId (if ft == Just Trash then True else False)
 130   pure $ TableResult { tr_docs = docs, tr_count = docsCount }
 131
 132 getTable' :: NodeId -> Maybe TabType
 133          -> Maybe Offset  -> Maybe Limit
 134          -> Maybe OrderBy -> Cmd err [FacetDoc]
 135 getTable' cId ft o l order =
 136   case ft of
 137     (Just Docs)      -> runViewDocuments cId False o l order
 138     (Just Trash)     -> runViewDocuments cId True  o l order
 139     (Just MoreFav)   -> moreLike cId o l order IsFav
 140     (Just MoreTrash) -> moreLike cId o l order IsTrash
 141     x     -> panic $ "not implemented in getTable: " <> (cs $ show x)
 142
 143
 144 getPair :: ContactId -> Maybe TabType
 145          -> Maybe Offset  -> Maybe Limit
 146          -> Maybe OrderBy -> Cmd err [FacetDoc]
 147 getPair cId ft o l order =
 148   case ft of
 149     (Just Docs)  -> runViewAuthorsDoc cId False o l order
 150     (Just Trash) -> runViewAuthorsDoc cId True  o l order
 151     _     -> panic $ "not implemented: get Pairing" <> (cs $ show ft)
 152