[FEAT] NgramsList upload

src/Gargantext/API/Corpus/New.hs

@@ -20,6 +20,7 @@ New corpus means either:
 {-# LANGUAGE OverloadedStrings  #-}
 {-# LANGUAGE FlexibleContexts   #-}
 {-# LANGUAGE RankNTypes         #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Gargantext.API.Corpus.New
       where
@@ -148,8 +149,8 @@ type AsyncJobs event ctI input output =
 type Upload = Summary "Corpus Upload endpoint"
    :> "corpus"
    :> Capture "corpus_id" CorpusId
-    :<|> "addWithquery" :> AsyncJobsAPI ScraperStatus WithQuery ScraperStatus
-    :<|> "addWithfile"  :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus
+    :<|> "addWithquery" :> AsyncJobsAPI ScraperStatus                   WithQuery ScraperStatus
+    :<|> "addWithfile"  :> AsyncJobs    ScraperStatus '[FormUrlEncoded] WithForm  ScraperStatus
 
 
 type AddWithQuery = Summary "Add with Query to corpus endpoint"

src/Gargantext/API/Ngrams.hs

@@ -123,6 +123,7 @@ import Control.Monad.State
 import Data.Aeson hiding ((.=))
 import Data.Aeson.TH (deriveJSON)
 import Data.Either(Either(Left))
+import Data.Either.Extra (maybeToEither)
 -- import Data.Map (lookup)
 import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
 import Data.Swagger hiding (version, patch)
@@ -662,7 +663,7 @@ data Versioned a = Versioned
   { _v_version :: Version
   , _v_data    :: a
   }
-  deriving (Generic, Show)
+  deriving (Generic, Show, Eq)
 deriveJSON (unPrefix "_v_") ''Versioned
 makeLenses ''Versioned
 instance ToSchema a => ToSchema (Versioned a) where
@@ -670,6 +671,7 @@ instance ToSchema a => ToSchema (Versioned a) where
 instance Arbitrary a => Arbitrary (Versioned a) where
   arbitrary = Versioned 1 <$> arbitrary -- TODO 1 is constant so far
 
+
 {-
 -- TODO sequencs of modifications (Patchs)
 type NgramsIdPatch = Patch NgramsId NgramsPatch
@@ -1100,7 +1102,6 @@ getTableNgrams _nType nId tabType listId limit_ offset
 -- TODO: find a better place for the code above, All APIs stay here
 type QueryParamR = QueryParam' '[Required, Strict]
 
-
 data OrderBy = TermAsc | TermDesc | ScoreAsc | ScoreDesc
              deriving (Generic, Enum, Bounded, Read, Show)
 
@@ -1112,6 +1113,7 @@ instance FromHttpApiData OrderBy
     parseUrlPiece "ScoreDesc" = pure ScoreDesc
     parseUrlPiece _           = Left "Unexpected value of OrderBy"
 
+
 instance ToParamSchema OrderBy
 instance FromJSON  OrderBy
 instance ToJSON    OrderBy
@@ -1205,8 +1207,8 @@ apiNgramsTableDoc :: ( RepoCmdM env err m
 apiNgramsTableDoc dId =  getTableNgramsDoc dId
                     :<|> tableNgramsPut
                     :<|> tableNgramsPost
-                        -- > add new ngrams in database (TODO AD)
-                        -- > index all the corpus accordingly (TODO AD)
+                    -- > add new ngrams in database (TODO AD)
+                    -- > index all the corpus accordingly (TODO AD)
 
 listNgramsChangedSince :: RepoCmdM env err m
                        => ListId -> NgramsType -> Version -> m (Versioned Bool)
@@ -1222,3 +1224,7 @@ instance Arbitrary NgramsRepoElement where
     where
       NgramsTable ns = mockTable
 
+--{-
+instance FromHttpApiData (Map NgramsType (Versioned NgramsTableMap))
+  where
+    parseUrlPiece x = maybeToEither x (decode $ cs x)

src/Gargantext/API/Ngrams/List.hs

@@ -23,21 +23,43 @@ Portability : POSIX
 module Gargantext.API.Ngrams.List
   where
 
-import Data.Text (Text, concat, pack)
+import Control.Lens hiding (elements)
+import Control.Monad.IO.Class (liftIO)
 import Data.Aeson
 import Data.List (zip)
 import Data.Map (Map, toList, fromList)
-import Network.HTTP.Media ((//), (/:))
-import Servant
-
-import Gargantext.Prelude
+import Data.Swagger (ToSchema, declareNamedSchema, genericDeclareNamedSchema)
+import Data.Text (Text, concat, pack)
+import GHC.Generics (Generic)
+import Gargantext.API.Corpus.New
+import Gargantext.API.Corpus.New.File (FileType(..))
 import Gargantext.API.Ngrams
+import Gargantext.API.Orchestrator.Types
 import Gargantext.API.Types (GargServer)
 import Gargantext.Database.Flow (FlowCmdM)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes)
 import Gargantext.Database.Types.Node
+import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
+import Gargantext.Prelude
+import Network.HTTP.Media ((//), (/:))
+import Servant
+import Servant.Job.Async
+import Web.FormUrlEncoded          (FromForm)
+import Servant.Job.Utils (jsonOptions)
 
+------------------------------------------------------------------------
 type NgramsList = (Map NgramsType (Versioned NgramsTableMap))
+------------------------------------------------------------------------
+type API =  Get '[HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
+       -- :<|> ReqBody '[JSON] NgramsList :> Post '[JSON] Bool
+       :<|> PostAPI
+
+api :: ListId -> GargServer API
+api l =
+        get l
+    :<|>
+        -- post l
+        postAsync l
 
 data HTML
 instance Accept HTML where
@@ -45,35 +67,82 @@ instance Accept HTML where
 instance ToJSON a => MimeRender HTML a where
   mimeRender _ = encode
 
-type API = ReqBody '[JSON] NgramsList :> Put '[JSON] Bool
-      :<|> Get '[HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
-
-api :: ListId -> GargServer API
-api l = put l :<|> getHtml l
+------------------------------------------------------------------------
 
 get :: RepoCmdM env err m
+        => ListId -> m (Headers '[Header "Content-Disposition" Text] NgramsList)
+get lId = do
+  lst <- get' lId
+  let (NodeId id) = lId
+  return $ addHeader (concat [ "attachment; filename=GarganText_NgramsList-"
+                             , pack $ show id
+                             , ".json"
+                             ]
+                     ) lst
+
+get' :: RepoCmdM env err m
     => ListId -> m NgramsList
-get lId = fromList
+get' lId = fromList
        <$> zip ngramsTypes
        <$> mapM (getNgramsTableMap lId) ngramsTypes
 
-getHtml :: RepoCmdM env err m
-        => ListId -> m (Headers '[Header "Content-Disposition" Text] NgramsList)
-getHtml lId = do
-  lst <- get lId
-  let (NodeId id) = lId
-  return $ addHeader (concat ["attachment; filename=GarganText_NgramsList-", pack $ show id, ".json"]) lst
-
+------------------------------------------------------------------------
 
 -- TODO : purge list
-put :: FlowCmdM env err m
+post :: FlowCmdM env err m
     => ListId
     -> NgramsList
     -> m Bool
-put l m = do
+post l m  = do
   -- TODO check with Version for optim
   _ <- mapM (\(nt, Versioned _v ns) -> putListNgrams' l nt ns) $ toList m
   -- TODO reindex
   pure True
 
+------------------------------------------------------------------------
+------------------------------------------------------------------------
+
+type PostAPI = Summary "Update List"
+        :> "add"
+        :> "form"
+        :> "async"
+        :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithFile ScraperStatus
+
+postAsync :: ListId -> GargServer PostAPI
+postAsync lId =
+  serveJobsAPI $
+    JobFunction (\f  log' -> postAsync' lId f (liftIO . log'))
+
+postAsync' :: FlowCmdM env err m
+          => ListId
+          -> WithFile
+          -> (ScraperStatus -> m ())
+          -> m ScraperStatus
+postAsync' l (WithFile _ m _) logStatus = do
+
+  logStatus ScraperStatus { _scst_succeeded = Just 0
+                          , _scst_failed    = Just 0
+                          , _scst_remaining = Just 1
+                          , _scst_events    = Just []
+                          }
+  _r <- post l m
+
+  pure ScraperStatus { _scst_succeeded = Just 1
+                     , _scst_failed    = Just 0
+                     , _scst_remaining = Just 0
+                     , _scst_events    = Just []
+                     }
+
+data WithFile = WithFile
+  { _wf_filetype :: !FileType
+  , _wf_data     :: !NgramsList
+  , _wf_name     :: !Text
+  } deriving (Eq, Show, Generic)
+
+makeLenses ''WithFile
+instance FromForm WithFile
+instance FromJSON WithFile where
+  parseJSON = genericParseJSON $ jsonOptions "_wf_"
+instance ToSchema WithFile where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")