refactoring 2021, remove old phylo files, keep API
[gargantext.git] / src / Gargantext / API / Ngrams / List.hs
index 94c34ca31d7af5281a941e0296de32074087cce9..ef8167e5ef4c3db0bef04679e7f583eafe700bb4 100644 (file)
@@ -9,34 +9,44 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE TypeOperators     #-}
 
 module Gargantext.API.Ngrams.List
   where
 
+import Control.Lens hiding (elements)
 import Data.Aeson
-import Data.List (zip)
 import Data.Map (Map, toList, fromList)
+import Data.Swagger (ToSchema, declareNamedSchema, genericDeclareNamedSchema)
+import Data.Text (Text, concat, pack)
+import GHC.Generics (Generic)
 import Network.HTTP.Media ((//), (/:))
 import Servant
+import Servant.Job.Async
+import Servant.Job.Utils (jsonOptions)
+import Web.FormUrlEncoded (FromForm)
 
-import Gargantext.Prelude
-import Gargantext.API.Ngrams
-import Gargantext.API.Types (GargServer)
-import Gargantext.Database.Flow (FlowCmdM)
+import Gargantext.API.Admin.Orchestrator.Types
+import Gargantext.API.Ngrams (getNgramsTableMap, setListNgrams)
+import Gargantext.API.Ngrams.Types (NgramsTableMap, RepoCmdM, Versioned(..))
+import Gargantext.API.Node.Corpus.New.File (FileType(..))
+import Gargantext.API.Prelude (GargServer)
+import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
+import Gargantext.Database.Action.Flow.Types (FlowCmdM)
+import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes)
-import Gargantext.Database.Types.Node
+import Gargantext.Prelude
 
+------------------------------------------------------------------------
 type NgramsList = (Map NgramsType (Versioned NgramsTableMap))
+------------------------------------------------------------------------
+type API =  Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
+       -- :<|> ReqBody '[JSON] NgramsList :> Post '[JSON] Bool
+       :<|> PostAPI
+
+api :: ListId -> GargServer API
+api l = get l :<|> postAsync l
 
 data HTML
 instance Accept HTML where
@@ -44,35 +54,80 @@ instance Accept HTML where
 instance ToJSON a => MimeRender HTML a where
   mimeRender _ = encode
 
-type API = Get '[JSON] NgramsList
-      :<|> ReqBody '[JSON] NgramsList :> Put '[JSON] Bool
-      :<|> Get '[HTML] (Headers '[Header "Content-Type" String] NgramsList)
+------------------------------------------------------------------------
+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
 
-api :: ListId -> GargServer API
-api l = get l :<|> put l :<|> getHtml l
-
-get :: RepoCmdM env err m
+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-Type" String] NgramsList)
-getHtml lId = do
-  lst <- get lId
-  return $ addHeader "attachment" lst
-
-
+------------------------------------------------------------------------
 -- TODO : purge list
-put :: FlowCmdM env err m
+-- TODO talk
+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
+  _ <- mapM (\(nt, Versioned _v ns) -> setListNgrams l nt ns) $ toList m
   -- TODO reindex
   pure True
 
+------------------------------------------------------------------------
+------------------------------------------------------------------------
+type PostAPI = Summary "Update List"
+        :> "add"
+        :> "form"
+        :> "async"
+        :> AsyncJobs JobLog '[FormUrlEncoded] WithFile JobLog
+
+postAsync :: ListId -> GargServer PostAPI
+postAsync lId =
+  serveJobsAPI $
+    JobFunction (\f  log' -> postAsync' lId f (liftBase . log'))
+
+postAsync' :: FlowCmdM env err m
+          => ListId
+          -> WithFile
+          -> (JobLog -> m ())
+          -> m JobLog
+postAsync' l (WithFile _ m _) logStatus = do
+
+  logStatus JobLog { _scst_succeeded = Just 0
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 1
+                   , _scst_events    = Just []
+                   }
+  _r <- post l m
+
+  pure JobLog { _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_")