Merge branch 'testing' into stable

package.yaml

@@ -186,6 +186,7 @@ library:
   - servant-auth-swagger
   - servant-blaze
   - servant-client
+  - servant-flatten
   - servant-job
   - servant-mock
   - servant-multipart

src/Gargantext/API.hs

@@ -285,6 +285,7 @@ type GargPrivateAPI' =
 
            :<|> New.AddWithQuery
            :<|> New.AddWithFile
+           :<|> New.AddWithForm
        --  :<|> "scraper" :> WithCallbacks ScraperAPI
        --  :<|> "new"  :> New.Api
 
@@ -366,6 +367,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
      -- TODO access
      :<|> addWithQuery
      :<|> addWithFile
+     :<|> addWithForm
      -- :<|> addToCorpus
      -- :<|> New.api  uid -- TODO-SECURITY
      -- :<|> New.info uid -- TODO-SECURITY
@@ -380,6 +382,11 @@ addWithFile cid i f =
   serveJobsAPI $
     JobFunction (\_i log -> New.addToCorpusWithFile cid i f (liftIO . log))
 
+addWithForm :: GargServer New.AddWithForm
+addWithForm cid =
+  serveJobsAPI $
+    JobFunction (\i log -> New.addToCorpusWithForm cid i (liftIO . log))
+
 serverStatic :: Server (Get '[HTML] Html)
 serverStatic = $(do
                   let path = "purescript-gargantext/dist/index.html"

src/Gargantext/API/Corpus/New.hs

@@ -24,32 +24,37 @@ New corpus means either:
 module Gargantext.API.Corpus.New
       where
 
-import Data.Either
+--import Gargantext.Text.Corpus.Parsers (parseFile, FileFormat(..))
+import Control.Lens hiding (elements)
 import Control.Monad.IO.Class (liftIO)
-import Data.Aeson.TH (deriveJSON)
 import Data.Aeson
-import Servant.Job.Utils (jsonOptions)
-import Control.Lens hiding (elements)
-import Servant.Multipart
+import Data.Aeson.TH (deriveJSON)
+import Data.Either
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
-import Servant.Job.Types
+import Gargantext.API.Corpus.New.File
+import Gargantext.API.Orchestrator.Types
+import Gargantext.Core (Lang(..))
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Database.Flow (FlowCmdM, flowCorpus)
 import Gargantext.Database.Flow (flowCorpusSearchInDatabase)
 import Gargantext.Database.Types.Node (CorpusId)
-import Gargantext.Text.Terms (TermType(..))
+import Gargantext.Database.Types.Node (ToHyperdataDocument(..))
+import Gargantext.Database.Types.Node (UserId)
 import Gargantext.Prelude
-import Gargantext.API.Orchestrator.Types
+import Gargantext.Text.Corpus.Parsers.CSV (parseHal')
+import Gargantext.Text.Terms (TermType(..))
 import Servant
--- import Servant.Job.Server
+import Servant.API.Flatten (Flat)
+import Servant.Job.Core
+import Servant.Job.Types
+import Servant.Job.Utils (jsonOptions)
+import Servant.Multipart
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
-import Gargantext.Core (Lang(..))
-import Gargantext.Database.Flow (FlowCmdM, flowCorpus)
+import Web.FormUrlEncoded          (FromForm)
 import qualified Gargantext.Text.Corpus.API as API
-import Gargantext.Database.Types.Node (UserId)
-import Gargantext.API.Corpus.New.File
 
 data Query = Query { query_query      :: Text
                    , query_corpus_id  :: Int
@@ -103,41 +108,6 @@ instance ToSchema ApiInfo
 info :: FlowCmdM env err m => UserId -> m ApiInfo
 info _u = pure $ ApiInfo API.externalAPIs
 
-{-
--- Proposal to replace the Query type which seems to generically named.
-data ScraperInput = ScraperInput
-  { _scin_query     :: !Text
-  , _scin_corpus_id :: !Int
-  , _scin_databases :: [API.ExternalAPIs]
-  }
-  deriving (Eq, Show, Generic)
-
-makeLenses ''ScraperInput
-
-deriveJSON (unPrefix "_scin_") 'ScraperInput
-
-data ScraperEvent = ScraperEvent
-  { _scev_message :: !(Maybe Text)
-  , _scev_level   :: !(Maybe Text)
-  , _scev_date    :: !(Maybe Text)
-  }
-  deriving Generic
-
-deriveJSON (unPrefix "_scev_") 'ScraperEvent
-
-data ScraperStatus = ScraperStatus
-  { _scst_succeeded :: !(Maybe Int)
-  , _scst_failed    :: !(Maybe Int)
-  , _scst_remaining :: !(Maybe Int)
-  , _scst_events    :: !(Maybe [ScraperEvent])
-  }
-  deriving Generic
-
-deriveJSON (unPrefix "_scst_") 'ScraperStatus
--}
-
-
-
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
 data WithQuery = WithQuery
@@ -147,26 +117,37 @@ data WithQuery = WithQuery
   deriving Generic
 
 makeLenses ''WithQuery
-
 instance FromJSON WithQuery where
   parseJSON = genericParseJSON $ jsonOptions "_wq_"
-
-instance ToSchema WithQuery
+instance ToSchema WithQuery where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wq_")
+
+-------------------------------------------------------
+data WithForm = WithForm
+  { _wf_filetype :: !FileType
+  , _wf_data     :: !Text
+  } deriving (Eq, Show, Generic)
+
+makeLenses ''WithForm
+instance FromForm WithForm
+instance FromJSON WithForm where
+  parseJSON = genericParseJSON $ jsonOptions "_wf_"
+instance ToSchema WithForm where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
 
 ------------------------------------------------------------------------
-type
-  AddAPI withInput = AsyncJobsAPI ScraperStatus withInput ScraperStatus
+type AsyncJobs event ctI input output =
+  Flat (AsyncJobsAPI' 'Unsafe 'Safe ctI '[JSON] Maybe event input output)
 ------------------------------------------------------------------------
-
-type AddWithQuery = Summary "Add to corpus endpoint"
+type AddWithQuery = Summary "Add with Query to corpus endpoint"
    :> "corpus"
    :> Capture "corpus_id" CorpusId
    :> "add"
    :> "query"
    :> "async"
-   :> AddAPI WithQuery
+   :> AsyncJobsAPI ScraperStatus WithQuery ScraperStatus
 
-type AddWithFile = Summary "Add to corpus endpoint"
+type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
    :> "corpus"
    :> Capture "corpus_id" CorpusId
    :> "add" 
@@ -174,7 +155,15 @@ type AddWithFile = Summary "Add to corpus endpoint"
    :> MultipartForm Mem (MultipartData Mem)
    :> QueryParam "fileType"  FileType
    :> "async"
-   :> AddAPI ()
+   :> AsyncJobs ScraperStatus '[JSON] () ScraperStatus
+
+type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
+   :> "corpus"
+   :> Capture "corpus_id" CorpusId
+   :> "add"
+   :> "form"
+   :> "async"
+   :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus
 
 ------------------------------------------------------------------------
 -- TODO WithQuery also has a corpus id
@@ -183,7 +172,7 @@ addToCorpusJobFunction :: FlowCmdM env err m
                        -> WithQuery
                        -> (ScraperStatus -> m ())
                        -> m ScraperStatus
-addToCorpusJobFunction _cid _input logStatus = do
+addToCorpusJobFunction _cid (WithQuery _q _dbs) logStatus = do
   -- TODO ...
   logStatus ScraperStatus { _scst_succeeded = Just 10
                           , _scst_failed    = Just 2
@@ -197,6 +186,7 @@ addToCorpusJobFunction _cid _input logStatus = do
                           , _scst_events    = Just []
                           }
 
+
 addToCorpusWithFile :: FlowCmdM env err m
                     => CorpusId
                     -> MultipartData Mem
@@ -217,3 +207,29 @@ addToCorpusWithFile cid input filetype logStatus = do
                           , _scst_events    = Just []
                           }
 
+addToCorpusWithForm :: FlowCmdM env err m
+                    => CorpusId
+                    -> WithForm
+                    -> (ScraperStatus -> m ())
+                    -> m ScraperStatus
+addToCorpusWithForm cid (WithForm _ft d) logStatus = do
+
+  let docs = splitEvery 500
+           $ take 10000
+           $ parseHal' (cs d)
+
+  logStatus ScraperStatus { _scst_succeeded = Just 1
+                          , _scst_failed    = Just 0
+                          , _scst_remaining = Just 1
+                          , _scst_events    = Just []
+                          }
+
+  cid' <- flowCorpus "user1" (Right [cid]) (Multi EN) (map (map toHyperdataDocument) docs)
+  printDebug "cid'" cid' 
+
+  pure      ScraperStatus { _scst_succeeded = Just 2
+                          , _scst_failed    = Just 0
+                          , _scst_remaining = Just 0
+                          , _scst_events    = Just []
+                          }
+

src/Gargantext/Text/Corpus/Parsers/CSV.hs

@@ -387,6 +387,10 @@ csv2doc (CsvDoc title source
 ------------------------------------------------------------------------
 parseHal :: FilePath -> IO [HyperdataDocument]
 parseHal fp = V.toList <$> V.map csvHal2doc <$> snd <$> readCsvHal fp
+
+parseHal' :: BL.ByteString -> [HyperdataDocument]
+parseHal' = V.toList . V.map csvHal2doc . snd . readCsvHalLazyBS 
+
 ------------------------------------------------------------------------
 
 parseCsv :: FilePath -> IO [HyperdataDocument]

stack.yaml

@@ -3,6 +3,7 @@ flags: {}
 extra-package-dbs: []
 packages:
 - .
+#- 'deps/servant-job'
 
 docker:
   enable: false
@@ -35,9 +36,10 @@ extra-deps:
     #
 - git: https://gitlab.iscpif.fr/gargantext/patches-class
   commit: 746b4ce0af8f9e600d555ad7e5b2973a940cdad9
-#- git: https://github.com/delanoe/servant-job.git
+  #- git: https://github.com/delanoe/servant-job.git
+  #commit: 7a7b7100e6d132adb4c11b25b2128e6309690ac0
 - git: https://github.com/np/servant-job.git
-  commit: 8557bfc9472a1b2be0b7bc632c23701ba5f44bf8
+  commit: 4016c76398a56e1a352a45b3ee9d698dd0dd2597
 - git: https://gitlab.iscpif.fr/gargantext/clustering-louvain.git
   commit: e5814cbfa71f43b0a453efb65f476240d7d51a53
 - git: https://github.com/np/patches-map