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(..))
  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 getPairing :: ContactId -> Maybe TabType
 126          -> Maybe Offset  -> Maybe Limit
 127          -> Maybe OrderBy -> Cmd err [FacetDoc]
 128 getPairing 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
 134 -}