Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
150
Issues
150
List
Board
Labels
Milestones
Merge Requests
7
Merge Requests
7
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
c0d83a7b
Verified
Commit
c0d83a7b
authored
Apr 04, 2025
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[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
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
57 additions
and
53 deletions
+57
-53
Export.hs
src/Gargantext/API/Node/Corpus/Export.hs
+6
-5
Utils.hs
src/Gargantext/API/Node/Corpus/Export/Utils.hs
+51
-48
No files found.
src/Gargantext/API/Node/Corpus/Export.hs
View file @
c0d83a7b
...
...
@@ -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
'[
H
eader
"Content-Disposition"
Text
]
CorpusSQLite
)
getCorpusSQLite
::
(
CES
.
MonadMask
m
,
IsGargServer
env
err
m
)
=>
CorpusId
->
Maybe
ListId
->
m
(
Headers
'[
H
eader
"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
...
...
src/Gargantext/API/Node/Corpus/Export/Utils.hs
View file @
c0d83a7b
...
...
@@ -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
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment