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
148
Issues
148
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
a2e7a40c
Verified
Commit
a2e7a40c
authored
Oct 11, 2023
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[refactor] some more Cmd refactoring + test fixes
parent
2ed7d1de
Pipeline
#5243
passed with stages
in 57 minutes and 29 seconds
Changes
7
Pipelines
1
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
105 additions
and
116 deletions
+105
-116
Metrics.hs
src/Gargantext/API/Metrics.hs
+19
-19
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+50
-53
Prelude.hs
src/Gargantext/API/Ngrams/Prelude.hs
+1
-1
Export.hs
src/Gargantext/API/Node/Corpus/Export.hs
+11
-12
Searx.hs
src/Gargantext/API/Node/Corpus/Searx.hs
+8
-13
API.hs
src/Gargantext/Core/Viz/Graph/API.hs
+15
-18
Types.hs
test/Test/Database/Types.hs
+1
-0
No files found.
src/Gargantext/API/Metrics.hs
View file @
a2e7a40c
...
@@ -185,12 +185,12 @@ getChart cId _start _end maybeListId tabType = do
...
@@ -185,12 +185,12 @@ getChart cId _start _end maybeListId tabType = do
pure
$
constructHashedResponse
chart
pure
$
constructHashedResponse
chart
updateChart
::
HasNodeError
err
=>
updateChart
::
HasNodeError
err
CorpusId
=>
CorpusId
->
Maybe
ListId
->
Maybe
ListId
->
TabType
->
TabType
->
Maybe
Limit
->
Maybe
Limit
->
DBCmd
err
()
->
DBCmd
err
()
updateChart
cId
maybeListId
tabType
maybeLimit
=
do
updateChart
cId
maybeListId
tabType
maybeLimit
=
do
listId
<-
case
maybeListId
of
listId
<-
case
maybeListId
of
Just
lid
->
pure
lid
Just
lid
->
pure
lid
...
@@ -202,12 +202,12 @@ updateChart cId maybeListId tabType maybeLimit = do
...
@@ -202,12 +202,12 @@ updateChart cId maybeListId tabType maybeLimit = do
_
<-
updateChart'
cId
listId
tabType
maybeLimit
_
<-
updateChart'
cId
listId
tabType
maybeLimit
pure
()
pure
()
updateChart'
::
HasNodeError
err
=>
updateChart'
::
HasNodeError
err
CorpusId
=>
CorpusId
->
ListId
->
ListId
->
TabType
->
TabType
->
Maybe
Limit
->
Maybe
Limit
->
DBCmd
err
(
ChartMetrics
Histo
)
->
DBCmd
err
(
ChartMetrics
Histo
)
updateChart'
cId
listId
tabType
_maybeLimit
=
do
updateChart'
cId
listId
tabType
_maybeLimit
=
do
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
hl
=
node
^.
node_hyperdata
let
hl
=
node
^.
node_hyperdata
...
@@ -267,7 +267,7 @@ getPie cId _start _end maybeListId tabType = do
...
@@ -267,7 +267,7 @@ getPie cId _start _end maybeListId tabType = do
chart
<-
case
mChart
of
chart
<-
case
mChart
of
Just
chart
->
pure
chart
Just
chart
->
pure
chart
Nothing
->
do
Nothing
->
do
updatePie'
cId
maybeL
istId
tabType
Nothing
updatePie'
cId
l
istId
tabType
Nothing
pure
$
constructHashedResponse
chart
pure
$
constructHashedResponse
chart
...
@@ -278,23 +278,23 @@ updatePie :: HasNodeStory env err m
...
@@ -278,23 +278,23 @@ updatePie :: HasNodeStory env err m
->
Maybe
Limit
->
Maybe
Limit
->
m
()
->
m
()
updatePie
cId
maybeListId
tabType
maybeLimit
=
do
updatePie
cId
maybeListId
tabType
maybeLimit
=
do
listId
<-
case
maybeListId
of
Just
lid
->
pure
lid
Nothing
->
defaultList
cId
printDebug
"[updatePie] cId"
cId
printDebug
"[updatePie] cId"
cId
printDebug
"[updatePie] maybeListId"
maybeListId
printDebug
"[updatePie] maybeListId"
maybeListId
printDebug
"[updatePie] tabType"
tabType
printDebug
"[updatePie] tabType"
tabType
printDebug
"[updatePie] maybeLimit"
maybeLimit
printDebug
"[updatePie] maybeLimit"
maybeLimit
_
<-
updatePie'
cId
maybeL
istId
tabType
maybeLimit
_
<-
updatePie'
cId
l
istId
tabType
maybeLimit
pure
()
pure
()
updatePie'
::
(
HasNodeStory
env
err
m
,
HasNodeError
err
)
updatePie'
::
(
HasNodeStory
env
err
m
,
HasNodeError
err
)
=>
CorpusId
=>
CorpusId
->
Maybe
ListId
->
ListId
->
TabType
->
TabType
->
Maybe
Limit
->
Maybe
Limit
->
m
(
ChartMetrics
Histo
)
->
m
(
ChartMetrics
Histo
)
updatePie'
cId
maybeListId
tabType
_maybeLimit
=
do
updatePie'
cId
listId
tabType
_maybeLimit
=
do
listId
<-
case
maybeListId
of
Just
lid
->
pure
lid
Nothing
->
defaultList
cId
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
hl
=
node
^.
node_hyperdata
let
hl
=
node
^.
node_hyperdata
pieMap
=
hl
^.
hl_pie
pieMap
=
hl
^.
hl_pie
...
...
src/Gargantext/API/Ngrams.hs
View file @
a2e7a40c
This diff is collapsed.
Click to expand it.
src/Gargantext/API/Ngrams/Prelude.hs
View file @
a2e7a40c
...
@@ -36,7 +36,7 @@ import qualified Data.Text as Text
...
@@ -36,7 +36,7 @@ import qualified Data.Text as Text
------------------------------------------------------------------------
------------------------------------------------------------------------
getNgramsList
::
HasNodeStory
env
err
m
getNgramsList
::
HasNodeStory
env
err
m
=>
ListId
->
m
NgramsList
=>
ListId
->
m
NgramsList
getNgramsList
lId
=
fromList
getNgramsList
lId
=
fromList
<$>
zip
ngramsTypes
<$>
zip
ngramsTypes
<$>
mapM
(
getNgramsTableMap
lId
)
ngramsTypes
<$>
mapM
(
getNgramsTableMap
lId
)
ngramsTypes
...
...
src/Gargantext/API/Node/Corpus/Export.hs
View file @
a2e7a40c
...
@@ -16,24 +16,21 @@ Main exports of Gargantext:
...
@@ -16,24 +16,21 @@ 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
Data.List
qualified
as
List
import
Data.Map.Strict
(
Map
)
import
Data.Map.Strict
(
Map
)
import
Data.Map.Strict
qualified
as
Map
import
Data.Maybe
(
fromMaybe
)
import
Data.Maybe
(
fromMaybe
)
import
Data.Set
(
Set
)
import
Data.Set
(
Set
)
import
Data.Set
qualified
as
Set
import
Data.Text
(
Text
,
pack
)
import
Data.Text
(
Text
,
pack
)
import
qualified
Data.List
as
List
import
qualified
Data.Map.Strict
as
Map
import
qualified
Data.Set
as
Set
import
qualified
Data.HashMap.Strict
as
HashMap
import
Servant
(
Headers
,
Header
,
addHeader
)
import
Gargantext.API.Node.Corpus.Export.Types
import
qualified
Gargantext.API.Node.Document.Export.Types
as
DocumentExport
import
Gargantext.API.Ngrams.Types
import
Gargantext.API.Ngrams.Tools
(
filterListWithRoot
,
mapTermListRoot
,
getRepo
)
import
Gargantext.API.Ngrams.Tools
(
filterListWithRoot
,
mapTermListRoot
,
getRepo
)
import
Gargantext.API.Ngrams.Types
import
Gargantext.API.Node.Corpus.Export.Types
import
Gargantext.API.Node.Document.Export.Types
qualified
as
DocumentExport
import
Gargantext.API.Prelude
(
GargNoServer
)
import
Gargantext.API.Prelude
(
GargNoServer
)
import
Gargantext.Prelude.Crypto.Hash
(
hash
)
import
Gargantext.Core.Types
import
Gargantext.Core.NodeStory
import
Gargantext.Core.NodeStory
import
Gargantext.Core.Types
import
Gargantext.Database.Action.Metrics.NgramsByContext
(
getNgramsByContextOnlyUser
)
import
Gargantext.Database.Action.Metrics.NgramsByContext
(
getNgramsByContextOnlyUser
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataDocument
(
..
))
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataDocument
(
..
))
...
@@ -42,9 +39,11 @@ import Gargantext.Database.Query.Table.Node
...
@@ -42,9 +39,11 @@ import Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Select
(
selectNodesWithUsername
)
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.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Database.Schema.Context
(
_context_id
,
_context_hyperdata
)
import
Gargantext.Database.Schema.Context
(
_context_id
,
_context_hyperdata
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Prelude.Crypto.Hash
(
hash
)
import
Servant
(
Headers
,
Header
,
addHeader
)
--------------------------------------------------
--------------------------------------------------
-- | Hashes are ordered by Set
-- | Hashes are ordered by Set
...
...
src/Gargantext/API/Node/Corpus/Searx.hs
View file @
a2e7a40c
...
@@ -31,7 +31,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus)
...
@@ -31,7 +31,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
(
..
))
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
ListId
,
NodeType
(
NodeTexts
))
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
ListId
,
NodeType
(
NodeTexts
))
import
Gargantext.Database.Prelude
(
hasConfig
)
import
Gargantext.Database.Prelude
(
hasConfig
)
import
Gargantext.Database.Query.Table.Node
(
defaultListMaybe
,
getOrMkList
)
import
Gargantext.Database.Query.Table.Node
(
getOrMkList
)
import
Gargantext.Database.Query.Table.Node
(
insertDefaultNodeIfNotExists
)
import
Gargantext.Database.Query.Table.Node
(
insertDefaultNodeIfNotExists
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Tree.Error
(
HasTreeError
)
import
Gargantext.Database.Query.Tree.Error
(
HasTreeError
)
...
@@ -160,12 +160,12 @@ triggerSearxSearch :: ( MonadBase IO m
...
@@ -160,12 +160,12 @@ triggerSearxSearch :: ( MonadBase IO m
,
HasTreeError
err
,
HasTreeError
err
,
HasInvalidError
err
,
HasInvalidError
err
,
MonadJobStatus
m
)
,
MonadJobStatus
m
)
=>
User
=>
User
->
CorpusId
->
CorpusId
->
API
.
RawQuery
->
API
.
RawQuery
->
Lang
->
Lang
->
JobHandle
m
->
JobHandle
m
->
m
()
->
m
()
triggerSearxSearch
user
cId
q
l
jobHandle
=
do
triggerSearxSearch
user
cId
q
l
jobHandle
=
do
userId
<-
getUserId
user
userId
<-
getUserId
user
...
@@ -181,12 +181,7 @@ triggerSearxSearch user cId q l jobHandle = do
...
@@ -181,12 +181,7 @@ triggerSearxSearch user cId q l jobHandle = do
uId
<-
getUserId
user
uId
<-
getUserId
user
let
surl
=
_gc_frame_searx_url
cfg
let
surl
=
_gc_frame_searx_url
cfg
-- printDebug "[triggerSearxSearch] surl" surl
-- printDebug "[triggerSearxSearch] surl" surl
mListId
<-
defaultListMaybe
cId
listId
<-
getOrMkList
cId
uId
listId
<-
case
mListId
of
Nothing
->
do
listId
<-
getOrMkList
cId
uId
pure
listId
Just
listId
->
pure
listId
-- printDebug "[triggerSearxSearch] listId" listId
-- printDebug "[triggerSearxSearch] listId" listId
...
...
src/Gargantext/Core/Viz/Graph/API.hs
View file @
a2e7a40c
...
@@ -281,11 +281,14 @@ type GraphVersionsAPI = Summary "Graph versions"
...
@@ -281,11 +281,14 @@ type GraphVersionsAPI = Summary "Graph versions"
graphVersionsAPI
::
UserId
->
NodeId
->
GargServer
GraphVersionsAPI
graphVersionsAPI
::
UserId
->
NodeId
->
GargServer
GraphVersionsAPI
graphVersionsAPI
u
n
=
graphVersionsAPI
u
n
=
graphVersions
0
n
graphVersions
u
n
:<|>
recomputeVersions
u
n
:<|>
recomputeVersions
u
n
graphVersions
::
Int
->
NodeId
->
GargNoServer
GraphVersions
graphVersions
::
(
HasNodeStory
env
err
m
)
graphVersions
n
nId
=
do
=>
UserId
->
NodeId
->
m
GraphVersions
graphVersions
u
nId
=
do
nodeGraph
<-
getNodeWith
nId
(
Proxy
::
Proxy
HyperdataGraph
)
nodeGraph
<-
getNodeWith
nId
(
Proxy
::
Proxy
HyperdataGraph
)
let
let
graph
=
nodeGraph
graph
=
nodeGraph
...
@@ -302,21 +305,14 @@ graphVersions n nId = do
...
@@ -302,21 +305,14 @@ graphVersions n nId = do
mcId
<-
getClosestParentIdByType
nId
NodeCorpus
mcId
<-
getClosestParentIdByType
nId
NodeCorpus
let
cId
=
maybe
(
panic
"[G.V.G.API] Node has no parent"
)
identity
mcId
let
cId
=
maybe
(
panic
"[G.V.G.API] Node has no parent"
)
identity
mcId
maybeListId
<-
defaultListMaybe
cId
listId
<-
getOrMkList
cId
u
case
maybeListId
of
repo
<-
getRepo
[
listId
]
Nothing
->
if
n
<=
2
let
v
=
repo
^.
unNodeStory
.
at
listId
.
_Just
.
a_version
then
graphVersions
(
n
+
1
)
cId
-- printDebug "graphVersions" v
else
panic
"[G.V.G.API] list not found after iterations"
Just
listId
->
do
repo
<-
getRepo
[
listId
]
let
v
=
repo
^.
unNodeStory
.
at
listId
.
_Just
.
a_version
-- printDebug "graphVersions" v
pure
$
GraphVersions
{
gv_graph
=
listVersion
pure
$
GraphVersions
{
gv_graph
=
listVersion
,
gv_repo
=
v
}
,
gv_repo
=
v
}
--recomputeVersions :: UserId -> NodeId -> GargNoServer Graph
recomputeVersions
::
HasNodeStory
env
err
m
recomputeVersions
::
HasNodeStory
env
err
m
=>
UserId
=>
UserId
->
NodeId
->
NodeId
...
@@ -324,10 +320,11 @@ recomputeVersions :: HasNodeStory env err m
...
@@ -324,10 +320,11 @@ recomputeVersions :: HasNodeStory env err m
recomputeVersions
uId
nId
=
recomputeGraph
uId
nId
Spinglass
BridgenessMethod_Basic
Nothing
Nothing
NgramsTerms
NgramsTerms
False
recomputeVersions
uId
nId
=
recomputeGraph
uId
nId
Spinglass
BridgenessMethod_Basic
Nothing
Nothing
NgramsTerms
NgramsTerms
False
------------------------------------------------------------
------------------------------------------------------------
graphClone
::
UserId
graphClone
::
HasNodeError
err
=>
UserId
->
NodeId
->
NodeId
->
HyperdataGraphAPI
->
HyperdataGraphAPI
->
GargNoServe
r
NodeId
->
DBCmd
er
r
NodeId
graphClone
uId
pId
(
HyperdataGraphAPI
{
_hyperdataAPIGraph
=
graph
graphClone
uId
pId
(
HyperdataGraphAPI
{
_hyperdataAPIGraph
=
graph
,
_hyperdataAPICamera
=
camera
})
=
do
,
_hyperdataAPICamera
=
camera
})
=
do
let
nodeType
=
NodeGraph
let
nodeType
=
NodeGraph
...
...
test/Test/Database/Types.hs
View file @
a2e7a40c
...
@@ -34,6 +34,7 @@ import Gargantext.API.Prelude
...
@@ -34,6 +34,7 @@ import Gargantext.API.Prelude
import
Gargantext.Core.Mail.Types
(
HasMail
(
..
))
import
Gargantext.Core.Mail.Types
(
HasMail
(
..
))
import
Gargantext.Core.NLP
(
HasNLPServer
(
..
))
import
Gargantext.Core.NLP
(
HasNLPServer
(
..
))
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Prelude
(
HasConfig
(
..
),
HasConnectionPool
(
..
))
import
Gargantext.Prelude.Config
import
Gargantext.Prelude.Config
import
Gargantext.Prelude.Mail.Types
(
MailConfig
(
..
),
LoginType
(
NoAuth
))
import
Gargantext.Prelude.Mail.Types
(
MailConfig
(
..
),
LoginType
(
NoAuth
))
import
Gargantext.System.Logging
(
HasLogger
(
..
),
Logger
,
MonadLogger
(
..
))
import
Gargantext.System.Logging
(
HasLogger
(
..
),
Logger
,
MonadLogger
(
..
))
...
...
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