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
...
@@ -185,8 +185,8 @@ 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
...
@@ -202,8 +202,8 @@ updateChart cId maybeListId tabType maybeLimit = do
...
@@ -202,8 +202,8 @@ 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
...
@@ -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
...
@@ -89,47 +89,46 @@ module Gargantext.API.Ngrams
...
@@ -89,47 +89,46 @@ module Gargantext.API.Ngrams
import
Control.Concurrent
import
Control.Concurrent
import
Control.Lens
((
.~
),
view
,
(
^.
),
(
^..
),
(
+~
),
(
%~
),
(
.~
),
msumOf
,
at
,
_Just
,
Each
(
..
),
(
%%~
),
mapped
,
ifolded
,
to
,
withIndex
,
over
)
import
Control.Lens
((
.~
),
view
,
(
^.
),
(
^..
),
(
+~
),
(
%~
),
(
.~
),
msumOf
,
at
,
_Just
,
Each
(
..
),
(
%%~
),
mapped
,
ifolded
,
to
,
withIndex
,
over
)
import
Control.Monad.Reader
import
Control.Monad.Reader
import
Data.Aeson.Text
qualified
as
DAT
import
Data.Foldable
import
Data.Foldable
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.Map.Strict.Patch
qualified
as
PM
import
Data.Maybe
(
fromMaybe
)
import
Data.Maybe
(
fromMaybe
)
import
Data.Monoid
import
Data.Monoid
import
Data.Ord
(
Down
(
..
))
import
Data.Ord
(
Down
(
..
))
import
Data.Patch.Class
(
Action
(
act
),
Transformable
(
..
),
ours
)
import
Data.Patch.Class
(
Action
(
act
),
Transformable
(
..
),
ours
)
import
Data.Set
(
Set
)
import
Data.Set
(
Set
)
import
Data.Set
qualified
as
Set
import
Data.Text
(
Text
,
isInfixOf
,
toLower
,
unpack
)
import
Data.Text
(
Text
,
isInfixOf
,
toLower
,
unpack
)
import
Data.Text.Lazy.IO
as
DTL
import
Data.Text.Lazy.IO
as
DTL
import
Formatting
(
hprint
,
int
,
(
%
))
import
Formatting
(
hprint
,
int
,
(
%
))
import
Gargantext.API.Admin.EnvTypes
(
Env
,
GargJob
(
..
))
import
Gargantext.API.Admin.EnvTypes
(
Env
,
GargJob
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
),
AsyncJobs
)
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
),
AsyncJobs
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
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.Ngrams.Types
import
Gargantext.API.Prelude
import
Gargantext.API.Prelude
import
Gargantext.Core.NodeStory
import
Gargantext.Core.NodeStory
import
Gargantext.Core.Types
(
ListType
(
..
),
NodeId
,
ListId
,
DocId
,
TODO
,
assertValid
,
HasInvalidError
,
ContextId
)
import
Gargantext.Core.Types
(
ListType
(
..
),
NodeId
,
ListId
,
DocId
,
TODO
,
assertValid
,
HasInvalidError
,
ContextId
)
import
Gargantext.Core.Types.Query
(
Limit
(
..
),
Offset
(
..
),
MinSize
(
..
),
MaxSize
(
..
))
import
Gargantext.Core.Types.Query
(
Limit
(
..
),
Offset
(
..
),
MinSize
(
..
),
MaxSize
(
..
))
import
Gargantext.API.Ngrams.Tools
import
Gargantext.Database.Action.Metrics.NgramsByContext
(
getOccByNgramsOnlyFast
)
import
Gargantext.Database.Action.Metrics.NgramsByContext
(
getOccByNgramsOnlyFast
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Types.Node
(
NodeType
(
..
))
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
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
(
getNode
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Select
import
Gargantext.Database.Query.Table.Node.Select
import
Gargantext.Database.Schema.Node
(
node_id
,
node_parent_id
,
node_user_id
)
import
Gargantext.Database.Schema.Node
(
node_id
,
node_parent_id
,
node_user_id
)
import
Gargantext.Prelude
hiding
(
log
)
import
Gargantext.Prelude
hiding
(
log
)
import
Gargantext.Prelude.Clock
(
hasTime
,
getTime
)
import
Gargantext.Prelude.Clock
(
hasTime
,
getTime
)
import
Gargantext.Utils.Jobs
(
serveJobsAPI
,
MonadJobStatus
(
..
))
import
Prelude
(
error
)
import
Prelude
(
error
)
import
Servant
hiding
(
Patch
)
import
Servant
hiding
(
Patch
)
import
Gargantext.Utils.Jobs
(
serveJobsAPI
,
MonadJobStatus
(
..
))
import
System.IO
(
stderr
)
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)
-- TODO sequences of modifications (Patchs)
...
@@ -201,8 +200,7 @@ listTypeConflictResolution :: ListType -> ListType -> ListType
...
@@ -201,8 +200,7 @@ listTypeConflictResolution :: ListType -> ListType -> ListType
listTypeConflictResolution
_
_
=
undefined
-- TODO Use Map User ListType
listTypeConflictResolution
_
_
=
undefined
-- TODO Use Map User ListType
ngramsStatePatchConflictResolution
ngramsStatePatchConflictResolution
::
TableNgrams
.
NgramsType
::
TableNgrams
.
NgramsType
->
NgramsTerm
->
NgramsTerm
->
ConflictResolutionNgramsPatch
->
ConflictResolutionNgramsPatch
ngramsStatePatchConflictResolution
_ngramsType
_ngramsTerm
ngramsStatePatchConflictResolution
_ngramsType
_ngramsTerm
...
@@ -290,8 +288,7 @@ newNgramsFromNgramsStatePatch p =
...
@@ -290,8 +288,7 @@ newNgramsFromNgramsStatePatch p =
commitStatePatch
::
(
HasNodeStory
env
err
m
commitStatePatch
::
(
HasNodeStory
env
err
m
,
HasNodeStoryImmediateSaver
env
,
HasNodeStoryImmediateSaver
env
,
HasNodeArchiveStoryImmediateSaver
env
,
HasNodeArchiveStoryImmediateSaver
env
)
,
CmdCommon
env
)
=>
ListId
=>
ListId
->
Versioned
NgramsStatePatch'
->
Versioned
NgramsStatePatch'
->
m
(
Versioned
NgramsStatePatch'
)
->
m
(
Versioned
NgramsStatePatch'
)
...
@@ -390,7 +387,6 @@ tableNgramsPut :: ( HasNodeStory env err m
...
@@ -390,7 +387,6 @@ tableNgramsPut :: ( HasNodeStory env err m
,
HasNodeStoryImmediateSaver
env
,
HasNodeStoryImmediateSaver
env
,
HasNodeArchiveStoryImmediateSaver
env
,
HasNodeArchiveStoryImmediateSaver
env
,
HasInvalidError
err
,
HasInvalidError
err
,
CmdCommon
env
)
)
=>
TabType
=>
TabType
->
ListId
->
ListId
...
@@ -418,8 +414,7 @@ tableNgramsPut tabType listId (Versioned p_version p_table)
...
@@ -418,8 +414,7 @@ tableNgramsPut tabType listId (Versioned p_version p_table)
tableNgramsPostChartsAsync
::
(
HasNodeStory
env
err
m
tableNgramsPostChartsAsync
::
(
HasNodeStory
env
err
m
,
HasSettings
env
,
HasSettings
env
,
MonadJobStatus
m
,
MonadJobStatus
m
)
)
=>
UpdateTableNgramsCharts
=>
UpdateTableNgramsCharts
->
JobHandle
m
->
JobHandle
m
->
m
()
->
m
()
...
@@ -608,7 +603,8 @@ searchTableNgrams versionedTableMap NgramsSearchQuery{..} =
...
@@ -608,7 +603,8 @@ searchTableNgrams versionedTableMap NgramsSearchQuery{..} =
getTableNgrams
::
forall
env
err
m
.
getTableNgrams
::
forall
env
err
m
.
(
HasNodeStory
env
err
m
,
HasNodeError
err
,
CmdCommon
env
)
(
HasNodeStory
env
err
m
,
HasNodeError
err
)
=>
NodeId
=>
NodeId
->
ListId
->
ListId
->
TabType
->
TabType
...
@@ -623,8 +619,7 @@ getTableNgrams nodeId listId tabType searchQuery = do
...
@@ -623,8 +619,7 @@ getTableNgrams nodeId listId tabType searchQuery = do
-- | Helper function to get the ngrams table with scores.
-- | Helper function to get the ngrams table with scores.
getNgramsTable'
::
forall
env
err
m
.
getNgramsTable'
::
forall
env
err
m
.
(
HasNodeStory
env
err
m
(
HasNodeStory
env
err
m
,
HasNodeError
err
,
HasNodeError
err
)
,
CmdCommon
env
)
=>
NodeId
=>
NodeId
->
ListId
->
ListId
->
TableNgrams
.
NgramsType
->
TableNgrams
.
NgramsType
...
@@ -638,8 +633,7 @@ getNgramsTable' nId listId ngramsType = do
...
@@ -638,8 +633,7 @@ getNgramsTable' nId listId ngramsType = do
setNgramsTableScores
::
forall
env
err
m
t
.
setNgramsTableScores
::
forall
env
err
m
t
.
(
Each
t
t
NgramsElement
NgramsElement
(
Each
t
t
NgramsElement
NgramsElement
,
HasNodeStory
env
err
m
,
HasNodeStory
env
err
m
,
HasNodeError
err
,
HasNodeError
err
)
,
CmdCommon
env
)
=>
NodeId
=>
NodeId
->
ListId
->
ListId
->
TableNgrams
.
NgramsType
->
TableNgrams
.
NgramsType
...
@@ -667,7 +661,7 @@ setNgramsTableScores nId listId ngramsType table = do
...
@@ -667,7 +661,7 @@ setNgramsTableScores nId listId ngramsType table = do
scoresRecomputeTableNgrams
::
forall
env
err
m
.
scoresRecomputeTableNgrams
::
forall
env
err
m
.
(
HasNodeStory
env
err
m
,
HasNodeError
err
,
CmdCommon
env
)
(
HasNodeStory
env
err
m
,
HasNodeError
err
)
=>
NodeId
->
TabType
->
ListId
->
m
Int
=>
NodeId
->
TabType
->
ListId
->
m
Int
scoresRecomputeTableNgrams
nId
tabType
listId
=
do
scoresRecomputeTableNgrams
nId
tabType
listId
=
do
tableMap
<-
getNgramsTableMap
listId
ngramsType
tableMap
<-
getNgramsTableMap
listId
ngramsType
...
@@ -728,7 +722,8 @@ type TableNgramsAsyncApi = Summary "Table Ngrams Async API"
...
@@ -728,7 +722,8 @@ type TableNgramsAsyncApi = Summary "Table Ngrams Async API"
:>
"update"
:>
"update"
:>
AsyncJobs
JobLog
'[
J
SON
]
UpdateTableNgramsCharts
JobLog
:>
AsyncJobs
JobLog
'[
J
SON
]
UpdateTableNgramsCharts
JobLog
getTableNgramsCorpus
::
(
HasNodeStory
env
err
m
,
HasNodeError
err
,
CmdCommon
env
)
getTableNgramsCorpus
::
(
HasNodeStory
env
err
m
,
HasNodeError
err
)
=>
NodeId
=>
NodeId
->
TabType
->
TabType
->
ListId
->
ListId
...
@@ -756,7 +751,8 @@ getTableNgramsCorpus nId tabType listId limit_ offset listType minSize maxSize o
...
@@ -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
=>
NodeId
->
TabType
->
TabType
->
ListId
->
ListId
...
@@ -772,7 +768,8 @@ getTableNgramsVersion _nId _tabType listId = currentVersion listId
...
@@ -772,7 +768,8 @@ getTableNgramsVersion _nId _tabType listId = currentVersion listId
-- | Text search is deactivated for now for ngrams by doc only
-- | 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
=>
DocId
->
TabType
->
ListId
->
Limit
->
Maybe
Offset
->
ListId
->
Limit
->
Maybe
Offset
->
Maybe
ListType
->
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:
...
@@ -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
)
...
@@ -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
<-
case
mListId
of
Nothing
->
do
listId
<-
getOrMkList
cId
uId
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,13 +305,7 @@ graphVersions n nId = do
...
@@ -302,13 +305,7 @@ 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
Nothing
->
if
n
<=
2
then
graphVersions
(
n
+
1
)
cId
else
panic
"[G.V.G.API] list not found after iterations"
Just
listId
->
do
repo
<-
getRepo
[
listId
]
repo
<-
getRepo
[
listId
]
let
v
=
repo
^.
unNodeStory
.
at
listId
.
_Just
.
a_version
let
v
=
repo
^.
unNodeStory
.
at
listId
.
_Just
.
a_version
-- printDebug "graphVersions" v
-- printDebug "graphVersions" v
...
@@ -316,7 +313,6 @@ graphVersions n nId = do
...
@@ -316,7 +313,6 @@ graphVersions n nId = do
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