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 Gargantext.API.Ngrams (TabType(..))
  40 import Gargantext.Core.Types (Offset, Limit, TableResult(..))
  41 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
  42 import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, OrderBy(..), runViewAuthorsDoc)
  43 import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike)
  44 import Gargantext.Database.Action.Search
  45 import Gargantext.Database.Admin.Types.Node
  46 import Gargantext.Database.Prelude -- (Cmd, CmdM)
  47 import Gargantext.Prelude
  48 import Servant
  49 import Test.QuickCheck (elements)
  50 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  51
  52 ------------------------------------------------------------------------
  53
  54 type TableApi = Summary " Table API"
  55               :> ReqBody '[JSON] TableQuery
  56               :> Post    '[JSON] FacetTableResult
  57
  58 data TableQuery = TableQuery
  59   { tq_offset  :: Int
  60   , tq_limit   :: Int
  61   , tq_orderBy :: OrderBy
  62   , tq_view    :: TabType
  63   , tq_query  :: Text
  64   } deriving (Generic)
  65
  66 type FacetTableResult = TableResult FacetDoc
  67
  68 $(deriveJSON (unPrefix "tq_") ''TableQuery)
  69
  70 instance ToSchema TableQuery where
  71   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tq_")
  72
  73 instance Arbitrary TableQuery where
  74   arbitrary = elements [TableQuery 0 10 DateAsc Docs "electrodes"]
  75
  76
  77 tableApi :: NodeId -> TableQuery -> Cmd err FacetTableResult
  78 tableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order)
  79 tableApi cId (TableQuery o l order ft q) = case ft of
  80       Docs  -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order)
  81       Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
  82       x     -> panic $ "not implemented in tableApi " <> (cs $ show x)
  83
  84 searchInCorpus' :: CorpusId
  85                 -> Bool
  86                 -> [Text]
  87                 -> Maybe Offset
  88                 -> Maybe Limit
  89                 -> Maybe OrderBy
  90                 -> Cmd err FacetTableResult
  91 searchInCorpus' cId t q o l order = do
  92   docs <- searchInCorpus cId t q o l order
  93   countAllDocs  <- searchCountInCorpus cId t q
  94   pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
  95
  96
  97 getTable :: NodeId -> Maybe TabType
  98          -> Maybe Offset  -> Maybe Limit
  99          -> Maybe OrderBy -> Cmd err FacetTableResult
 100 getTable cId ft o l order = do
 101   docs <- getTable' cId ft o l order
 102   -- TODO: Rewrite to use runCountOpaQuery and avoid (length allDocs)
 103   allDocs  <- getTable' cId ft Nothing Nothing Nothing
 104   pure $ TableResult { tr_docs = docs, tr_count = length allDocs }
 105
 106 getTable' :: NodeId -> Maybe TabType
 107          -> Maybe Offset  -> Maybe Limit
 108          -> Maybe OrderBy -> Cmd err [FacetDoc]
 109 getTable' cId ft o l order =
 110   case ft of
 111     (Just Docs)      -> runViewDocuments cId False o l order
 112     (Just Trash)     -> runViewDocuments cId True  o l order
 113     (Just MoreFav)   -> moreLike cId o l order IsFav
 114     (Just MoreTrash) -> moreLike cId o l order IsTrash
 115     x     -> panic $ "not implemented in getTable: " <> (cs $ show x)
 116
 117
 118 getPair :: ContactId -> Maybe TabType
 119          -> Maybe Offset  -> Maybe Limit
 120          -> Maybe OrderBy -> Cmd err [FacetDoc]
 121 getPair cId ft o l order =
 122   case ft of
 123     (Just Docs)  -> runViewAuthorsDoc cId False o l order
 124     (Just Trash) -> runViewAuthorsDoc cId True  o l order
 125     _     -> panic $ "not implemented: get Pairing" <> (cs $ show ft)
 126