[Annuaire] async file upload stub

src/Gargantext/API.hs

@@ -94,6 +94,7 @@ import Gargantext.API.Ngrams (HasRepo(..), HasRepoSaver(..), saveRepo, TableNgra
 import Gargantext.API.Node
 import Gargantext.API.Search (SearchPairsAPI, searchPairs)
 import Gargantext.API.Types
+import qualified Gargantext.API.Annuaire as Annuaire
 import qualified Gargantext.API.Export as Export
 import qualified Gargantext.API.Corpus.New as New
 import Gargantext.Database.Types.Node
@@ -304,6 +305,8 @@ type GargPrivateAPI' =
            -- :<|> New.Upload
            :<|> New.AddWithForm
            :<|> New.AddWithQuery
+
+           :<|> Annuaire.AddWithForm
            -- :<|> New.AddWithFile
        --  :<|> "scraper" :> WithCallbacks ScraperAPI
        --  :<|> "new"  :> New.Api
@@ -390,8 +393,10 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
      -- TODO access
      -- :<|> addUpload
      -- :<|> (\corpus -> addWithQuery corpus :<|> addWithFile corpus)
-     :<|> addWithForm
-     :<|> addWithQuery
+     :<|> addCorpusWithForm
+     :<|> addCorpusWithQuery
+
+     :<|> addAnnuaireWithForm
      -- :<|> New.api  uid -- TODO-SECURITY
      -- :<|> New.info uid -- TODO-SECURITY
 
@@ -401,8 +406,8 @@ addUpload cId = (serveJobsAPI $ JobFunction (\i log -> New.addToCorpusJobFunctio
            :<|> (serveJobsAPI $ JobFunction (\i log -> New.addToCorpusWithForm    cid i (liftIO . log)))
 --}
 
-addWithQuery :: GargServer New.AddWithQuery
-addWithQuery cid =
+addCorpusWithQuery :: GargServer New.AddWithQuery
+addCorpusWithQuery cid =
   serveJobsAPI $
     JobFunction (\i log -> New.addToCorpusJobFunction cid i (liftIO . log))
 
@@ -411,11 +416,16 @@ addWithFile cid i f =
   serveJobsAPI $
     JobFunction (\_i log -> New.addToCorpusWithFile cid i f (liftIO . log))
 
-addWithForm :: GargServer New.AddWithForm
-addWithForm cid =
+addCorpusWithForm :: GargServer New.AddWithForm
+addCorpusWithForm cid =
   serveJobsAPI $
     JobFunction (\i log -> New.addToCorpusWithForm cid i (liftIO . log))
 
+addAnnuaireWithForm :: GargServer Annuaire.AddWithForm
+addAnnuaireWithForm cid =
+  serveJobsAPI $
+    JobFunction (\i log -> Annuaire.addToAnnuaireWithForm cid i (liftIO . log))
+
 serverStatic :: Server (Get '[HTML] Html)
 serverStatic = $(do
                   let path = "purescript-gargantext/dist/index.html"

src/Gargantext/API/Annuaire.hs

+{-|
+Module      : Gargantext.API.Annuaire
+Description : New annuaire API
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+{-# LANGUAGE NoImplicitPrelude  #-}
+{-# LANGUAGE TemplateHaskell    #-}
+{-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE DataKinds          #-}
+{-# LANGUAGE TypeOperators      #-}
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE FlexibleContexts   #-}
+{-# LANGUAGE RankNTypes         #-}
+
+module Gargantext.API.Annuaire
+      where
+
+import Control.Lens hiding (elements)
+import Data.Aeson
+import Data.Swagger
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import qualified Gargantext.API.Corpus.New.File as NewFile
+import Gargantext.API.Orchestrator.Types
+import Gargantext.Core (Lang(..))
+import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
+import Gargantext.Database.Flow (FlowCmdM)  -- flowAnnuaire
+import Gargantext.Database.Types.Node (AnnuaireId)
+import Gargantext.Prelude
+import Servant
+import Servant.API.Flatten (Flat)
+import Servant.Job.Core
+import Servant.Job.Types
+import Servant.Job.Utils (jsonOptions)
+import Web.FormUrlEncoded          (FromForm)
+
+
+type Api = Summary "New Annuaire endpoint"
+         :> Post '[JSON] AnnuaireId
+
+------------------------------------------------------------------------
+------------------------------------------------------------------------
+data WithForm = WithForm
+  { _wf_filetype :: !NewFile.FileType
+  , _wf_data     :: !Text
+  , _wf_lang     :: !(Maybe Lang)
+  } 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 AsyncJobs event ctI input output =
+  Flat (AsyncJobsAPI' 'Unsafe 'Safe ctI '[JSON] Maybe event input output)
+------------------------------------------------------------------------
+
+type AddWithForm = Summary "Add with FormUrlEncoded to annuaire endpoint"
+   :> "corpus"
+   :> Capture "annuaire_id" AnnuaireId
+   :> "add"
+   :> "form"
+   :> "async"
+   :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus
+
+------------------------------------------------------------------------
+addToAnnuaireWithForm :: FlowCmdM env err m
+                    => AnnuaireId
+                    -> WithForm
+                    -> (ScraperStatus -> m ())
+                    -> m ScraperStatus
+addToAnnuaireWithForm _cid (WithForm ft _d _l) logStatus = do
+
+  printDebug "ft" ft
+
+  -- let
+    -- parse = case ft of
+    --   CSV_HAL   -> Parser.parseFormat Parser.CsvHal
+    --   CSV       -> Parser.parseFormat Parser.CsvGargV3
+    --   WOS       -> Parser.parseFormat Parser.WOS
+    --   PresseRIS -> Parser.parseFormat Parser.RisPresse
+
+  -- docs <- liftIO
+  --       $ splitEvery 500
+  --      <$> take 1000000
+  --      <$> parse (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 $ fromMaybe EN l)
+  --                    (map (map toHyperdataDocument) docs)
+
+  -- printDebug "cid'" cid'
+
+  pure      ScraperStatus { _scst_succeeded = Just 2
+                          , _scst_failed    = Just 0
+                          , _scst_remaining = Just 0
+                          , _scst_events    = Just []
+                          }
+

stack.yaml

@@ -8,6 +8,8 @@ packages:
 docker:
   enable: false
   repo: 'fpco/stack-build:lts-14.6-garg'
+  run-args:
+    - '--publish=8008:8008'
 
 allow-newer: true
 extra-deps: