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)
  49 import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..),runViewAuthorsDoc)
  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 type TableApi = Summary " Table API"
  61               :> ReqBody '[JSON] TableQuery
  62               :> Post '[JSON] [FacetDoc]
  63
  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 $(deriveJSON (unPrefix "tq_") ''TableQuery)
  74
  75 instance ToSchema TableQuery where
  76   declareNamedSchema =
  77     genericDeclareNamedSchema
  78       defaultSchemaOptions {fieldLabelModifier = drop 3}
  79
  80 instance Arbitrary TableQuery where
  81   arbitrary = elements [TableQuery 0 10 DateAsc Docs "electrodes"]
  82
  83
  84 tableApi :: NodeId -> TableQuery -> Cmd err [FacetDoc]
  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 getTable :: NodeId -> Maybe TabType
  92          -> Maybe Offset  -> Maybe Limit
  93          -> Maybe OrderBy -> Cmd err [FacetDoc]
  94 getTable cId ft o l order =
  95   case ft of
  96     (Just Docs)  -> runViewDocuments cId False o l order
  97     (Just Trash) -> runViewDocuments cId True  o l order
  98     (Just MoreFav)   -> moreLike cId o l order IsFav
  99     (Just MoreTrash) -> moreLike cId o l order IsTrash
 100     x     -> panic $ "not implemented in getTable: " <> (cs $ show x)
 101
 102 getPairing :: ContactId -> Maybe TabType
 103          -> Maybe Offset  -> Maybe Limit
 104          -> Maybe OrderBy -> Cmd err [FacetDoc]
 105 getPairing cId ft o l order =
 106   case ft of
 107     (Just Docs)  -> runViewAuthorsDoc cId False o l order
 108     (Just Trash) -> runViewAuthorsDoc cId True  o l order
 109     _     -> panic $ "not implemented: get Pairing" <> (cs $ show ft)
 110
 111