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
153
Issues
153
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
f6897b2b
Commit
f6897b2b
authored
Mar 26, 2025
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
fix merge
parents
656ec546
fcf968af
Pipeline
#7481
passed with stages
in 44 minutes and 36 seconds
Changes
25
Pipelines
1
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
25 changed files
with
526 additions
and
83 deletions
+526
-83
gargantext.cabal
gargantext.cabal
+7
-1
NgramsTree.hs
src/Gargantext/API/Ngrams/NgramsTree.hs
+1
-1
Export.hs
src/Gargantext/API/Node/Corpus/Export.hs
+18
-28
Types.hs
src/Gargantext/API/Node/Corpus/Export/Types.hs
+56
-6
Utils.hs
src/Gargantext/API/Node/Corpus/Export/Utils.hs
+269
-0
Searx.hs
src/Gargantext/API/Node/Corpus/Searx.hs
+2
-3
DocumentUpload.hs
src/Gargantext/API/Node/DocumentUpload.hs
+3
-5
Corpus.hs
src/Gargantext/API/Routes/Named/Corpus.hs
+6
-2
Arxiv.hs
src/Gargantext/Core/Text/Corpus/API/Arxiv.hs
+2
-2
Types.hs
src/Gargantext/Core/Viz/Types.hs
+1
-1
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+14
-14
Corpus.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs
+1
-1
CorpusField.hs
src/Gargantext/Database/Admin/Types/Hyperdata/CorpusField.hs
+2
-2
List.hs
src/Gargantext/Database/Admin/Types/Hyperdata/List.hs
+1
-1
Metrics.hs
src/Gargantext/Database/Admin/Types/Metrics.hs
+3
-3
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+1
-0
stack.yaml
stack.yaml
+12
-0
API.hs
test/Test/API.hs
+2
-0
Export.hs
test/Test/API/Export.hs
+95
-0
Prelude.hs
test/Test/API/Prelude.hs
+1
-1
Routes.hs
test/Test/API/Routes.hs
+24
-2
UpdateList.hs
test/Test/API/UpdateList.hs
+1
-0
DocumentSearch.hs
test/Test/Database/Operations/DocumentSearch.hs
+1
-7
PublishNode.hs
test/Test/Database/Operations/PublishNode.hs
+0
-3
Types.hs
test/Test/Database/Types.hs
+3
-0
No files found.
gargantext.cabal
View file @
f6897b2b
...
@@ -134,6 +134,8 @@ library
...
@@ -134,6 +134,8 @@ library
Gargantext.API.Node
Gargantext.API.Node
Gargantext.API.Node.Contact.Types
Gargantext.API.Node.Contact.Types
Gargantext.API.Node.Corpus.Annuaire
Gargantext.API.Node.Corpus.Annuaire
Gargantext.API.Node.Corpus.Export.Types
Gargantext.API.Node.Corpus.Export.Utils
Gargantext.API.Node.Corpus.New
Gargantext.API.Node.Corpus.New
Gargantext.API.Node.Corpus.New.Types
Gargantext.API.Node.Corpus.New.Types
Gargantext.API.Node.Corpus.Types
Gargantext.API.Node.Corpus.Types
...
@@ -344,7 +346,6 @@ library
...
@@ -344,7 +346,6 @@ library
Gargantext.API.Ngrams.NgramsTree
Gargantext.API.Ngrams.NgramsTree
Gargantext.API.Node.Contact
Gargantext.API.Node.Contact
Gargantext.API.Node.Corpus.Export
Gargantext.API.Node.Corpus.Export
Gargantext.API.Node.Corpus.Export.Types
Gargantext.API.Node.Corpus.Searx
Gargantext.API.Node.Corpus.Searx
Gargantext.API.Node.Corpus.Subcorpus
Gargantext.API.Node.Corpus.Subcorpus
Gargantext.API.Node.Document.Export
Gargantext.API.Node.Document.Export
...
@@ -621,6 +622,7 @@ library
...
@@ -621,6 +622,7 @@ library
, singletons-th >= 3.1 && < 3.3
, singletons-th >= 3.1 && < 3.3
, smtp-mail >= 0.3.0.0
, smtp-mail >= 0.3.0.0
, split >= 0.2.3.4
, split >= 0.2.3.4
, sqlite-simple >= 0.4.19 && < 0.5
, stemmer == 0.5.2
, stemmer == 0.5.2
, stm >= 2.5.1.0 && < 2.6
, stm >= 2.5.1.0 && < 2.6
, stm-containers >= 1.2.0.3 && < 1.3
, stm-containers >= 1.2.0.3 && < 1.3
...
@@ -759,6 +761,7 @@ common commonTestDependencies
...
@@ -759,6 +761,7 @@ common commonTestDependencies
, servant-client >= 0.20 && < 0.21
, servant-client >= 0.20 && < 0.21
, servant-client-core >= 0.20 && < 0.21
, servant-client-core >= 0.20 && < 0.21
, servant-conduit >= 0.15 && < 0.17
, servant-conduit >= 0.15 && < 0.17
, servant-server >= 0.20.1 && < 0.21
, shelly >= 1.9 && < 2
, shelly >= 1.9 && < 2
, stm >= 2.5.1.0 && < 2.6
, stm >= 2.5.1.0 && < 2.6
, streaming-commons
, streaming-commons
...
@@ -868,12 +871,15 @@ test-suite garg-test-hspec
...
@@ -868,12 +871,15 @@ test-suite garg-test-hspec
main-is: drivers/hspec/Main.hs
main-is: drivers/hspec/Main.hs
build-depends:
build-depends:
process ^>= 1.6.18.0
process ^>= 1.6.18.0
, servant >= 0.20.1 && < 0.21
, sqlite-simple >= 0.4.19 && < 0.5
, unix >= 2.7.3 && < 2.9
, unix >= 2.7.3 && < 2.9
other-modules:
other-modules:
Paths_gargantext
Paths_gargantext
Test.API
Test.API
Test.API.Authentication
Test.API.Authentication
Test.API.Errors
Test.API.Errors
Test.API.Export
Test.API.GraphQL
Test.API.GraphQL
Test.API.Notifications
Test.API.Notifications
Test.API.Private
Test.API.Private
...
...
src/Gargantext/API/Ngrams/NgramsTree.hs
View file @
f6897b2b
...
@@ -34,7 +34,7 @@ data NgramsTree = NgramsTree { mt_label :: Text
...
@@ -34,7 +34,7 @@ data NgramsTree = NgramsTree { mt_label :: Text
,
mt_value
::
Double
,
mt_value
::
Double
,
mt_children
::
[
NgramsTree
]
,
mt_children
::
[
NgramsTree
]
}
}
deriving
(
Generic
,
Show
)
deriving
(
Generic
,
Show
,
Eq
)
toNgramsTree
::
Tree
(
NgramsTerm
,
Double
)
->
NgramsTree
toNgramsTree
::
Tree
(
NgramsTerm
,
Double
)
->
NgramsTree
toNgramsTree
(
Node
(
NgramsTerm
l
,
v
)
xs
)
=
NgramsTree
l
v
(
map
toNgramsTree
xs
)
toNgramsTree
(
Node
(
NgramsTerm
l
,
v
)
xs
)
=
NgramsTree
l
v
(
map
toNgramsTree
xs
)
...
...
src/Gargantext/API/Node/Corpus/Export.hs
View file @
f6897b2b
{-# LANGUAGE TypeOperators #-}
{-|
{-|
Module : Gargantext.API.Node.Corpus.Export
Module : Gargantext.API.Node.Corpus.Export
Description : Corpus export
Description : Corpus export
...
@@ -17,27 +16,22 @@ Main exports of Gargantext:
...
@@ -17,27 +16,22 @@ Main exports of Gargantext:
module
Gargantext.API.Node.Corpus.Export
module
Gargantext.API.Node.Corpus.Export
where
where
import
Data.HashMap.Strict
qualified
as
HashMap
import
Control.Exception.Safe
qualified
as
CES
import
Data.List
qualified
as
List
import
Data.List
qualified
as
List
import
Data.Map.Strict
qualified
as
Map
import
Data.Map.Strict
qualified
as
Map
import
Data.Set
qualified
as
Set
import
Data.Set
qualified
as
Set
import
Data.Text
(
pack
)
import
Data.Text
(
pack
)
import
Gargantext.API.Ngrams.Tools
(
filterListWithRoot
,
mapTermListRoot
,
getRepo
)
import
Gargantext.API.Ngrams.Tools
(
getRepo
)
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
(
unNgramsTerm
)
)
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
(
unNgramsTerm
)
)
import
Gargantext.API.Node.Corpus.Export.Types
(
Corpus
(
..
)
)
import
Gargantext.API.Node.Corpus.Export.Types
(
Corpus
(
..
),
CorpusSQLite
(
..
)
)
import
Gargantext.API.Node.Corpus.Export.Utils
(
getContextNgrams
,
mkCorpusSQLite
,
mkCorpusSQLiteData
)
import
Gargantext.API.Node.Document.Export.Types
qualified
as
DocumentExport
import
Gargantext.API.Node.Document.Export.Types
qualified
as
DocumentExport
import
Gargantext.API.Prelude
(
IsGargServer
)
import
Gargantext.API.Prelude
(
IsGargServer
)
import
Gargantext.Core.NodeStory.Types
(
NodeListStory
)
import
Gargantext.Core.Text.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Core.Text.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Core.Types.Main
(
ListType
(
MapTerm
)
)
import
Gargantext.Core.Types.Main
(
ListType
(
MapTerm
)
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Action.Metrics.NgramsByContext
(
getNgramsByContextOnlyUser
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
(
..
)
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
(
..
)
)
import
Gargantext.Database.Prelude
(
DBCmdExtra
)
import
Gargantext.Database.Query.Table.Node
(
defaultList
)
import
Gargantext.Database.Query.Table.Node
(
defaultList
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Select
(
selectNodesWithUsername
)
import
Gargantext.Database.Query.Table.NodeContext
(
selectDocNodes
)
import
Gargantext.Database.Query.Table.NodeContext
(
selectDocNodes
)
import
Gargantext.Database.Schema.Context
(
_context_id
)
import
Gargantext.Database.Schema.Context
(
_context_id
)
import
Gargantext.Prelude
hiding
(
hash
)
import
Gargantext.Prelude
hiding
(
hash
)
...
@@ -48,10 +42,13 @@ import qualified Gargantext.API.Routes.Named.Corpus as Named
...
@@ -48,10 +42,13 @@ import qualified Gargantext.API.Routes.Named.Corpus as Named
--------------------------------------------------
--------------------------------------------------
-- | Hashes are ordered by Set
-- | Hashes are ordered by Set
getCorpus
::
forall
env
err
m
.
IsGargServer
env
err
m
getCorpus
::
(
CES
.
MonadMask
m
,
IsGargServer
env
err
m
)
=>
CorpusId
=>
CorpusId
->
Named
.
CorpusExportAPI
(
AsServerT
m
)
->
Named
.
CorpusExportAPI
(
AsServerT
m
)
getCorpus
cId
=
Named
.
CorpusExportAPI
$
\
lId
nt'
->
get_corpus
lId
nt'
getCorpus
cId
=
Named
.
CorpusExportAPI
{
Named
.
corpusExportEp
=
get_corpus
,
Named
.
corpusSQLiteEp
=
getCorpusSQLite
cId
}
where
where
get_corpus
::
IsGargServer
env
err
m
get_corpus
::
IsGargServer
env
err
m
...
@@ -89,23 +86,16 @@ getCorpus cId = Named.CorpusExportAPI $ \lId nt' -> get_corpus lId nt'
...
@@ -89,23 +86,16 @@ getCorpus cId = Named.CorpusExportAPI $ \lId nt' -> get_corpus lId nt'
$
Corpus
{
_c_corpus
=
Map
.
elems
r
$
Corpus
{
_c_corpus
=
Map
.
elems
r
,
_c_hash
=
hash
$
List
.
map
DocumentExport
.
_d_hash
$
Map
.
elems
r
}
,
_c_hash
=
hash
$
List
.
map
DocumentExport
.
_d_hash
$
Map
.
elems
r
}
getContextNgrams
::
HasNodeError
err
=>
CorpusId
->
ListId
->
ListType
->
NgramsType
->
NodeListStory
->
DBCmdExtra
err
(
Map
ContextId
(
Set
NgramsTerm
))
getContextNgrams
cId
lId
listType
nt
repo
=
do
-- lId <- case lId' of
-- Nothing -> defaultList cId
-- Just l -> pure l
lIds
<-
selectNodesWithUsername
NodeList
userMaster
getCorpusSQLite
::
(
CES
.
MonadMask
m
,
IsGargServer
env
err
m
)
let
ngs
=
filterListWithRoot
[
listType
]
$
mapTermListRoot
[
lId
]
nt
repo
=>
CorpusId
-- TODO HashMap
->
Maybe
ListId
r
<-
getNgramsByContextOnlyUser
cId
(
lIds
<>
[
lId
])
nt
(
HashMap
.
keys
ngs
)
->
m
(
Headers
'[
H
eader
"Content-Disposition"
Text
]
CorpusSQLite
)
pure
r
getCorpusSQLite
cId
lId
=
do
corpusSQLiteData
<-
mkCorpusSQLiteData
cId
lId
corpusSQLite
<-
liftBase
$
mkCorpusSQLite
corpusSQLiteData
pure
$
addHeader
(
"attachment; filename=GarganText_corpus-"
<>
pack
(
show
cId
)
<>
".sqlite"
)
$
corpusSQLite
-- TODO
-- TODO
-- Exports List
-- Exports List
...
...
src/Gargantext/API/Node/Corpus/Export/Types.hs
View file @
f6897b2b
...
@@ -13,14 +13,21 @@ Portability : POSIX
...
@@ -13,14 +13,21 @@ Portability : POSIX
module
Gargantext.API.Node.Corpus.Export.Types
where
module
Gargantext.API.Node.Corpus.Export.Types
where
import
Data.
Aeson.TH
(
deriveJSON
)
import
Data.
ByteString.Lazy
qualified
as
BSL
import
Data.Swagger
(
ToSchema
(
..
),
genericDeclareNamedSchema
,
ToParamSchema
(
..
)
)
import
Data.Swagger
(
ToSchema
(
..
),
genericDeclareNamedSchema
,
ToParamSchema
(
..
)
,
NamedSchema
(
..
),
binarySchema
)
import
Data.T
ext
(
Text
)
import
Data.T
ime.Clock
(
UTCTime
)
import
GHC.Generics
(
Generic
)
import
Data.Version
(
Version
)
import
Gargantext.API.Node.Document.Export.Types
qualified
as
DocumentExport
import
Gargantext.API.Node.Document.Export.Types
qualified
as
DocumentExport
import
Gargantext.Core.Types
(
TODO
)
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
)
import
Gargantext.Core.Types
(
CorpusId
,
ListId
,
TODO
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
)
import
Servant
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataCorpus
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
)
import
Gargantext.Database.Admin.Types.Hyperdata.List
(
HyperdataList
)
import
Gargantext.Database.Admin.Types.Node
(
ContextId
,
NodeId
)
import
Gargantext.Prelude
import
Gargantext.Prelude.Crypto.Hash
qualified
as
H
import
Servant
(
Accept
(
..
),
MimeRender
(
mimeRender
),
MimeUnrender
(
mimeUnrender
),
OctetStream
)
-- Corpus Export
-- Corpus Export
...
@@ -37,3 +44,46 @@ instance ToSchema Corpus where
...
@@ -37,3 +44,46 @@ instance ToSchema Corpus where
instance
ToParamSchema
Corpus
where
instance
ToParamSchema
Corpus
where
toParamSchema
_
=
toParamSchema
(
Proxy
::
Proxy
TODO
)
toParamSchema
_
=
toParamSchema
(
Proxy
::
Proxy
TODO
)
$
(
deriveJSON
(
unPrefix
"_c_"
)
''
C
orpus
)
$
(
deriveJSON
(
unPrefix
"_c_"
)
''
C
orpus
)
-- | Wrapper around 'ByteString' to return an SQLite db containing
-- corpus
newtype
CorpusSQLite
=
CorpusSQLite
{
_cs_bs
::
BSL
.
ByteString
}
deriving
(
Generic
,
NFData
)
instance
Accept
CorpusSQLite
where
contentType
_
=
contentType
(
Proxy
::
Proxy
OctetStream
)
instance
MimeRender
OctetStream
CorpusSQLite
where
mimeRender
_
(
CorpusSQLite
bs
)
=
bs
-- | Needed for tests
instance
MimeUnrender
OctetStream
CorpusSQLite
where
mimeUnrender
_
bs
=
Right
$
CorpusSQLite
{
_cs_bs
=
bs
}
instance
ToSchema
CorpusSQLite
where
declareNamedSchema
_
=
pure
$
NamedSchema
(
Just
"CorpusSQLite"
)
binarySchema
-- | Contents of the SQLite export DB
-- (having such datatype makes it easier to coherently implement import/export)
data
CorpusSQLiteData
=
CorpusSQLiteData
{
_csd_version
::
Version
,
_csd_cId
::
CorpusId
,
_csd_lId
::
ListId
,
_csd_created
::
UTCTime
,
_csd_corpus_name
::
Text
,
_csd_corpus_hash
::
Maybe
H
.
Hash
,
_csd_corpus_parent
::
Maybe
NodeId
,
_csd_corpus_hyperdata
::
HyperdataCorpus
,
_csd_list_name
::
Text
,
_csd_list_parent
::
Maybe
NodeId
,
_csd_list_hyperdata
::
HyperdataList
,
_csd_contexts
::
[(
NodeId
,
Text
,
UTCTime
,
HyperdataDocument
)]
,
_csd_map_context_ngrams
::
Map
ContextId
(
Set
NgramsTerm
)
,
_csd_stop_context_ngrams
::
Map
ContextId
(
Set
NgramsTerm
)
,
_csd_candidate_context_ngrams
::
Map
ContextId
(
Set
NgramsTerm
)
}
deriving
(
Show
,
Eq
,
Generic
)
src/Gargantext/API/Node/Corpus/Export/Utils.hs
0 → 100644
View file @
f6897b2b
This diff is collapsed.
Click to expand it.
src/Gargantext/API/Node/Corpus/Searx.hs
View file @
f6897b2b
...
@@ -23,7 +23,7 @@ import Data.Tuple.Select (sel1, sel2, sel3)
...
@@ -23,7 +23,7 @@ import Data.Tuple.Select (sel1, sel2, sel3)
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core.Config
(
GargConfig
(
..
),
hasConfig
)
import
Gargantext.Core.Config
(
GargConfig
(
..
),
hasConfig
)
import
Gargantext.Core.Config.Types
(
FramesConfig
(
..
))
import
Gargantext.Core.Config.Types
(
FramesConfig
(
..
))
import
Gargantext.Core.NLP
(
HasNLPServer
,
nlpServerGet
)
import
Gargantext.Core.NLP
(
HasNLPServer
)
import
Gargantext.Core.NodeStory.Types
(
HasNodeStory
)
import
Gargantext.Core.NodeStory.Types
(
HasNodeStory
)
import
Gargantext.Core.Text.Corpus.Query
qualified
as
Query
import
Gargantext.Core.Text.Corpus.Query
qualified
as
Query
import
Gargantext.Core.Text.Terms
(
TermType
(
..
))
import
Gargantext.Core.Text.Terms
(
TermType
(
..
))
...
@@ -126,7 +126,6 @@ insertSearxResponse :: ( MonadBase IO m
...
@@ -126,7 +126,6 @@ insertSearxResponse :: ( MonadBase IO m
->
m
()
->
m
()
insertSearxResponse
_
_
_
_
(
Left
_
)
=
pure
()
insertSearxResponse
_
_
_
_
(
Left
_
)
=
pure
()
insertSearxResponse
user
cId
listId
l
(
Right
(
SearxResponse
{
_srs_results
}))
=
do
insertSearxResponse
user
cId
listId
l
(
Right
(
SearxResponse
{
_srs_results
}))
=
do
server
<-
view
(
nlpServerGet
l
)
-- docs :: [Either Text HyperdataDocument]
-- docs :: [Either Text HyperdataDocument]
let
docs
=
hyperdataDocumentFromSearxResult
l
<$>
_srs_results
let
docs
=
hyperdataDocumentFromSearxResult
l
<$>
_srs_results
--printDebug "[triggerSearxSearch] docs" docs
--printDebug "[triggerSearxSearch] docs" docs
...
@@ -141,7 +140,7 @@ insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) =
...
@@ -141,7 +140,7 @@ insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) =
-}
-}
--
_
<-
flowDataText
user
(
DataNew
[
docs'
])
(
Multi
l
)
cId
Nothing
logStatus
--
_
<-
flowDataText
user
(
DataNew
[
docs'
])
(
Multi
l
)
cId
Nothing
logStatus
let
mCorpus
=
Nothing
::
Maybe
HyperdataCorpus
let
mCorpus
=
Nothing
::
Maybe
HyperdataCorpus
void
$
addDocumentsToHyperCorpus
server
mCorpus
(
Multi
l
)
cId
docs'
void
$
addDocumentsToHyperCorpus
mCorpus
(
Multi
l
)
cId
docs'
_
<-
buildSocialList
l
user
cId
listId
mCorpus
Nothing
_
<-
buildSocialList
l
user
cId
listId
mCorpus
Nothing
...
...
src/Gargantext/API/Node/DocumentUpload.hs
View file @
f6897b2b
...
@@ -27,7 +27,7 @@ import Gargantext.API.Prelude ( GargM )
...
@@ -27,7 +27,7 @@ import Gargantext.API.Prelude ( GargM )
import
Gargantext.API.Routes.Named.Document
qualified
as
Named
import
Gargantext.API.Routes.Named.Document
qualified
as
Named
import
Gargantext.API.Worker
(
serveWorkerAPI
)
import
Gargantext.API.Worker
(
serveWorkerAPI
)
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core.NLP
(
nlpServerGet
,
HasNLPServer
)
import
Gargantext.Core.NLP
(
HasNLPServer
)
import
Gargantext.Core.NodeStory.Types
(
HasNodeStoryEnv
,
HasNodeArchiveStoryImmediateSaver
)
import
Gargantext.Core.NodeStory.Types
(
HasNodeStoryEnv
,
HasNodeArchiveStoryImmediateSaver
)
import
Gargantext.Core.Text.Corpus.Parsers.Date
(
mDateSplit
)
import
Gargantext.Core.Text.Corpus.Parsers.Date
(
mDateSplit
)
import
Gargantext.Core.Text.Terms
(
TermType
(
..
))
import
Gargantext.Core.Text.Terms
(
TermType
(
..
))
...
@@ -99,8 +99,7 @@ documentUpload nId doc = do
...
@@ -99,8 +99,7 @@ documentUpload nId doc = do
,
_hd_institutes_tree
=
Nothing
}
,
_hd_institutes_tree
=
Nothing
}
let
lang
=
EN
let
lang
=
EN
ncs
<-
view
$
nlpServerGet
lang
addDocumentsToHyperCorpus
(
Nothing
::
Maybe
HyperdataCorpus
)
(
Multi
lang
)
cId
[
hd
]
addDocumentsToHyperCorpus
ncs
(
Nothing
::
Maybe
HyperdataCorpus
)
(
Multi
lang
)
cId
[
hd
]
-- | Imports the documents contained into this 'DocumentExport' into this (local) version
-- | Imports the documents contained into this 'DocumentExport' into this (local) version
-- of the running node.
-- of the running node.
...
@@ -122,9 +121,8 @@ remoteImportDocuments :: ( HasNodeError err
...
@@ -122,9 +121,8 @@ remoteImportDocuments :: ( HasNodeError err
->
m
[
NodeId
]
->
m
[
NodeId
]
remoteImportDocuments
loggedInUser
corpusId
nodeId
WorkSplit
{
..
}
documents
=
do
remoteImportDocuments
loggedInUser
corpusId
nodeId
WorkSplit
{
..
}
documents
=
do
let
la
=
Multi
EN
let
la
=
Multi
EN
nlpServerConfig
<-
view
$
nlpServerGet
(
_tt_lang
la
)
$
(
logLocM
)
INFO
$
"Importing "
<>
T
.
pack
(
show
_ws_current
)
<>
"/"
<>
T
.
pack
(
show
_ws_total
)
<>
" documents for corpus node "
<>
T
.
pack
(
show
nodeId
)
$
(
logLocM
)
INFO
$
"Importing "
<>
T
.
pack
(
show
_ws_current
)
<>
"/"
<>
T
.
pack
(
show
_ws_total
)
<>
" documents for corpus node "
<>
T
.
pack
(
show
nodeId
)
docs
<-
addDocumentsToHyperCorpus
nlpServerConfig
(
Nothing
::
Maybe
HyperdataCorpus
)
la
corpusId
(
map
(
_node_hyperdata
.
_d_document
)
documents
)
docs
<-
addDocumentsToHyperCorpus
(
Nothing
::
Maybe
HyperdataCorpus
)
la
corpusId
(
map
(
_node_hyperdata
.
_d_document
)
documents
)
_versioned
<-
commitCorpus
corpusId
(
RootId
$
_auth_node_id
loggedInUser
)
_versioned
<-
commitCorpus
corpusId
(
RootId
$
_auth_node_id
loggedInUser
)
$
(
logLocM
)
INFO
$
"Done importing "
<>
T
.
pack
(
show
_ws_current
)
<>
"/"
<>
T
.
pack
(
show
_ws_total
)
<>
" documents for corpus node "
<>
T
.
pack
(
show
nodeId
)
$
(
logLocM
)
INFO
$
"Done importing "
<>
T
.
pack
(
show
_ws_current
)
<>
"/"
<>
T
.
pack
(
show
_ws_total
)
<>
" documents for corpus node "
<>
T
.
pack
(
show
nodeId
)
pure
docs
pure
docs
src/Gargantext/API/Routes/Named/Corpus.hs
View file @
f6897b2b
...
@@ -25,7 +25,7 @@ import Data.Aeson.TH (deriveJSON)
...
@@ -25,7 +25,7 @@ import Data.Aeson.TH (deriveJSON)
import
Data.Swagger
(
ToSchema
(
..
),
genericDeclareNamedSchema
)
import
Data.Swagger
(
ToSchema
(
..
),
genericDeclareNamedSchema
)
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
GHC.Generics
import
GHC.Generics
import
Gargantext.API.Node.Corpus.Export.Types
(
Corpus
)
import
Gargantext.API.Node.Corpus.Export.Types
(
Corpus
,
CorpusSQLite
)
import
Gargantext.API.Node.Types
(
NewWithForm
,
WithQuery
)
import
Gargantext.API.Node.Types
(
NewWithForm
,
WithQuery
)
import
Gargantext.API.Worker
(
WorkerAPI
)
import
Gargantext.API.Worker
(
WorkerAPI
)
import
Gargantext.Core.Text.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Core.Text.Ngrams
(
NgramsType
(
..
))
...
@@ -35,12 +35,16 @@ import Gargantext.Prelude (Bool)
...
@@ -35,12 +35,16 @@ import Gargantext.Prelude (Bool)
import
Servant
import
Servant
--------------------------------------------------
--------------------------------------------------
newtype
CorpusExportAPI
mode
=
CorpusExportAPI
data
CorpusExportAPI
mode
=
CorpusExportAPI
{
corpusExportEp
::
mode
:-
Summary
"Corpus Export"
{
corpusExportEp
::
mode
:-
Summary
"Corpus Export"
:>
"export"
:>
"export"
:>
QueryParam
"listId"
ListId
:>
QueryParam
"listId"
ListId
:>
QueryParam
"ngramsType"
NgramsType
:>
QueryParam
"ngramsType"
NgramsType
:>
Get
'[
J
SON
]
(
Headers
'[
S
ervant
.
Header
"Content-Disposition"
Text
]
Corpus
)
:>
Get
'[
J
SON
]
(
Headers
'[
S
ervant
.
Header
"Content-Disposition"
Text
]
Corpus
)
,
corpusSQLiteEp
::
mode
:-
Summary
"Corpus SQLite export"
:>
"sqlite"
:>
QueryParam
"listId"
ListId
:>
Get
'[
O
ctetStream
]
(
Headers
'[
S
ervant
.
Header
"Content-Disposition"
Text
]
CorpusSQLite
)
}
deriving
Generic
}
deriving
Generic
...
...
src/Gargantext/Core/Text/Corpus/API/Arxiv.hs
View file @
f6897b2b
...
@@ -9,8 +9,8 @@ Portability : POSIX
...
@@ -9,8 +9,8 @@ Portability : POSIX
-}
-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
module
Gargantext.Core.Text.Corpus.API.Arxiv
module
Gargantext.Core.Text.Corpus.API.Arxiv
(
get
(
get
...
@@ -18,7 +18,7 @@ module Gargantext.Core.Text.Corpus.API.Arxiv
...
@@ -18,7 +18,7 @@ module Gargantext.Core.Text.Corpus.API.Arxiv
,
convertQuery
,
convertQuery
)
where
)
where
import
Arxiv
qualified
as
Arxiv
import
Arxiv
qualified
import
Conduit
import
Conduit
import
Data.Text
qualified
as
Text
import
Data.Text
qualified
as
Text
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core
(
Lang
(
..
))
...
...
src/Gargantext/Core/Viz/Types.hs
View file @
f6897b2b
...
@@ -22,7 +22,7 @@ data Chart = ChartHisto | ChartScatter | ChartPie
...
@@ -22,7 +22,7 @@ data Chart = ChartHisto | ChartScatter | ChartPie
data
Histo
=
Histo
{
histo_dates
::
!
(
Vector
Text
)
data
Histo
=
Histo
{
histo_dates
::
!
(
Vector
Text
)
,
histo_count
::
!
(
Vector
Int
)
,
histo_count
::
!
(
Vector
Int
)
}
}
deriving
(
Show
,
Generic
)
deriving
(
Show
,
Generic
,
Eq
)
instance
ToSchema
Histo
where
instance
ToSchema
Histo
where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"histo_"
)
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"histo_"
)
...
...
src/Gargantext/Database/Action/Flow.hs
View file @
f6897b2b
...
@@ -64,7 +64,7 @@ import Data.Set qualified as Set
...
@@ -64,7 +64,7 @@ import Data.Set qualified as Set
import
Data.Text
qualified
as
T
import
Data.Text
qualified
as
T
import
Gargantext.API.Ngrams.Tools
(
getTermsWith
)
import
Gargantext.API.Ngrams.Tools
(
getTermsWith
)
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
)
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
)
import
Gargantext.Core
(
Lang
(
..
),
NLPServerConfig
,
withDefaultLanguage
)
import
Gargantext.Core
(
Lang
(
..
),
withDefaultLanguage
)
import
Gargantext.Core.Notifications.CentralExchange.Types
(
HasCentralExchangeNotification
(
ce_notify
),
CEMessage
(
..
))
import
Gargantext.Core.Notifications.CentralExchange.Types
(
HasCentralExchangeNotification
(
ce_notify
),
CEMessage
(
..
))
import
Gargantext.Core.Config
(
GargConfig
(
..
),
hasConfig
)
import
Gargantext.Core.Config
(
GargConfig
(
..
),
hasConfig
)
import
Gargantext.Core.Config.Types
(
APIsConfig
(
..
))
import
Gargantext.Core.Config.Types
(
APIsConfig
(
..
))
...
@@ -274,10 +274,9 @@ flow :: forall env err m a c.
...
@@ -274,10 +274,9 @@ flow :: forall env err m a c.
flow
c
mkCorpusUser
la
mfslw
(
count
,
docsC
)
jobHandle
=
do
flow
c
mkCorpusUser
la
mfslw
(
count
,
docsC
)
jobHandle
=
do
(
_userId
,
userCorpusId
,
listId
)
<-
createNodes
mkCorpusUser
c
(
_userId
,
userCorpusId
,
listId
)
<-
createNodes
mkCorpusUser
c
-- TODO if public insertMasterDocs else insertUserDocs
-- TODO if public insertMasterDocs else insertUserDocs
nlpServer
<-
view
$
nlpServerGet
(
_tt_lang
la
)
runConduit
$
zipSources
(
yieldMany
([
1
..
]
::
[
Int
]))
docsC
runConduit
$
zipSources
(
yieldMany
([
1
..
]
::
[
Int
]))
docsC
.|
CList
.
chunksOf
5
.|
CList
.
chunksOf
5
.|
mapM_C
(
addDocumentsWithProgress
nlpServer
userCorpusId
)
.|
mapM_C
(
addDocumentsWithProgress
userCorpusId
)
.|
sinkNull
.|
sinkNull
let
u
=
userFromMkCorpusUser
mkCorpusUser
let
u
=
userFromMkCorpusUser
mkCorpusUser
...
@@ -286,10 +285,10 @@ flow c mkCorpusUser la mfslw (count, docsC) jobHandle = do
...
@@ -286,10 +285,10 @@ flow c mkCorpusUser la mfslw (count, docsC) jobHandle = do
flowCorpusUser
(
la
^.
tt_lang
)
u
userCorpusId
listId
c
mfslw
flowCorpusUser
(
la
^.
tt_lang
)
u
userCorpusId
listId
c
mfslw
where
where
addDocumentsWithProgress
::
NLPServerConfig
->
CorpusId
->
[(
Int
,
a
)]
->
m
()
addDocumentsWithProgress
::
CorpusId
->
[(
Int
,
a
)]
->
m
()
addDocumentsWithProgress
nlpServer
userCorpusId
docsChunk
=
do
addDocumentsWithProgress
userCorpusId
docsChunk
=
do
$
(
logLocM
)
DEBUG
$
T
.
pack
$
"calling insertDoc, ([idx], mLength) = "
<>
show
(
fst
<$>
docsChunk
,
count
)
$
(
logLocM
)
DEBUG
$
T
.
pack
$
"calling insertDoc, ([idx], mLength) = "
<>
show
(
fst
<$>
docsChunk
,
count
)
docs
<-
addDocumentsToHyperCorpus
nlpServer
c
la
userCorpusId
(
map
snd
docsChunk
)
docs
<-
addDocumentsToHyperCorpus
c
la
userCorpusId
(
map
snd
docsChunk
)
markProgress
(
length
docs
)
jobHandle
markProgress
(
length
docs
)
jobHandle
...
@@ -297,17 +296,17 @@ flow c mkCorpusUser la mfslw (count, docsC) jobHandle = do
...
@@ -297,17 +296,17 @@ flow c mkCorpusUser la mfslw (count, docsC) jobHandle = do
-- the given documents to the corpus. Returns the Ids of the inserted documents.
-- the given documents to the corpus. Returns the Ids of the inserted documents.
addDocumentsToHyperCorpus
::
(
IsDBCmd
env
err
m
addDocumentsToHyperCorpus
::
(
IsDBCmd
env
err
m
,
HasNodeError
err
,
HasNodeError
err
,
HasNLPServer
env
,
FlowCorpus
document
,
FlowCorpus
document
,
MkCorpus
corpus
,
MkCorpus
corpus
)
)
=>
NLPServerConfig
=>
Maybe
corpus
->
Maybe
corpus
->
TermType
Lang
->
TermType
Lang
->
CorpusId
->
CorpusId
->
[
document
]
->
[
document
]
->
m
[
DocId
]
->
m
[
DocId
]
addDocumentsToHyperCorpus
ncs
mb_hyper
la
corpusId
docs
=
do
addDocumentsToHyperCorpus
mb_hyper
la
corpusId
docs
=
do
ids
<-
insertMasterDocs
ncs
mb_hyper
la
docs
ids
<-
insertMasterDocs
mb_hyper
la
docs
void
$
Doc
.
add
corpusId
(
map
nodeId2ContextId
ids
)
void
$
Doc
.
add
corpusId
(
map
nodeId2ContextId
ids
)
pure
ids
pure
ids
...
@@ -401,15 +400,16 @@ buildSocialList l user userCorpusId listId ctype mfslw = do
...
@@ -401,15 +400,16 @@ buildSocialList l user userCorpusId listId ctype mfslw = do
insertMasterDocs
::
(
IsDBCmd
env
err
m
insertMasterDocs
::
(
IsDBCmd
env
err
m
,
HasNodeError
err
,
HasNodeError
err
,
HasNLPServer
env
,
FlowCorpus
a
,
FlowCorpus
a
,
MkCorpus
c
,
MkCorpus
c
)
)
=>
NLPServerConfig
=>
Maybe
c
->
Maybe
c
->
TermType
Lang
->
TermType
Lang
->
[
a
]
->
[
a
]
->
m
[
DocId
]
->
m
[
DocId
]
insertMasterDocs
ncs
c
lang
hs
=
do
insertMasterDocs
c
lang
hs
=
do
nlpServer
<-
view
$
nlpServerGet
(
_tt_lang
lang
)
(
masterUserId
,
_
,
masterCorpusId
)
<-
getOrMkRootWithCorpus
MkCorpusUserMaster
c
(
masterUserId
,
_
,
masterCorpusId
)
<-
getOrMkRootWithCorpus
MkCorpusUserMaster
c
(
ids'
,
documentsWithId
)
<-
insertDocs
masterUserId
masterCorpusId
(
map
(
toNode
masterUserId
Nothing
)
hs
)
(
ids'
,
documentsWithId
)
<-
insertDocs
masterUserId
masterCorpusId
(
map
(
toNode
masterUserId
Nothing
)
hs
)
_
<-
Doc
.
add
masterCorpusId
ids'
_
<-
Doc
.
add
masterCorpusId
ids'
...
@@ -421,7 +421,7 @@ insertMasterDocs ncs c lang hs = do
...
@@ -421,7 +421,7 @@ insertMasterDocs ncs c lang hs = do
mapNgramsDocs'
::
HashMap
.
HashMap
ExtractedNgrams
(
Map
NgramsType
(
Map
NodeId
(
TermsWeight
,
TermsCount
)))
mapNgramsDocs'
::
HashMap
.
HashMap
ExtractedNgrams
(
Map
NgramsType
(
Map
NodeId
(
TermsWeight
,
TermsCount
)))
<-
mapNodeIdNgrams
<-
mapNodeIdNgrams
<$>
documentIdWithNgrams
<$>
documentIdWithNgrams
(
extractNgramsT
n
cs
$
withLang
lang
documentsWithId
)
(
extractNgramsT
n
lpServer
$
withLang
lang
documentsWithId
)
(
map
(
B
.
first
contextId2NodeId
)
documentsWithId
)
(
map
(
B
.
first
contextId2NodeId
)
documentsWithId
)
lId
<-
getOrMkList
masterCorpusId
masterUserId
lId
<-
getOrMkList
masterCorpusId
masterUserId
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs
View file @
f6897b2b
...
@@ -28,7 +28,7 @@ data HyperdataCorpus =
...
@@ -28,7 +28,7 @@ data HyperdataCorpus =
-- 'defaultLanguage' if we don't know which language it is.
-- 'defaultLanguage' if we don't know which language it is.
,
_hc_lang
::
Maybe
Lang
,
_hc_lang
::
Maybe
Lang
}
}
deriving
(
Generic
,
Show
)
deriving
(
Generic
,
Eq
,
Show
)
defaultHyperdataCorpus
::
HyperdataCorpus
defaultHyperdataCorpus
::
HyperdataCorpus
defaultHyperdataCorpus
=
defaultHyperdataCorpus
=
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/CorpusField.hs
View file @
f6897b2b
...
@@ -34,7 +34,7 @@ data CorpusField = MarkdownField { _cf_text :: !Text }
...
@@ -34,7 +34,7 @@ data CorpusField = MarkdownField { _cf_text :: !Text }
,
_cf_authors
::
!
Text
,
_cf_authors
::
!
Text
-- , _cf_resources :: ![Resource]
-- , _cf_resources :: ![Resource]
}
}
deriving
(
Show
,
Generic
)
deriving
(
Show
,
Generic
,
Eq
)
defaultCorpusField
::
CorpusField
defaultCorpusField
::
CorpusField
defaultCorpusField
=
MarkdownField
"# Title"
defaultCorpusField
=
MarkdownField
"# Title"
...
@@ -56,7 +56,7 @@ data HyperdataField a =
...
@@ -56,7 +56,7 @@ data HyperdataField a =
HyperdataField
{
_hf_type
::
!
CodeType
HyperdataField
{
_hf_type
::
!
CodeType
,
_hf_name
::
!
Text
,
_hf_name
::
!
Text
,
_hf_data
::
!
a
,
_hf_data
::
!
a
}
deriving
(
Generic
,
Show
)
}
deriving
(
Generic
,
Show
,
Eq
)
defaultHyperdataField
::
HyperdataField
CorpusField
defaultHyperdataField
::
HyperdataField
CorpusField
defaultHyperdataField
=
HyperdataField
Markdown
"name"
defaultCorpusField
defaultHyperdataField
=
HyperdataField
Markdown
"name"
defaultCorpusField
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/List.hs
View file @
f6897b2b
...
@@ -34,7 +34,7 @@ data HyperdataList =
...
@@ -34,7 +34,7 @@ data HyperdataList =
,
_hl_pie
::
!
(
HashMap
TabType
(
ChartMetrics
Histo
))
,
_hl_pie
::
!
(
HashMap
TabType
(
ChartMetrics
Histo
))
,
_hl_scatter
::
!
(
HashMap
TabType
Metrics
)
,
_hl_scatter
::
!
(
HashMap
TabType
Metrics
)
,
_hl_tree
::
!
(
HashMap
TabType
(
ChartMetrics
(
Vector
NgramsTree
)))
,
_hl_tree
::
!
(
HashMap
TabType
(
ChartMetrics
(
Vector
NgramsTree
)))
}
deriving
(
Show
,
Generic
)
}
deriving
(
Show
,
Generic
,
Eq
)
-- HyperdataList { _hl_chart :: !(Maybe (ChartMetrics Histo))
-- HyperdataList { _hl_chart :: !(Maybe (ChartMetrics Histo))
-- , _hl_list :: !(Maybe Text)
-- , _hl_list :: !(Maybe Text)
-- , _hl_pie :: !(Maybe (ChartMetrics Histo))
-- , _hl_pie :: !(Maybe (ChartMetrics Histo))
...
...
src/Gargantext/Database/Admin/Types/Metrics.hs
View file @
f6897b2b
...
@@ -25,7 +25,7 @@ import Test.QuickCheck.Arbitrary
...
@@ -25,7 +25,7 @@ import Test.QuickCheck.Arbitrary
newtype
Metrics
=
Metrics
newtype
Metrics
=
Metrics
{
metrics_data
::
Vector
Metric
}
{
metrics_data
::
Vector
Metric
}
deriving
(
Generic
,
Show
)
deriving
(
Generic
,
Show
,
Eq
)
instance
ToSchema
Metrics
where
instance
ToSchema
Metrics
where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"metrics_"
)
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"metrics_"
)
...
@@ -38,7 +38,7 @@ data Metric = Metric
...
@@ -38,7 +38,7 @@ data Metric = Metric
,
m_x
::
!
Double
,
m_x
::
!
Double
,
m_y
::
!
Double
,
m_y
::
!
Double
,
m_cat
::
!
ListType
,
m_cat
::
!
ListType
}
deriving
(
Generic
,
Show
)
}
deriving
(
Generic
,
Show
,
Eq
)
instance
ToSchema
Metric
where
instance
ToSchema
Metric
where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"m_"
)
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"m_"
)
...
@@ -54,7 +54,7 @@ deriveJSON (unPrefix "metrics_") ''Metrics
...
@@ -54,7 +54,7 @@ deriveJSON (unPrefix "metrics_") ''Metrics
newtype
ChartMetrics
a
=
ChartMetrics
{
chartMetrics_data
::
a
}
newtype
ChartMetrics
a
=
ChartMetrics
{
chartMetrics_data
::
a
}
deriving
(
Generic
,
Show
)
deriving
(
Generic
,
Show
,
Eq
)
instance
(
Typeable
a
,
ToSchema
a
)
=>
ToSchema
(
ChartMetrics
a
)
where
instance
(
Typeable
a
,
ToSchema
a
)
=>
ToSchema
(
ChartMetrics
a
)
where
declareNamedSchema
=
wellNamedSchema
"chartMetrics_"
declareNamedSchema
=
wellNamedSchema
"chartMetrics_"
...
...
src/Gargantext/Database/Query/Table/Node.hs
View file @
f6897b2b
...
@@ -307,6 +307,7 @@ selectNodesIdWithType nt = proc () -> do
...
@@ -307,6 +307,7 @@ selectNodesIdWithType nt = proc () -> do
restrict
-<
tn
.==
(
sqlInt4
$
toDBid
nt
)
restrict
-<
tn
.==
(
sqlInt4
$
toDBid
nt
)
returnA
-<
_node_id
row
returnA
-<
_node_id
row
-- | Get node, Hyperdata is 'Aeson.Value'
getNode
::
HasNodeError
err
=>
NodeId
->
DBCmd
err
(
Node
Value
)
getNode
::
HasNodeError
err
=>
NodeId
->
DBCmd
err
(
Node
Value
)
getNode
nId
=
do
getNode
nId
=
do
maybeNode
<-
headMay
<$>
runOpaQuery
(
selectNode
(
pgNodeId
nId
))
maybeNode
<-
headMay
<$>
runOpaQuery
(
selectNode
(
pgNodeId
nId
))
...
...
stack.yaml
View file @
f6897b2b
...
@@ -273,6 +273,10 @@ flags:
...
@@ -273,6 +273,10 @@ flags:
tagged
:
true
tagged
:
true
bitvec
:
bitvec
:
simd
:
true
simd
:
true
"
blaze-textual"
:
developer
:
false
"
integer-simple"
:
false
native
:
true
boring
:
boring
:
tagged
:
true
tagged
:
true
"
bytestring-builder"
:
"
bytestring-builder"
:
...
@@ -338,6 +342,14 @@ flags:
...
@@ -338,6 +342,14 @@ flags:
have_strong_getauxval
:
false
have_strong_getauxval
:
false
have_weak_getauxval
:
false
have_weak_getauxval
:
false
"
pkg-config"
:
true
"
pkg-config"
:
true
"
direct-sqlite"
:
dbstat
:
true
fulltextsearch
:
true
haveusleep
:
true
json1
:
true
mathfunctions
:
false
systemlib
:
false
urifilenames
:
true
distributive
:
distributive
:
semigroups
:
true
semigroups
:
true
tagged
:
true
tagged
:
true
...
...
test/Test/API.hs
View file @
f6897b2b
...
@@ -5,6 +5,7 @@ import Prelude
...
@@ -5,6 +5,7 @@ import Prelude
import
Test.Hspec
import
Test.Hspec
import
qualified
Test.API.Authentication
as
Auth
import
qualified
Test.API.Authentication
as
Auth
import
qualified
Test.API.Errors
as
Errors
import
qualified
Test.API.Errors
as
Errors
import
qualified
Test.API.Export
as
Export
import
qualified
Test.API.GraphQL
as
GraphQL
import
qualified
Test.API.GraphQL
as
GraphQL
import
qualified
Test.API.Notifications
as
Notifications
import
qualified
Test.API.Notifications
as
Notifications
import
qualified
Test.API.Private
as
Private
import
qualified
Test.API.Private
as
Private
...
@@ -17,6 +18,7 @@ tests = describe "Gargantext API" $ do
...
@@ -17,6 +18,7 @@ tests = describe "Gargantext API" $ do
Private
.
tests
Private
.
tests
GraphQL
.
tests
GraphQL
.
tests
Errors
.
tests
Errors
.
tests
Export
.
tests
UpdateList
.
tests
UpdateList
.
tests
Notifications
.
tests
Notifications
.
tests
Worker
.
tests
Worker
.
tests
test/Test/API/Export.hs
0 → 100644
View file @
f6897b2b
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module
Test.API.Export
(
tests
)
where
import
Data.ByteString.Lazy
qualified
as
BSL
import
Data.Version
(
showVersion
)
import
Database.SQLite.Simple
qualified
as
S
-- import Fmt (build)
import
Gargantext.API.Node.Corpus.Export.Types
(
CorpusSQLite
(
..
),
CorpusSQLiteData
(
..
))
import
Gargantext.API.Node.Corpus.Export.Utils
(
withTempSQLiteDir
,
mkCorpusSQLiteData
)
import
Gargantext.Core
(
Lang
(
EN
))
import
Gargantext.Core.Text.Terms
(
TermType
(
Multi
))
import
Gargantext.Core.Types
(
unNodeId
)
import
Gargantext.Core.Types.Individu
import
Gargantext.Database.Action.Flow
(
addDocumentsToHyperCorpus
)
import
Gargantext.Database.Action.User
(
getUserId
)
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataCorpus
)
import
Gargantext.Database.Admin.Types.Node
(
NodeType
(
NodeFolder
,
NodeCorpus
,
NodeFolderPrivate
))
import
Gargantext.Database.Query.Table.Node
(
getOrMkList
,
getNodeWith
,
insertDefaultNode
,
insertNode
)
import
Gargantext.Database.Query.Tree.Root
(
getRootId
)
import
Gargantext.Database.Schema.Node
(
node_hyperdata
)
import
Gargantext.Prelude
hiding
(
get
)
import
Paths_gargantext
qualified
as
PG
-- cabal magic build module
import
Servant.API.ResponseHeaders
(
Headers
(
getResponse
))
import
Servant.Auth.Client
()
import
Servant.Client.Streaming
(
runClientM
)
import
Test.API.Prelude
(
checkEither
)
import
Test.API.Routes
(
get_corpus_sqlite_export
)
import
Test.API.Setup
(
withTestDBAndPort
,
dbEnvSetup
,
SpecContext
(
..
))
import
Test.API.UpdateList
(
createFortranDocsList
)
import
Test.Database.Operations.DocumentSearch
(
exampleDocument_01
,
exampleDocument_02
)
import
Test.Database.Types
(
runTestMonad
)
import
Test.Hspec
import
Test.Hspec.Wai.Internal
(
withApplication
)
import
Test.Utils
(
withValidLogin
)
tests
::
Spec
tests
=
sequential
$
around
withTestDBAndPort
$
beforeWith
dbEnvSetup
$
do
describe
"Export API"
$
do
describe
"Check CorpusSQLiteData creation"
$
do
it
"correctly creates CorpusSQLiteData"
$
\
ctx
->
do
flip
runReaderT
(
_sctx_env
ctx
)
$
runTestMonad
$
do
aliceUserId
<-
getUserId
(
UserName
"alice"
)
aliceRootId
<-
getRootId
(
UserName
"alice"
)
alicePrivateFolderId
<-
insertNode
NodeFolderPrivate
(
Just
"NodeFolderPrivate"
)
Nothing
aliceRootId
aliceUserId
aliceFolderId
<-
insertDefaultNode
NodeFolder
alicePrivateFolderId
aliceUserId
corpusId
<-
insertDefaultNode
NodeCorpus
aliceFolderId
aliceUserId
aliceListId
<-
getOrMkList
corpusId
aliceUserId
corpus
<-
getNodeWith
corpusId
(
Proxy
@
HyperdataCorpus
)
let
docs
=
[
exampleDocument_01
,
exampleDocument_02
]
let
lang
=
EN
_
<-
addDocumentsToHyperCorpus
(
Just
$
corpus
^.
node_hyperdata
)
(
Multi
lang
)
corpusId
docs
(
CorpusSQLiteData
{
..
})
<-
mkCorpusSQLiteData
corpusId
Nothing
liftIO
$
do
_csd_version
`
shouldBe
`
PG
.
version
_csd_cId
`
shouldBe
`
corpusId
_csd_lId
`
shouldBe
`
aliceListId
length
_csd_contexts
`
shouldBe
`
2
length
_csd_map_context_ngrams
`
shouldBe
`
0
length
_csd_stop_context_ngrams
`
shouldBe
`
0
length
_csd_candidate_context_ngrams
`
shouldBe
`
0
describe
"GET /api/v1.0/corpus/cId/sqlite"
$
do
it
"returns correct SQLite db"
$
\
ctx
->
do
let
port
=
_sctx_port
ctx
withApplication
(
_sctx_app
ctx
)
$
do
withValidLogin
port
"alice"
(
GargPassword
"alice"
)
$
\
clientEnv
token
->
do
cId
<-
createFortranDocsList
(
_sctx_env
ctx
)
port
clientEnv
token
void
$
liftIO
$
do
(
CorpusSQLite
{
_cs_bs
})
<-
(
checkEither
$
runClientM
(
get_corpus_sqlite_export
token
cId
)
clientEnv
)
>>=
(
pure
.
getResponse
)
withTempSQLiteDir
$
\
(
_fp
,
_fname
,
fpath
)
->
do
BSL
.
writeFile
fpath
_cs_bs
S
.
withConnection
fpath
$
\
conn
->
do
[
S
.
Only
cId'
]
<-
S
.
query_
conn
"SELECT value FROM info WHERE key = 'corpusId'"
cId'
`
shouldBe
`
unNodeId
cId
-- [S.Only lId'] <- S.query_ conn "SELECT value FROM info WHERE key = 'listId'"
-- lId' `shouldBe` unNodeId listId
[
S
.
Only
version
]
<-
S
.
query_
conn
"SELECT value FROM info WHERE key = 'gargVersion'"
version
`
shouldBe
`
showVersion
PG
.
version
[
S
.
Only
corpoLen
]
<-
S
.
query
conn
"SELECT COUNT(*) FROM corpus WHERE id = ?"
(
S
.
Only
$
unNodeId
cId
)
corpoLen
`
shouldBe
`
(
1
::
Int
)
-- [S.Only listLen] <- S.query conn "SELECT COUNT(*) FROM lists WHERE id = ?" (S.Only $ unNodeId listId)
-- listLen `shouldBe` (1 :: Int)
[
S
.
Only
ngramsLen
]
<-
S
.
query_
conn
"SELECT COUNT(*) FROM ngrams"
ngramsLen
`
shouldBe
`
(
0
::
Int
)
[
S
.
Only
docsLen
]
<-
S
.
query_
conn
"SELECT COUNT(*) FROM documents"
docsLen
`
shouldBe
`
(
2
::
Int
)
test/Test/API/Prelude.hs
View file @
f6897b2b
...
@@ -20,7 +20,7 @@ import Gargantext.Core.Types (NodeId, NodeType(..))
...
@@ -20,7 +20,7 @@ import Gargantext.Core.Types (NodeId, NodeType(..))
import
Gargantext.Core.Worker.Env
()
-- instance HasNodeError
import
Gargantext.Core.Worker.Env
()
-- instance HasNodeError
import
Gargantext.Database.Action.User
import
Gargantext.Database.Action.User
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node
(
insertNode
,
mk
,
getUserRootPublicNode
,
getUserRootPrivateNode
)
import
Gargantext.Database.Query.Table.Node.User
(
getUserByName
)
import
Gargantext.Database.Query.Table.Node.User
(
getUserByName
)
import
Gargantext.Database.Query.Tree.Root
import
Gargantext.Database.Query.Tree.Root
import
Gargantext.Database.Schema.Node
(
_node_id
)
import
Gargantext.Database.Schema.Node
(
_node_id
)
...
...
test/Test/API/Routes.hs
View file @
f6897b2b
...
@@ -28,6 +28,7 @@ module Test.API.Routes (
...
@@ -28,6 +28,7 @@ module Test.API.Routes (
,
delete_node
,
delete_node
,
add_form_to_list
,
add_form_to_list
,
add_tsv_to_list
,
add_tsv_to_list
,
get_corpus_sqlite_export
)
where
)
where
import
Data.Text.Encoding
qualified
as
TE
import
Data.Text.Encoding
qualified
as
TE
...
@@ -37,13 +38,14 @@ import Gargantext.API.Errors
...
@@ -37,13 +38,14 @@ import Gargantext.API.Errors
import
Gargantext.API.HashedResponse
(
HashedResponse
)
import
Gargantext.API.HashedResponse
(
HashedResponse
)
import
Gargantext.API.Ngrams.List.Types
(
WithJsonFile
,
WithTextFile
)
import
Gargantext.API.Ngrams.List.Types
(
WithJsonFile
,
WithTextFile
)
import
Gargantext.API.Ngrams.Types
(
NgramsTable
,
NgramsTablePatch
,
OrderBy
,
TabType
,
Versioned
,
VersionedWithCount
)
import
Gargantext.API.Ngrams.Types
(
NgramsTable
,
NgramsTablePatch
,
OrderBy
,
TabType
,
Versioned
,
VersionedWithCount
)
import
Gargantext.API.Node.Corpus.Export.Types
(
CorpusSQLite
)
import
Gargantext.API.Routes.Client
import
Gargantext.API.Routes.Client
import
Gargantext.API.Routes.Named
import
Gargantext.API.Routes.Named
import
Gargantext.API.Routes.Named.Corpus
(
CorpusExportAPI
(
corpusSQLiteEp
))
import
Gargantext.API.Routes.Named.List
(
updateListJSONEp
,
updateListTSVEp
)
import
Gargantext.API.Routes.Named.List
(
updateListJSONEp
,
updateListTSVEp
)
import
Gargantext.API.Routes.Named.Node
hiding
(
treeAPI
)
import
Gargantext.API.Routes.Named.Node
hiding
(
treeAPI
)
import
Gargantext.API.Routes.Named.Private
hiding
(
tableNgramsAPI
)
import
Gargantext.API.Routes.Named.Private
hiding
(
tableNgramsAPI
)
import
Gargantext.API.Routes.Named.Publish
(
PublishAPI
(
..
))
import
Gargantext.API.Routes.Named.Publish
(
PublishAPI
(
..
),
PublishRequest
(
..
))
import
Gargantext.API.Routes.Named.Publish
(
PublishRequest
(
..
))
import
Gargantext.API.Routes.Named.Table
import
Gargantext.API.Routes.Named.Table
import
Gargantext.API.Routes.Named.Tree
(
nodeTreeEp
)
import
Gargantext.API.Routes.Named.Tree
(
nodeTreeEp
)
import
Gargantext.API.Types
()
-- MimeUnrender instances
import
Gargantext.API.Types
()
-- MimeUnrender instances
...
@@ -57,6 +59,7 @@ import Gargantext.Database.Query.Facet qualified as Facet
...
@@ -57,6 +59,7 @@ import Gargantext.Database.Query.Facet qualified as Facet
import
Gargantext.Database.Query.Table.NodeNode
(
SourceId
(
..
),
TargetId
(
..
))
import
Gargantext.Database.Query.Table.NodeNode
(
SourceId
(
..
),
TargetId
(
..
))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Network.Wai.Handler.Warp
(
Port
)
import
Network.Wai.Handler.Warp
(
Port
)
import
Servant
(
Headers
,
Header
)
import
Servant.Auth.Client
qualified
as
S
import
Servant.Auth.Client
qualified
as
S
import
Servant.Client.Streaming
import
Servant.Client.Streaming
import
Servant.Conduit
()
import
Servant.Conduit
()
...
@@ -337,3 +340,22 @@ publish_node (toServantToken -> token) sourceId policy = fmap UnsafeMkNodeId $
...
@@ -337,3 +340,22 @@ publish_node (toServantToken -> token) sourceId policy = fmap UnsafeMkNodeId $
&
publishAPI
&
publishAPI
&
publishEp
&
publishEp
&
(
$
PublishRequest
policy
)
&
(
$
PublishRequest
policy
)
get_corpus_sqlite_export
::
Token
->
CorpusId
->
ClientM
(
Headers
'[
H
eader
"Content-Disposition"
Text
]
CorpusSQLite
)
get_corpus_sqlite_export
(
toServantToken
->
token
)
cId
=
clientRoutes
&
apiWithCustomErrorScheme
&
(
$
GES_new
)
&
backendAPI
&
backendAPI'
&
mkBackEndAPI
&
gargAPIVersion
&
gargPrivateAPI
&
mkPrivateAPI
&
(
$
token
)
&
corpusExportAPI
&
(
$
cId
)
&
corpusSQLiteEp
&
(
$
Nothing
)
-- Maybe ListId
test/Test/API/UpdateList.hs
View file @
f6897b2b
...
@@ -23,6 +23,7 @@ module Test.API.UpdateList (
...
@@ -23,6 +23,7 @@ module Test.API.UpdateList (
,
JobPollHandle
(
..
)
,
JobPollHandle
(
..
)
,
updateNode
,
updateNode
,
createDocsList
,
createDocsList
,
createFortranDocsList
)
where
)
where
import
Control.Lens
(
mapped
,
over
)
import
Control.Lens
(
mapped
,
over
)
...
...
test/Test/Database/Operations/DocumentSearch.hs
View file @
f6897b2b
...
@@ -12,15 +12,11 @@ Portability : POSIX
...
@@ -12,15 +12,11 @@ Portability : POSIX
module
Test.Database.Operations.DocumentSearch
where
module
Test.Database.Operations.DocumentSearch
where
-- import Gargantext.API.Node.Update (updateDocs)
-- import Network.URI (parseURI)
import
Control.Lens
(
view
)
import
Control.Monad.Reader
import
Control.Monad.Reader
import
Data.Aeson.QQ.Simple
import
Data.Aeson.QQ.Simple
import
Data.Aeson.Types
import
Data.Aeson.Types
import
Data.Text
qualified
as
T
import
Data.Text
qualified
as
T
import
Gargantext.Core
import
Gargantext.Core
import
Gargantext.Core.NLP
(
nlpServerGet
)
import
Gargantext.Core.Text.Corpus.Query
qualified
as
API
import
Gargantext.Core.Text.Corpus.Query
qualified
as
API
import
Gargantext.Core.Text.Terms.Mono.Stem
import
Gargantext.Core.Text.Terms.Mono.Stem
import
Gargantext.Core.Types.Individu
import
Gargantext.Core.Types.Individu
...
@@ -122,9 +118,7 @@ addCorpusDocuments env = flip runReaderT env $ runTestMonad $ do
...
@@ -122,9 +118,7 @@ addCorpusDocuments env = flip runReaderT env $ runTestMonad $ do
let
lang
=
EN
let
lang
=
EN
let
docs
=
[
exampleDocument_01
,
exampleDocument_02
,
exampleDocument_03
,
exampleDocument_04
]
let
docs
=
[
exampleDocument_01
,
exampleDocument_02
,
exampleDocument_03
,
exampleDocument_04
]
server
<-
view
(
nlpServerGet
lang
)
_
<-
addDocumentsToHyperCorpus
(
Just
$
_node_hyperdata
$
corpus
)
_
<-
addDocumentsToHyperCorpus
server
(
Just
$
_node_hyperdata
$
corpus
)
(
Multi
lang
)
(
Multi
lang
)
corpusId
corpusId
docs
docs
...
...
test/Test/Database/Operations/PublishNode.hs
View file @
f6897b2b
...
@@ -8,9 +8,6 @@ Stability : experimental
...
@@ -8,9 +8,6 @@ Stability : experimental
Portability : POSIX
Portability : POSIX
-}
-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
module
Test.Database.Operations.PublishNode
where
module
Test.Database.Operations.PublishNode
where
import
Prelude
import
Prelude
...
...
test/Test/Database/Types.hs
View file @
f6897b2b
...
@@ -70,6 +70,9 @@ newtype TestMonad a = TestMonad { runTestMonad :: ReaderT TestEnv IO a }
...
@@ -70,6 +70,9 @@ newtype TestMonad a = TestMonad { runTestMonad :: ReaderT TestEnv IO a }
,
MonadBaseControl
IO
,
MonadBaseControl
IO
,
MonadFail
,
MonadFail
,
MonadIO
,
MonadIO
,
MonadMask
,
MonadCatch
,
MonadThrow
)
)
data
TestJobHandle
=
TestNoJobHandle
data
TestJobHandle
=
TestNoJobHandle
...
...
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