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.Aeson.TH (deriveJSON)
  28 import Data.Swagger
  29 import Data.Text (Text)
  30 import GHC.Generics (Generic)
  31 import Gargantext.Core (Lang(..))
  32 import Gargantext.Core.Utils.Prefix (unPrefix)
  33 import Gargantext.Database.Flow (flowCorpusSearchInDatabase)
  34 import Gargantext.Database.Types.Node (CorpusId)
  35 import Gargantext.Prelude
  36 import Gargantext.Prelude.Utils (hash)
  37 import Servant
  38 import Test.QuickCheck (elements)
  39 import Test.QuickCheck.Arbitrary
  40 import Gargantext.Database.Flow (FlowCmdM)
  41
  42 data Query = Query { query_query      :: Text
  43                    , query_corpus_id  :: Int
  44                    , query_files_id  :: [Text]
  45                    }
  46                    deriving (Eq, Show, Generic)
  47
  48 deriveJSON (unPrefix "query_") ''Query
  49
  50
  51 instance Arbitrary Query where
  52     arbitrary = elements [ Query q n fs
  53                          | q <- ["a","b"]
  54                          , n <- [0..10]
  55                          , fs <- map (map hash) [["a","b"], ["c","d"]]
  56                          ]
  57
  58 instance ToSchema Query where
  59   declareNamedSchema =
  60     genericDeclareNamedSchema
  61       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 6 fieldLabel}
  62
  63
  64
  65 type Api = Summary "New Corpus endpoint"
  66          :> ReqBody '[JSON] Query
  67          :> Post '[JSON] CorpusId
  68
  69
  70 api :: FlowCmdM env err m => Query -> m CorpusId
  71 api (Query q _ _) = do
  72   cId <- flowCorpusSearchInDatabase "user1" EN q
  73   pure cId