src/Gargantext/API/Corpus/New.hs

   1 {-|
   2 Module      : Gargantext.API.Corpus.New
   3 Description : New corpus 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 New corpus means either:
  11 - new corpus
  12 - new data in existing corpus
  13 -}
  14
  15 {-# LANGUAGE NoImplicitPrelude  #-}
  16 {-# LANGUAGE TemplateHaskell    #-}
  17 {-# LANGUAGE DeriveGeneric      #-}
  18 {-# LANGUAGE DataKinds          #-}
  19 {-# LANGUAGE TypeOperators      #-}
  20 {-# LANGUAGE OverloadedStrings  #-}
  21 {-# LANGUAGE FlexibleContexts     #-}
  22 {-# LANGUAGE RankNTypes          #-}
  23
  24 module Gargantext.API.Corpus.New
  25       where
  26
  27 import Control.Monad.IO.Class (liftIO)
  28 import Data.Aeson.TH (deriveJSON)
  29 import Data.Swagger
  30 import Data.Text (Text)
  31 import GHC.Generics (Generic)
  32 import Gargantext.Core.Utils.Prefix (unPrefix)
  33 import Gargantext.Database.Flow (flowCorpusSearchInDatabase)
  34 import Gargantext.Database.Types.Node (CorpusId)
  35 import Gargantext.Text.Terms (TermType(..))
  36 import Gargantext.Prelude
  37 import Servant
  38 import Test.QuickCheck (elements)
  39 import Test.QuickCheck.Arbitrary
  40 import Gargantext.Core (Lang(..))
  41 import Gargantext.Database.Flow (FlowCmdM, flowCorpus)
  42 import qualified Gargantext.Text.Corpus.API as API
  43 import Gargantext.Database.Types.Node (UserId)
  44
  45 data Query = Query { query_query      :: Text
  46                    , query_corpus_id  :: Int
  47                    , query_databases  :: [API.ExternalAPIs]
  48                    }
  49                    deriving (Eq, Show, Generic)
  50
  51 deriveJSON (unPrefix "query_") 'Query
  52
  53
  54 instance Arbitrary Query where
  55     arbitrary = elements [ Query q n fs
  56                          | q <- ["a","b"]
  57                          , n <- [0..10]
  58                          , fs <- take 3 $ repeat API.externalAPIs
  59                          ]
  60
  61 instance ToSchema Query where
  62   declareNamedSchema =
  63     genericDeclareNamedSchema
  64       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 6 fieldLabel}
  65
  66 type Api = Summary "New Corpus endpoint"
  67          :> ReqBody '[JSON] Query
  68          :> Post '[JSON] CorpusId
  69         :<|> Get '[JSON] ApiInfo
  70
  71 -- | TODO manage several apis
  72 api :: (FlowCmdM env err m) => Query -> m CorpusId
  73 api (Query q _ as) = do
  74   cId <- case head as of
  75     Nothing      -> flowCorpusSearchInDatabase "user1" EN q
  76     Just API.All -> flowCorpusSearchInDatabase "user1" EN q
  77     Just a   -> do
  78       docs <- liftIO $ API.get a q Nothing
  79       cId' <- flowCorpus "user1" q (Multi EN) [docs]
  80       pure cId'
  81
  82   pure cId
  83
  84 ------------------------------------------------
  85 data ApiInfo = ApiInfo { api_info :: [API.ExternalAPIs]}
  86   deriving (Generic)
  87 instance Arbitrary ApiInfo where
  88   arbitrary = ApiInfo <$> arbitrary
  89
  90 deriveJSON (unPrefix "") 'ApiInfo
  91
  92 instance ToSchema ApiInfo
  93
  94 info :: FlowCmdM env err m => UserId -> m ApiInfo
  95 info _u = pure $ ApiInfo API.externalAPIs
  96
  97
  98