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
Show 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,8 +185,8 @@ getChart cId _start _end maybeListId tabType = do
pure
$
constructHashedResponse
chart
updateChart
::
HasNodeError
err
=>
CorpusId
updateChart
::
HasNodeError
err
=>
CorpusId
->
Maybe
ListId
->
TabType
->
Maybe
Limit
...
...
@@ -202,8 +202,8 @@ updateChart cId maybeListId tabType maybeLimit = do
_
<-
updateChart'
cId
listId
tabType
maybeLimit
pure
()
updateChart'
::
HasNodeError
err
=>
CorpusId
updateChart'
::
HasNodeError
err
=>
CorpusId
->
ListId
->
TabType
->
Maybe
Limit
...
...
@@ -267,7 +267,7 @@ getPie cId _start _end maybeListId tabType = do
chart
<-
case
mChart
of
Just
chart
->
pure
chart
Nothing
->
do
updatePie'
cId
maybeL
istId
tabType
Nothing
updatePie'
cId
l
istId
tabType
Nothing
pure
$
constructHashedResponse
chart
...
...
@@ -278,23 +278,23 @@ updatePie :: HasNodeStory env err m
->
Maybe
Limit
->
m
()
updatePie
cId
maybeListId
tabType
maybeLimit
=
do
listId
<-
case
maybeListId
of
Just
lid
->
pure
lid
Nothing
->
defaultList
cId
printDebug
"[updatePie] cId"
cId
printDebug
"[updatePie] maybeListId"
maybeListId
printDebug
"[updatePie] tabType"
tabType
printDebug
"[updatePie] maybeLimit"
maybeLimit
_
<-
updatePie'
cId
maybeL
istId
tabType
maybeLimit
_
<-
updatePie'
cId
l
istId
tabType
maybeLimit
pure
()
updatePie'
::
(
HasNodeStory
env
err
m
,
HasNodeError
err
)
=>
CorpusId
->
Maybe
ListId
->
ListId
->
TabType
->
Maybe
Limit
->
m
(
ChartMetrics
Histo
)
updatePie'
cId
maybeListId
tabType
_maybeLimit
=
do
listId
<-
case
maybeListId
of
Just
lid
->
pure
lid
Nothing
->
defaultList
cId
updatePie'
cId
listId
tabType
_maybeLimit
=
do
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
hl
=
node
^.
node_hyperdata
pieMap
=
hl
^.
hl_pie
...
...
src/Gargantext/API/Ngrams.hs
View file @
a2e7a40c
...
...
@@ -89,47 +89,46 @@ module Gargantext.API.Ngrams
import
Control.Concurrent
import
Control.Lens
((
.~
),
view
,
(
^.
),
(
^..
),
(
+~
),
(
%~
),
(
.~
),
msumOf
,
at
,
_Just
,
Each
(
..
),
(
%%~
),
mapped
,
ifolded
,
to
,
withIndex
,
over
)
import
Control.Monad.Reader
import
Data.Aeson.Text
qualified
as
DAT
import
Data.Foldable
import
Data.List
qualified
as
List
import
Data.Map.Strict
(
Map
)
import
Data.Map.Strict
qualified
as
Map
import
Data.Map.Strict.Patch
qualified
as
PM
import
Data.Maybe
(
fromMaybe
)
import
Data.Monoid
import
Data.Ord
(
Down
(
..
))
import
Data.Patch.Class
(
Action
(
act
),
Transformable
(
..
),
ours
)
import
Data.Set
(
Set
)
import
Data.Set
qualified
as
Set
import
Data.Text
(
Text
,
isInfixOf
,
toLower
,
unpack
)
import
Data.Text.Lazy.IO
as
DTL
import
Formatting
(
hprint
,
int
,
(
%
))
import
Gargantext.API.Admin.EnvTypes
(
Env
,
GargJob
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
),
AsyncJobs
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Metrics
qualified
as
Metrics
import
Gargantext.API.Ngrams.Tools
import
Gargantext.API.Ngrams.Types
import
Gargantext.API.Prelude
import
Gargantext.Core.NodeStory
import
Gargantext.Core.Types
(
ListType
(
..
),
NodeId
,
ListId
,
DocId
,
TODO
,
assertValid
,
HasInvalidError
,
ContextId
)
import
Gargantext.Core.Types.Query
(
Limit
(
..
),
Offset
(
..
),
MinSize
(
..
),
MaxSize
(
..
))
import
Gargantext.API.Ngrams.Tools
import
Gargantext.Database.Action.Metrics.NgramsByContext
(
getOccByNgramsOnlyFast
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Types.Node
(
NodeType
(
..
))
import
Gargantext.Database.Prelude
(
CmdCommon
)
import
Gargantext.Database.Query.Table.Ngrams
hiding
(
NgramsType
(
..
),
ngramsType
,
ngrams_terms
)
import
Gargantext.Database.Query.Table.Ngrams
qualified
as
TableNgrams
import
Gargantext.Database.Query.Table.Node
(
getNode
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Select
import
Gargantext.Database.Schema.Node
(
node_id
,
node_parent_id
,
node_user_id
)
import
Gargantext.Prelude
hiding
(
log
)
import
Gargantext.Prelude.Clock
(
hasTime
,
getTime
)
import
Gargantext.Utils.Jobs
(
serveJobsAPI
,
MonadJobStatus
(
..
))
import
Prelude
(
error
)
import
Servant
hiding
(
Patch
)
import
Gargantext.Utils.Jobs
(
serveJobsAPI
,
MonadJobStatus
(
..
))
import
System.IO
(
stderr
)
import
qualified
Data.Aeson.Text
as
DAT
import
qualified
Data.List
as
List
import
qualified
Data.Map.Strict
as
Map
import
qualified
Data.Map.Strict.Patch
as
PM
import
qualified
Data.Set
as
Set
import
qualified
Gargantext.API.Metrics
as
Metrics
import
qualified
Gargantext.Database.Query.Table.Ngrams
as
TableNgrams
{-
-- TODO sequences of modifications (Patchs)
...
...
@@ -201,8 +200,7 @@ listTypeConflictResolution :: ListType -> ListType -> ListType
listTypeConflictResolution
_
_
=
undefined
-- TODO Use Map User ListType
ngramsStatePatchConflictResolution
::
TableNgrams
.
NgramsType
ngramsStatePatchConflictResolution
::
TableNgrams
.
NgramsType
->
NgramsTerm
->
ConflictResolutionNgramsPatch
ngramsStatePatchConflictResolution
_ngramsType
_ngramsTerm
...
...
@@ -290,8 +288,7 @@ newNgramsFromNgramsStatePatch p =
commitStatePatch
::
(
HasNodeStory
env
err
m
,
HasNodeStoryImmediateSaver
env
,
HasNodeArchiveStoryImmediateSaver
env
,
CmdCommon
env
)
,
HasNodeArchiveStoryImmediateSaver
env
)
=>
ListId
->
Versioned
NgramsStatePatch'
->
m
(
Versioned
NgramsStatePatch'
)
...
...
@@ -390,7 +387,6 @@ tableNgramsPut :: ( HasNodeStory env err m
,
HasNodeStoryImmediateSaver
env
,
HasNodeArchiveStoryImmediateSaver
env
,
HasInvalidError
err
,
CmdCommon
env
)
=>
TabType
->
ListId
...
...
@@ -418,8 +414,7 @@ tableNgramsPut tabType listId (Versioned p_version p_table)
tableNgramsPostChartsAsync
::
(
HasNodeStory
env
err
m
,
HasSettings
env
,
MonadJobStatus
m
)
,
MonadJobStatus
m
)
=>
UpdateTableNgramsCharts
->
JobHandle
m
->
m
()
...
...
@@ -608,7 +603,8 @@ searchTableNgrams versionedTableMap NgramsSearchQuery{..} =
getTableNgrams
::
forall
env
err
m
.
(
HasNodeStory
env
err
m
,
HasNodeError
err
,
CmdCommon
env
)
(
HasNodeStory
env
err
m
,
HasNodeError
err
)
=>
NodeId
->
ListId
->
TabType
...
...
@@ -623,8 +619,7 @@ getTableNgrams nodeId listId tabType searchQuery = do
-- | Helper function to get the ngrams table with scores.
getNgramsTable'
::
forall
env
err
m
.
(
HasNodeStory
env
err
m
,
HasNodeError
err
,
CmdCommon
env
)
,
HasNodeError
err
)
=>
NodeId
->
ListId
->
TableNgrams
.
NgramsType
...
...
@@ -638,8 +633,7 @@ getNgramsTable' nId listId ngramsType = do
setNgramsTableScores
::
forall
env
err
m
t
.
(
Each
t
t
NgramsElement
NgramsElement
,
HasNodeStory
env
err
m
,
HasNodeError
err
,
CmdCommon
env
)
,
HasNodeError
err
)
=>
NodeId
->
ListId
->
TableNgrams
.
NgramsType
...
...
@@ -667,7 +661,7 @@ setNgramsTableScores nId listId ngramsType table = do
scoresRecomputeTableNgrams
::
forall
env
err
m
.
(
HasNodeStory
env
err
m
,
HasNodeError
err
,
CmdCommon
env
)
(
HasNodeStory
env
err
m
,
HasNodeError
err
)
=>
NodeId
->
TabType
->
ListId
->
m
Int
scoresRecomputeTableNgrams
nId
tabType
listId
=
do
tableMap
<-
getNgramsTableMap
listId
ngramsType
...
...
@@ -728,7 +722,8 @@ type TableNgramsAsyncApi = Summary "Table Ngrams Async API"
:>
"update"
:>
AsyncJobs
JobLog
'[
J
SON
]
UpdateTableNgramsCharts
JobLog
getTableNgramsCorpus
::
(
HasNodeStory
env
err
m
,
HasNodeError
err
,
CmdCommon
env
)
getTableNgramsCorpus
::
(
HasNodeStory
env
err
m
,
HasNodeError
err
)
=>
NodeId
->
TabType
->
ListId
...
...
@@ -756,7 +751,8 @@ getTableNgramsCorpus nId tabType listId limit_ offset listType minSize maxSize o
getTableNgramsVersion
::
(
HasNodeStory
env
err
m
,
HasNodeError
err
,
CmdCommon
env
)
getTableNgramsVersion
::
(
HasNodeStory
env
err
m
,
HasNodeError
err
)
=>
NodeId
->
TabType
->
ListId
...
...
@@ -772,7 +768,8 @@ getTableNgramsVersion _nId _tabType listId = currentVersion listId
-- | Text search is deactivated for now for ngrams by doc only
getTableNgramsDoc
::
(
HasNodeStory
env
err
m
,
HasNodeError
err
,
CmdCommon
env
)
getTableNgramsDoc
::
(
HasNodeStory
env
err
m
,
HasNodeError
err
)
=>
DocId
->
TabType
->
ListId
->
Limit
->
Maybe
Offset
->
Maybe
ListType
...
...
src/Gargantext/API/Ngrams/Prelude.hs
View file @
a2e7a40c
src/Gargantext/API/Node/Corpus/Export.hs
View file @
a2e7a40c
...
...
@@ -16,24 +16,21 @@ Main exports of Gargantext:
module
Gargantext.API.Node.Corpus.Export
where
import
Data.HashMap.Strict
qualified
as
HashMap
import
Data.List
qualified
as
List
import
Data.Map.Strict
(
Map
)
import
Data.Map.Strict
qualified
as
Map
import
Data.Maybe
(
fromMaybe
)
import
Data.Set
(
Set
)
import
Data.Set
qualified
as
Set
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.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.Prelude.Crypto.Hash
(
hash
)
import
Gargantext.Core.Types
import
Gargantext.Core.NodeStory
import
Gargantext.Core.Types
import
Gargantext.Database.Action.Metrics.NgramsByContext
(
getNgramsByContextOnlyUser
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataDocument
(
..
))
...
...
@@ -42,9 +39,11 @@ import Gargantext.Database.Query.Table.Node
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.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Database.Schema.Context
(
_context_id
,
_context_hyperdata
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Prelude
import
Gargantext.Prelude.Crypto.Hash
(
hash
)
import
Servant
(
Headers
,
Header
,
addHeader
)
--------------------------------------------------
-- | 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)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
ListId
,
NodeType
(
NodeTexts
))
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.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Tree.Error
(
HasTreeError
)
...
...
@@ -181,12 +181,7 @@ triggerSearxSearch user cId q l jobHandle = do
uId
<-
getUserId
user
let
surl
=
_gc_frame_searx_url
cfg
-- printDebug "[triggerSearxSearch] surl" surl
mListId
<-
defaultListMaybe
cId
listId
<-
case
mListId
of
Nothing
->
do
listId
<-
getOrMkList
cId
uId
pure
listId
Just
listId
->
pure
listId
-- printDebug "[triggerSearxSearch] listId" listId
...
...
src/Gargantext/Core/Viz/Graph/API.hs
View file @
a2e7a40c
...
...
@@ -281,11 +281,14 @@ type GraphVersionsAPI = Summary "Graph versions"
graphVersionsAPI
::
UserId
->
NodeId
->
GargServer
GraphVersionsAPI
graphVersionsAPI
u
n
=
graphVersions
0
n
graphVersions
u
n
:<|>
recomputeVersions
u
n
graphVersions
::
Int
->
NodeId
->
GargNoServer
GraphVersions
graphVersions
n
nId
=
do
graphVersions
::
(
HasNodeStory
env
err
m
)
=>
UserId
->
NodeId
->
m
GraphVersions
graphVersions
u
nId
=
do
nodeGraph
<-
getNodeWith
nId
(
Proxy
::
Proxy
HyperdataGraph
)
let
graph
=
nodeGraph
...
...
@@ -302,13 +305,7 @@ graphVersions n nId = do
mcId
<-
getClosestParentIdByType
nId
NodeCorpus
let
cId
=
maybe
(
panic
"[G.V.G.API] Node has no parent"
)
identity
mcId
maybeListId
<-
defaultListMaybe
cId
case
maybeListId
of
Nothing
->
if
n
<=
2
then
graphVersions
(
n
+
1
)
cId
else
panic
"[G.V.G.API] list not found after iterations"
Just
listId
->
do
listId
<-
getOrMkList
cId
u
repo
<-
getRepo
[
listId
]
let
v
=
repo
^.
unNodeStory
.
at
listId
.
_Just
.
a_version
-- printDebug "graphVersions" v
...
...
@@ -316,7 +313,6 @@ graphVersions n nId = do
pure
$
GraphVersions
{
gv_graph
=
listVersion
,
gv_repo
=
v
}
--recomputeVersions :: UserId -> NodeId -> GargNoServer Graph
recomputeVersions
::
HasNodeStory
env
err
m
=>
UserId
->
NodeId
...
...
@@ -324,10 +320,11 @@ recomputeVersions :: HasNodeStory env err m
recomputeVersions
uId
nId
=
recomputeGraph
uId
nId
Spinglass
BridgenessMethod_Basic
Nothing
Nothing
NgramsTerms
NgramsTerms
False
------------------------------------------------------------
graphClone
::
UserId
graphClone
::
HasNodeError
err
=>
UserId
->
NodeId
->
HyperdataGraphAPI
->
GargNoServe
r
NodeId
->
DBCmd
er
r
NodeId
graphClone
uId
pId
(
HyperdataGraphAPI
{
_hyperdataAPIGraph
=
graph
,
_hyperdataAPICamera
=
camera
})
=
do
let
nodeType
=
NodeGraph
...
...
test/Test/Database/Types.hs
View file @
a2e7a40c
...
...
@@ -34,6 +34,7 @@ import Gargantext.API.Prelude
import
Gargantext.Core.Mail.Types
(
HasMail
(
..
))
import
Gargantext.Core.NLP
(
HasNLPServer
(
..
))
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Prelude
(
HasConfig
(
..
),
HasConnectionPool
(
..
))
import
Gargantext.Prelude.Config
import
Gargantext.Prelude.Mail.Types
(
MailConfig
(
..
),
LoginType
(
NoAuth
))
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