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, unPrefixSwagger)
  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 Gargantext.API.Orchestrator.Types
  39 import Servant
  40 -- import Servant.Job.Server
  41 import Test.QuickCheck (elements)
  42 import Test.QuickCheck.Arbitrary
  43 import Gargantext.Core (Lang(..))
  44 import Gargantext.Database.Flow (FlowCmdM, flowCorpus)
  45 import qualified Gargantext.Text.Corpus.API as API
  46 import Gargantext.Database.Types.Node (UserId)
  47
  48 data Query = Query { query_query      :: Text
  49                    , query_corpus_id  :: Int
  50                    , query_databases  :: [API.ExternalAPIs]
  51                    }
  52                    deriving (Eq, Show, Generic)
  53
  54 deriveJSON (unPrefix "query_") 'Query
  55
  56
  57 instance Arbitrary Query where
  58     arbitrary = elements [ Query q n fs
  59                          | q <- ["a","b"]
  60                          , n <- [0..10]
  61                          , fs <- take 3 $ repeat API.externalAPIs
  62                          ]
  63
  64 instance ToSchema Query where
  65   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
  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 {-
 101 -- Proposal to replace the Query type which seems to generically named.
 102 data ScraperInput = ScraperInput
 103   { _scin_query     :: !Text
 104   , _scin_corpus_id :: !Int
 105   , _scin_databases :: [API.ExternalAPIs]
 106   }
 107   deriving (Eq, Show, Generic)
 108
 109 makeLenses ''ScraperInput
 110
 111 deriveJSON (unPrefix "_scin_") 'ScraperInput
 112
 113 data ScraperEvent = ScraperEvent
 114   { _scev_message :: !(Maybe Text)
 115   , _scev_level   :: !(Maybe Text)
 116   , _scev_date    :: !(Maybe Text)
 117   }
 118   deriving Generic
 119
 120 deriveJSON (unPrefix "_scev_") 'ScraperEvent
 121
 122 data ScraperStatus = ScraperStatus
 123   { _scst_succeeded :: !(Maybe Int)
 124   , _scst_failed    :: !(Maybe Int)
 125   , _scst_remaining :: !(Maybe Int)
 126   , _scst_events    :: !(Maybe [ScraperEvent])
 127   }
 128   deriving Generic
 129
 130 deriveJSON (unPrefix "_scst_") 'ScraperStatus
 131 -}
 132
 133 type API_v2 =
 134   Summary "Add to corpus endpoint" :>
 135   "corpus" :>
 136   Capture "corpus_id" CorpusId :>
 137   "add" :>
 138   "async" :> ScraperAPI2
 139
 140   -- TODO ScraperInput2 also has a corpus id
 141 addToCorpusJobFunction :: FlowCmdM env err m => CorpusId -> ScraperInput2 -> (ScraperStatus -> m ()) -> m ScraperStatus
 142 addToCorpusJobFunction _cid _input logStatus = do
 143   -- TODO ...
 144   logStatus ScraperStatus { _scst_succeeded = Just 10
 145                           , _scst_failed    = Just 2
 146                           , _scst_remaining = Just 138
 147                           , _scst_events    = Just []
 148                           }
 149   -- TODO ...
 150   pure      ScraperStatus { _scst_succeeded = Just 137
 151                           , _scst_failed    = Just 13
 152                           , _scst_remaining = Just 0
 153                           , _scst_events    = Just []
 154                           }