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)
  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] TableResult
  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 data TableResult = TableResult { tr_count :: Int
  74                                , tr_docs  :: [FacetDoc]
  75                                } deriving (Generic)
  76
  77 $(deriveJSON (unPrefix "tr_") ''TableResult)
  78
  79 instance ToSchema TableResult where
  80   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tr_")
  81
  82 instance Arbitrary TableResult where
  83   arbitrary = TableResult <$> arbitrary <*> arbitrary
  84
  85 $(deriveJSON (unPrefix "tq_") ''TableQuery)
  86
  87 instance ToSchema TableQuery where
  88   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tq_")
  89
  90 instance Arbitrary TableQuery where
  91   arbitrary = elements [TableQuery 0 10 DateAsc Docs "electrodes"]
  92
  93
  94 tableApi :: NodeId -> TableQuery -> Cmd err TableResult
  95 tableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order)
  96 tableApi cId (TableQuery o l order ft q) = case ft of
  97       Docs  -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order)
  98       Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
  99       x     -> panic $ "not implemented in tableApi " <> (cs $ show x)
 100
 101 searchInCorpus' :: CorpusId
 102                 -> Bool
 103                 -> [Text]
 104                 -> Maybe Offset
 105                 -> Maybe Limit
 106                 -> Maybe OrderBy
 107                 -> Cmd err TableResult
 108 searchInCorpus' cId t q o l order = do
 109   docs <- searchInCorpus cId t q o l order
 110   allDocs  <- searchInCorpus cId t q Nothing Nothing Nothing
 111   pure (TableResult (length allDocs) docs)
 112
 113
 114 getTable :: NodeId -> Maybe TabType
 115          -> Maybe Offset  -> Maybe Limit
 116          -> Maybe OrderBy -> Cmd err TableResult
 117 getTable cId ft o l order = do
 118   docs <- getTable' cId ft o l order
 119   allDocs  <- getTable' cId ft Nothing Nothing Nothing
 120   pure (TableResult (length allDocs) docs)
 121
 122 getTable' :: NodeId -> Maybe TabType
 123          -> Maybe Offset  -> Maybe Limit
 124          -> Maybe OrderBy -> Cmd err [FacetDoc]
 125 getTable' cId ft o l order =
 126   case ft of
 127     (Just Docs)      -> runViewDocuments cId False o l order
 128     (Just Trash)     -> runViewDocuments cId True  o l order
 129     (Just MoreFav)   -> moreLike cId o l order IsFav
 130     (Just MoreTrash) -> moreLike cId o l order IsTrash
 131     x     -> panic $ "not implemented in getTable: " <> (cs $ show x)
 132
 133 {-
 134 getPairing :: ContactId -> Maybe TabType
 135          -> Maybe Offset  -> Maybe Limit
 136          -> Maybe OrderBy -> Cmd err [FacetDoc]
 137 getPairing cId ft o l order =
 138   case ft of
 139     (Just Docs)  -> runViewAuthorsDoc cId False o l order
 140     (Just Trash) -> runViewAuthorsDoc cId True  o l order
 141     _     -> panic $ "not implemented: get Pairing" <> (cs $ show ft)
 142
 143 -}