Commit 6019587c authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Initial support for importing ngrams

parent 842b3d36
......@@ -15,12 +15,13 @@ import Control.Exception.Safe qualified as Safe
import Control.Exception (toException)
import Control.Lens (view, (#))
import Control.Monad.Except (throwError, MonadError)
import Control.Monad (void)
import Data.Aeson qualified as JSON
import Data.ByteString.Builder qualified as B
import Data.ByteString.Lazy qualified as BL
import Data.Conduit.Combinators qualified as C
import Data.Conduit.List qualified as CL
import Data.Foldable (foldlM)
import Data.Foldable (for_, foldlM)
import Data.Text qualified as T
import Gargantext.API.Admin.Auth
import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..))
......@@ -28,13 +29,17 @@ import Gargantext.API.Auth.PolicyCheck (remoteExportChecks)
import Gargantext.API.Errors.Types
import Gargantext.API.Ngrams.Prelude (getNgramsList)
import Gargantext.API.Ngrams.Types (NgramsList)
import Gargantext.API.Node.Document.Export (get_document_json)
import Gargantext.API.Node.Document.Export.Types (DocumentExport)
import Gargantext.API.Prelude (IsGargServer)
import Gargantext.API.Routes.Client (remoteImportClient)
import Gargantext.API.Routes.Named.Remote qualified as Named
import Gargantext.Core.Config
import Gargantext.Core (lookupDBid)
import Gargantext.Core.NodeStory.Types (HasNodeStoryEnv)
import Gargantext.Core.Types.Main
import Gargantext.Core.Worker.Jobs (sendJob)
import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (IsDBCmd)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError, nodeError, NodeError (..))
......@@ -45,7 +50,6 @@ import GHC.Generics (Generic)
import Prelude
import Servant.Client.Streaming (mkClientEnv, withClientM, ClientError)
import Servant.Server.Generic (AsServerT)
import Gargantext.API.Node.Document.Export (get_document_json)
data ExportableNode =
ExportableNode {
......@@ -73,7 +77,11 @@ remoteAPI authenticatedUser = Named.RemoteAPI $
type ExpectedPayload = Tree ExportableNode
remoteImportHandler :: forall err env m.
(HasNodeError err, HasBackendInternalError err, IsDBCmd env err m, MonadIO m)
( HasNodeStoryEnv env
, HasNodeError err
, HasBackendInternalError err
, IsDBCmd env err m
, MonadIO m)
=> AuthenticatedUser
-> ConduitT () Named.RemoteBinaryData IO ()
-> m [NodeId]
......@@ -93,10 +101,16 @@ remoteImportHandler loggedInUser c = do
where
insertNode :: Maybe NodeId -> ExportableNode -> m NodeId
insertNode mb_parent (ExportableNode x _mb_docs _mb_terms) = case lookupDBid $ _node_typename x of
insertNode mb_parent (ExportableNode x _mb_docs mb_terms) = case lookupDBid $ _node_typename x of
Nothing -> throwError $ _BackendInternalError # InternalUnexpectedError (toException $ userError $ "remoteImportHandler: impossible, node with invalid type.")
Just ty -> do
new_node <- insertNodeWithHyperdata ty (_node_name x) (_node_hyperdata x) mb_parent (_auth_user_id loggedInUser)
for_ mb_terms $ \ngramsList -> do
void $ sendJob $ Jobs.JSONPost { _jp_list_id = new_node
, _jp_ngrams_list = ngramsList
}
--for_ mb_docs $ \docsList -> do
-- addToCorpusWithForm user corpusId new_with_form (noJobHandle @m Proxy)
pure new_node
insertTrees :: Maybe NodeId -> [NodeId] -> Tree ExportableNode -> m [NodeId]
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment