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 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 = genericDeclareNamedSchema (unPrefixSwagger "tq_")
  77
  78 instance Arbitrary TableQuery where
  79   arbitrary = elements [TableQuery 0 10 DateAsc Docs "electrodes"]
  80
  81
  82 tableApi :: NodeId -> TableQuery -> Cmd err [FacetDoc]
  83 tableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order)
  84 tableApi cId (TableQuery o l order ft q) = case ft of
  85       Docs  -> searchInCorpus cId False [q] (Just o) (Just l) (Just order)
  86       Trash -> searchInCorpus cId True [q] (Just o) (Just l) (Just order)
  87       x     -> panic $ "not implemented in tableApi " <> (cs $ show x)
  88
  89 getTable :: NodeId -> Maybe TabType
  90          -> Maybe Offset  -> Maybe Limit
  91          -> Maybe OrderBy -> Cmd err [FacetDoc]
  92 getTable cId ft o l order =
  93   case ft of
  94     (Just Docs)  -> runViewDocuments cId False o l order
  95     (Just Trash) -> runViewDocuments cId True  o l order
  96     (Just MoreFav)   -> moreLike cId o l order IsFav
  97     (Just MoreTrash) -> moreLike cId o l order IsTrash
  98     x     -> panic $ "not implemented in getTable: " <> (cs $ show x)
  99
 100 {-
 101 getPairing :: ContactId -> Maybe TabType
 102          -> Maybe Offset  -> Maybe Limit
 103          -> Maybe OrderBy -> Cmd err [FacetDoc]
 104 getPairing cId ft o l order =
 105   case ft of
 106     (Just Docs)  -> runViewAuthorsDoc cId False o l order
 107     (Just Trash) -> runViewAuthorsDoc cId True  o l order
 108     _     -> panic $ "not implemented: get Pairing" <> (cs $ show ft)
 109
 110 -}