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 api :: (FlowCmdM env err m) => Query -> m CorpusId
  74 api (Query q _ as) = do
  75   cId <- case head as of
  76     Nothing      -> flowCorpusSearchInDatabase "user1" EN q
  77     Just API.All -> flowCorpusSearchInDatabase "user1" EN q
  78     Just a   -> do
  79       docs <- liftIO $ API.get a q Nothing
  80       cId' <- flowCorpus "user1" (Left q) (Multi EN) [docs]
  81       pure cId'
  82
  83   pure cId
  84
  85 ------------------------------------------------
  86 data ApiInfo = ApiInfo { api_info :: [API.ExternalAPIs]}
  87   deriving (Generic)
  88 instance Arbitrary ApiInfo where
  89   arbitrary = ApiInfo <$> arbitrary
  90
  91 deriveJSON (unPrefix "") 'ApiInfo
  92
  93 instance ToSchema ApiInfo
  94
  95 info :: FlowCmdM env err m => UserId -> m ApiInfo
  96 info _u = pure $ ApiInfo API.externalAPIs
  97
  98
  99