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