[sqlite] replace putText with logLocM

Also, no need for `liftBase` in `getCorpusSQLite`.
parent 3e49fe87
Pipeline #7509 passed with stages
in 39 minutes and 56 seconds
......@@ -87,13 +87,14 @@ getCorpus cId = Named.CorpusExportAPI {
, _c_hash = hash $ List.map DocumentExport._d_hash $ Map.elems r }
getCorpusSQLite :: (CES.MonadMask m, IsGargServer env err m)
=> CorpusId
-> Maybe ListId
-> m (Headers '[Header "Content-Disposition" Text] CorpusSQLite)
getCorpusSQLite :: ( CES.MonadMask m
, IsGargServer env err m)
=> CorpusId
-> Maybe ListId
-> m (Headers '[Header "Content-Disposition" Text] CorpusSQLite)
getCorpusSQLite cId lId = do
corpusSQLiteData <- mkCorpusSQLiteData cId lId
corpusSQLite <- liftBase $ mkCorpusSQLite corpusSQLiteData
corpusSQLite <- mkCorpusSQLite corpusSQLiteData
pure $ addHeader ("attachment; filename=GarganText_corpus-" <> pack (show cId) <> ".sqlite")
$ corpusSQLite
......
......@@ -8,6 +8,7 @@ Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module Gargantext.API.Node.Corpus.Export.Utils
......@@ -46,6 +47,7 @@ import Gargantext.Database.Query.Table.NodeContext (selectDocNodes)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
import Gargantext.Prelude
import Gargantext.System.Logging (logLocM, LogLevel(..), MonadLogger)
import Paths_gargantext qualified as PG -- cabal magic build module
import Prelude qualified
import System.Directory (removeDirectoryRecursive)
......@@ -122,57 +124,58 @@ mkCorpusSQLiteData cId lId = do
mkCorpusSQLite :: ( CES.MonadMask m
, MonadBase IO m )
, MonadBase IO m
, MonadLogger m )
=> CorpusSQLiteData
-> m CorpusSQLite
mkCorpusSQLite (CorpusSQLiteData { .. }) = withTempSQLiteDir $ \(fp, _fname, fpath) -> liftBase $ do
putText $ "[mkCorpusSQLite] listId: " <> show _csd_lId
putText $ "[mkCorpusSQLite] fp: " <> show fp
S.withConnection fpath $ \conn -> do
-- better performance
-- https://kerkour.com/sqlite-for-servers
S.execute_ conn "PRAGMA journal_mode = WAL"
S.execute_ conn "CREATE TABLE info (key, value);"
S.execute conn "INSERT INTO info (key, value) VALUES ('gargVersion', ?)" (S.Only $ showVersion _csd_version)
S.execute conn "INSERT INTO info (key, value) VALUES ('corpusId', ?)" (S.Only $ unNodeId _csd_cId)
S.execute conn "INSERT INTO info (key, value) VALUES ('listId', ?)" (S.Only $ unNodeId _csd_lId)
S.execute conn "INSERT INTO info (key, value) VALUES ('created', datetime(?))" (S.Only $ iso8601Show _csd_created)
S.execute_ conn "CREATE TABLE corpus (id, name, hash, parent_id, hyperdata)"
S.execute conn "INSERT INTO corpus (id, name, hash, parent_id, hyperdata) VALUES (?, ?, ?, ?, ?)"
( unNodeId _csd_cId
, _csd_corpus_name
, _csd_corpus_hash
, unNodeId <$> _csd_corpus_parent
, Aeson.encode _csd_corpus_hyperdata )
S.execute_ conn "CREATE TABLE lists (id, name, parent_id, hyperdata)"
S.execute conn "INSERT INTO lists (id, name, parent_id, hyperdata) VALUES (?, ?, ?, ?)"
( unNodeId _csd_lId
, _csd_list_name
, unNodeId <$> _csd_list_parent
, Aeson.encode _csd_list_hyperdata )
S.execute_ conn "CREATE TABLE ngrams (context_id, terms, type_)"
let insertTerms ngs type_ = do
let ngs' = concatMap (\(ctxId, ngrams) -> (\n -> (_ContextId ctxId, unNgramsTerm n, type_)) <$> Set.toList ngrams) (Map.toList ngs)
S.executeMany conn "INSERT INTO ngrams (context_id, terms, type_) VALUES (?, ?, ?)" ngs'
insertTerms _csd_map_context_ngrams ("map" :: Text)
insertTerms _csd_stop_context_ngrams ("stop" :: Text)
insertTerms _csd_candidate_context_ngrams ("candidate" :: Text)
S.execute_ conn "CREATE TABLE documents (context_id, name, date, hyperdata)"
S.executeMany conn "INSERT INTO documents (context_id, name, date, hyperdata) VALUES (?, ?, date(?), ?)"
((\(ctxId, ctxName, ctxDate, ctxHyperdata) -> ( unNodeId ctxId
, ctxName
, iso8601Show ctxDate
, Aeson.encode ctxHyperdata )) <$> _csd_contexts)
bsl <- BSL.readFile fpath
mkCorpusSQLite (CorpusSQLiteData { .. }) = withTempSQLiteDir $ \(fp, _fname, fpath) -> do
$(logLocM) DEBUG $ "listId: " <> show _csd_lId
$(logLocM) DEBUG $ "fp: " <> show fp
liftBase $ do
S.withConnection fpath $ \conn -> do
-- better performance
-- https://kerkour.com/sqlite-for-servers
S.execute_ conn "PRAGMA journal_mode = WAL"
S.execute_ conn "CREATE TABLE info (key, value);"
S.execute conn "INSERT INTO info (key, value) VALUES ('gargVersion', ?)" (S.Only $ showVersion _csd_version)
S.execute conn "INSERT INTO info (key, value) VALUES ('corpusId', ?)" (S.Only $ unNodeId _csd_cId)
S.execute conn "INSERT INTO info (key, value) VALUES ('listId', ?)" (S.Only $ unNodeId _csd_lId)
S.execute conn "INSERT INTO info (key, value) VALUES ('created', datetime(?))" (S.Only $ iso8601Show _csd_created)
S.execute_ conn "CREATE TABLE corpus (id, name, hash, parent_id, hyperdata)"
S.execute conn "INSERT INTO corpus (id, name, hash, parent_id, hyperdata) VALUES (?, ?, ?, ?, ?)"
( unNodeId _csd_cId
, _csd_corpus_name
, _csd_corpus_hash
, unNodeId <$> _csd_corpus_parent
, Aeson.encode _csd_corpus_hyperdata )
S.execute_ conn "CREATE TABLE lists (id, name, parent_id, hyperdata)"
S.execute conn "INSERT INTO lists (id, name, parent_id, hyperdata) VALUES (?, ?, ?, ?)"
( unNodeId _csd_lId
, _csd_list_name
, unNodeId <$> _csd_list_parent
, Aeson.encode _csd_list_hyperdata )
S.execute_ conn "CREATE TABLE ngrams (context_id, terms, type_)"
let insertTerms ngs type_ = do
let ngs' = concatMap (\(ctxId, ngrams) -> (\n -> (_ContextId ctxId, unNgramsTerm n, type_)) <$> Set.toList ngrams) (Map.toList ngs)
S.executeMany conn "INSERT INTO ngrams (context_id, terms, type_) VALUES (?, ?, ?)" ngs'
insertTerms _csd_map_context_ngrams ("map" :: Text)
insertTerms _csd_stop_context_ngrams ("stop" :: Text)
insertTerms _csd_candidate_context_ngrams ("candidate" :: Text)
S.execute_ conn "CREATE TABLE documents (context_id, name, date, hyperdata)"
S.executeMany conn "INSERT INTO documents (context_id, name, date, hyperdata) VALUES (?, ?, date(?), ?)"
((\(ctxId, ctxName, ctxDate, ctxHyperdata) -> ( unNodeId ctxId
, ctxName
, iso8601Show ctxDate
, Aeson.encode ctxHyperdata )) <$> _csd_contexts)
bsl <- BSL.readFile fpath
pure $ CorpusSQLite { _cs_bs = bsl }
pure $ CorpusSQLite { _cs_bs = bsl }
readCorpusSQLite :: ( CES.MonadMask m
......
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