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
118
Issues
118
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
4ef66cea
Commit
4ef66cea
authored
Oct 12, 2023
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
Merge remote-tracking branch 'origin/dev-typeclasses-refactoring' into dev
parents
aa230640
a2e7a40c
Changes
63
Show whitespace changes
Inline
Side-by-side
Showing
63 changed files
with
500 additions
and
495 deletions
+500
-495
API.hs
src/Gargantext/API.hs
+3
-5
Auth.hs
src/Gargantext/API/Admin/Auth.hs
+8
-8
Context.hs
src/Gargantext/API/Context.hs
+1
-1
Dev.hs
src/Gargantext/API/Dev.hs
+5
-5
Context.hs
src/Gargantext/API/GraphQL/Context.hs
+2
-2
PolicyCheck.hs
src/Gargantext/API/GraphQL/PolicyCheck.hs
+1
-1
User.hs
src/Gargantext/API/GraphQL/User.hs
+8
-12
Metrics.hs
src/Gargantext/API/Metrics.hs
+20
-20
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+50
-53
List.hs
src/Gargantext/API/Ngrams/List.hs
+16
-17
Prelude.hs
src/Gargantext/API/Ngrams/Prelude.hs
+1
-1
Tools.hs
src/Gargantext/API/Ngrams/Tools.hs
+2
-2
Node.hs
src/Gargantext/API/Node.hs
+10
-10
Export.hs
src/Gargantext/API/Node/Corpus/Export.hs
+11
-12
File.hs
src/Gargantext/API/Node/Corpus/New/File.hs
+1
-1
Searx.hs
src/Gargantext/API/Node/Corpus/Searx.hs
+33
-24
Update.hs
src/Gargantext/API/Node/Corpus/Update.hs
+1
-1
New.hs
src/Gargantext/API/Node/New.hs
+1
-1
Share.hs
src/Gargantext/API/Node/Share.hs
+1
-1
Prelude.hs
src/Gargantext/API/Prelude.hs
+8
-8
Public.hs
src/Gargantext/API/Public.hs
+2
-2
Table.hs
src/Gargantext/API/Table.hs
+10
-11
Mail.hs
src/Gargantext/Core/Mail.hs
+3
-3
NodeStoryFile.hs
src/Gargantext/Core/NodeStoryFile.hs
+2
-2
List.hs
src/Gargantext/Core/Text/List.hs
+12
-14
Social.hs
src/Gargantext/Core/Text/List/Social.hs
+24
-36
Find.hs
src/Gargantext/Core/Text/List/Social/Find.hs
+5
-3
Chart.hs
src/Gargantext/Core/Viz/Chart.hs
+1
-1
API.hs
src/Gargantext/Core/Viz/Graph/API.hs
+19
-23
LegacyMain.hs
src/Gargantext/Core/Viz/Phylo/Legacy/LegacyMain.hs
+11
-19
Database.hs
src/Gargantext/Database.hs
+3
-3
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+55
-20
List.hs
src/Gargantext/Database/Action/Flow/List.hs
+14
-15
Pairing.hs
src/Gargantext/Database/Action/Flow/Pairing.hs
+8
-8
Learn.hs
src/Gargantext/Database/Action/Learn.hs
+7
-7
Mail.hs
src/Gargantext/Database/Action/Mail.hs
+1
-1
Metrics.hs
src/Gargantext/Database/Action/Metrics.hs
+2
-4
NgramsByContext.hs
src/Gargantext/Database/Action/Metrics/NgramsByContext.hs
+5
-5
TFICF.hs
src/Gargantext/Database/Action/Metrics/TFICF.hs
+5
-5
Node.hs
src/Gargantext/Database/Action/Node.hs
+1
-1
Share.hs
src/Gargantext/Database/Action/Share.hs
+2
-2
TSQuery.hs
src/Gargantext/Database/Action/TSQuery.hs
+16
-3
New.hs
src/Gargantext/Database/Action/User/New.hs
+3
-3
Prelude.hs
src/Gargantext/Database/Prelude.hs
+7
-11
Facet.hs
src/Gargantext/Database/Query/Facet.hs
+5
-5
Context.hs
src/Gargantext/Database/Query/Table/Context.hs
+9
-7
Ngrams.hs
src/Gargantext/Database/Query/Table/Ngrams.hs
+7
-7
NgramsPostag.hs
src/Gargantext/Database/Query/Table/NgramsPostag.hs
+3
-3
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+4
-6
Children.hs
src/Gargantext/Database/Query/Table/Node/Children.hs
+3
-7
Add.hs
src/Gargantext/Database/Query/Table/Node/Document/Add.hs
+3
-3
Select.hs
src/Gargantext/Database/Query/Table/Node/Select.hs
+4
-6
Update.hs
src/Gargantext/Database/Query/Table/Node/Update.hs
+2
-2
UpdateOpaleye.hs
src/Gargantext/Database/Query/Table/Node/UpdateOpaleye.hs
+4
-4
User.hs
src/Gargantext/Database/Query/Table/Node/User.hs
+2
-2
NodeContext.hs
src/Gargantext/Database/Query/Table/NodeContext.hs
+6
-8
NodeContext_NodeContext.hs
...argantext/Database/Query/Table/NodeContext_NodeContext.hs
+2
-2
NodeNgrams.hs
src/Gargantext/Database/Query/Table/NodeNgrams.hs
+4
-6
NodeNode.hs
src/Gargantext/Database/Query/Table/NodeNode.hs
+4
-4
NodeNodeNgrams.hs
src/Gargantext/Database/Query/Table/NodeNodeNgrams.hs
+3
-3
User.hs
src/Gargantext/Database/Query/Table/User.hs
+16
-16
Tree.hs
src/Gargantext/Database/Query/Tree.hs
+17
-17
Types.hs
test/Test/Database/Types.hs
+1
-0
No files found.
src/Gargantext/API.hs
View file @
4ef66cea
...
@@ -56,9 +56,9 @@ import Gargantext.API.Ngrams (saveNodeStoryImmediate)
...
@@ -56,9 +56,9 @@ import Gargantext.API.Ngrams (saveNodeStoryImmediate)
import
Gargantext.API.Routes
import
Gargantext.API.Routes
import
Gargantext.API.Server
(
server
)
import
Gargantext.API.Server
(
server
)
import
Gargantext.Core.NodeStory
import
Gargantext.Core.NodeStory
-- import Gargantext.Database.Prelude (Cmd)
import
Gargantext.Database.Prelude
qualified
as
DB
-- import Gargantext.Database.Action.Metrics.NgramsByContext (refreshNgramsMaterialized)
import
Gargantext.Prelude
hiding
(
putStrLn
)
import
Gargantext.Prelude
hiding
(
putStrLn
)
import
Gargantext.System.Logging
import
Network.HTTP.Types
hiding
(
Query
)
import
Network.HTTP.Types
hiding
(
Query
)
import
Network.Wai
import
Network.Wai
import
Network.Wai.Handler.Warp
hiding
(
defaultSettings
)
import
Network.Wai.Handler.Warp
hiding
(
defaultSettings
)
...
@@ -66,10 +66,8 @@ import Network.Wai.Middleware.Cors
...
@@ -66,10 +66,8 @@ import Network.Wai.Middleware.Cors
import
Network.Wai.Middleware.RequestLogger
import
Network.Wai.Middleware.RequestLogger
import
Paths_gargantext
(
getDataDir
)
import
Paths_gargantext
(
getDataDir
)
import
Servant
import
Servant
import
System.Cron.Schedule
qualified
as
Cron
import
System.FilePath
import
System.FilePath
import
qualified
Gargantext.Database.Prelude
as
DB
import
qualified
System.Cron.Schedule
as
Cron
import
Gargantext.System.Logging
-- | startGargantext takes as parameters port number and Ini file.
-- | startGargantext takes as parameters port number and Ini file.
startGargantext
::
Mode
->
PortNumber
->
FilePath
->
IO
()
startGargantext
::
Mode
->
PortNumber
->
FilePath
->
IO
()
...
...
src/Gargantext/API/Admin/Auth.hs
View file @
4ef66cea
...
@@ -58,7 +58,7 @@ import Gargantext.Core.Mail.Types (mailSettings)
...
@@ -58,7 +58,7 @@ import Gargantext.Core.Mail.Types (mailSettings)
import
Gargantext.Core.Types.Individu
(
User
(
..
),
Username
,
GargPassword
(
..
))
import
Gargantext.Core.Types.Individu
(
User
(
..
),
Username
,
GargPassword
(
..
))
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
NodeId
(
..
))
import
Gargantext.Database.Prelude
(
Cmd
'
,
Cmd
M
,
CmdCommon
)
import
Gargantext.Database.Prelude
(
Cmd
'
,
Cmd
Common
,
DbCmd
'
)
import
Gargantext.Database.Query.Table.User
import
Gargantext.Database.Query.Table.User
import
Gargantext.Database.Query.Tree
(
isDescendantOf
,
isIn
)
import
Gargantext.Database.Query.Tree
(
isDescendantOf
,
isIn
)
import
Gargantext.Database.Query.Tree.Root
(
getRoot
)
import
Gargantext.Database.Query.Tree.Root
(
getRoot
)
...
@@ -79,7 +79,8 @@ import Gargantext.API.Auth.PolicyCheck
...
@@ -79,7 +79,8 @@ import Gargantext.API.Auth.PolicyCheck
-- | Main functions of authorization
-- | Main functions of authorization
makeTokenForUser
::
(
HasSettings
env
,
HasJoseError
err
)
makeTokenForUser
::
(
HasSettings
env
,
HasJoseError
err
)
=>
NodeId
->
Cmd'
env
err
Token
=>
NodeId
->
Cmd'
env
err
Token
makeTokenForUser
uid
=
do
makeTokenForUser
uid
=
do
jwtS
<-
view
$
settings
.
jwtSettings
jwtS
<-
view
$
settings
.
jwtSettings
...
@@ -88,10 +89,10 @@ makeTokenForUser uid = do
...
@@ -88,10 +89,10 @@ makeTokenForUser uid = do
either
joseError
(
pure
.
toStrict
.
LE
.
decodeUtf8
)
e
either
joseError
(
pure
.
toStrict
.
LE
.
decodeUtf8
)
e
-- TODO not sure about the encoding...
-- TODO not sure about the encoding...
checkAuthRequest
::
(
HasSettings
env
,
CmdCommon
env
,
HasJoseError
err
)
checkAuthRequest
::
(
HasSettings
env
,
HasJoseError
err
,
DbCmd'
env
err
m
)
=>
Username
=>
Username
->
GargPassword
->
GargPassword
->
Cmd'
env
err
CheckAuth
->
m
CheckAuth
checkAuthRequest
couldBeEmail
(
GargPassword
p
)
=
do
checkAuthRequest
couldBeEmail
(
GargPassword
p
)
=
do
-- Sometimes user put email instead of username
-- Sometimes user put email instead of username
-- hence we have to check before
-- hence we have to check before
...
@@ -113,8 +114,8 @@ checkAuthRequest couldBeEmail (GargPassword p) = do
...
@@ -113,8 +114,8 @@ checkAuthRequest couldBeEmail (GargPassword p) = do
token
<-
makeTokenForUser
uid
token
<-
makeTokenForUser
uid
pure
$
Valid
token
uid
userLight_id
pure
$
Valid
token
uid
userLight_id
auth
::
(
HasSettings
env
,
CmdCommon
env
,
HasJoseError
err
)
auth
::
(
HasSettings
env
,
HasJoseError
err
,
DbCmd'
env
err
m
)
=>
AuthRequest
->
Cmd'
env
err
AuthResponse
=>
AuthRequest
->
m
AuthResponse
auth
(
AuthRequest
u
p
)
=
do
auth
(
AuthRequest
u
p
)
=
do
checkAuthRequest'
<-
checkAuthRequest
u
p
checkAuthRequest'
<-
checkAuthRequest
u
p
case
checkAuthRequest'
of
case
checkAuthRequest'
of
...
@@ -135,7 +136,7 @@ authCheck _env (BasicAuthData login password) = pure $
...
@@ -135,7 +136,7 @@ authCheck _env (BasicAuthData login password) = pure $
maybe Indefinite Authenticated $ TODO
maybe Indefinite Authenticated $ TODO
-}
-}
withAccessM
::
(
CmdM
env
err
m
,
HasServerError
err
)
withAccessM
::
(
DbCmd'
env
err
m
)
=>
AuthenticatedUser
=>
AuthenticatedUser
->
PathId
->
PathId
->
m
a
->
m
a
...
@@ -143,7 +144,6 @@ withAccessM :: (CmdM env err m, HasServerError err)
...
@@ -143,7 +144,6 @@ withAccessM :: (CmdM env err m, HasServerError err)
withAccessM
(
AuthenticatedUser
uId
)
(
PathNode
id
)
m
=
do
withAccessM
(
AuthenticatedUser
uId
)
(
PathNode
id
)
m
=
do
d
<-
id
`
isDescendantOf
`
uId
d
<-
id
`
isDescendantOf
`
uId
if
d
then
m
else
m
-- serverError err401
if
d
then
m
else
m
-- serverError err401
withAccessM
(
AuthenticatedUser
uId
)
(
PathNodeNode
cId
docId
)
m
=
do
withAccessM
(
AuthenticatedUser
uId
)
(
PathNodeNode
cId
docId
)
m
=
do
_a
<-
isIn
cId
docId
-- TODO use one query for all ?
_a
<-
isIn
cId
docId
-- TODO use one query for all ?
_d
<-
cId
`
isDescendantOf
`
uId
_d
<-
cId
`
isDescendantOf
`
uId
...
...
src/Gargantext/API/Context.hs
View file @
4ef66cea
...
@@ -25,7 +25,7 @@ import Gargantext.API.Admin.Auth (withAccess)
...
@@ -25,7 +25,7 @@ import Gargantext.API.Admin.Auth (withAccess)
import
Gargantext.API.Admin.Auth.Types
(
PathId
(
..
),
AuthenticatedUser
)
import
Gargantext.API.Admin.Auth.Types
(
PathId
(
..
),
AuthenticatedUser
)
import
Gargantext.API.Prelude
import
Gargantext.API.Prelude
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
-- (Cmd, CmdM
)
import
Gargantext.Database.Prelude
(
JSONB
)
import
Gargantext.Database.Query.Table.Context
import
Gargantext.Database.Query.Table.Context
-------------------------------------------------------------------
-------------------------------------------------------------------
...
...
src/Gargantext/API/Dev.hs
View file @
4ef66cea
...
@@ -14,22 +14,22 @@ module Gargantext.API.Dev where
...
@@ -14,22 +14,22 @@ module Gargantext.API.Dev where
import
Control.Exception
(
finally
)
import
Control.Exception
(
finally
)
import
Control.Monad
(
fail
)
import
Control.Monad
(
fail
)
import
Control.Monad.Reader
(
runReaderT
)
import
Control.Monad.Except
(
runExceptT
)
import
Control.Monad.Except
(
runExceptT
)
import
Control.Monad.Reader
(
runReaderT
)
import
Gargantext.API.Admin.EnvTypes
import
Gargantext.API.Admin.EnvTypes
import
Gargantext.API.Admin.Settings
import
Gargantext.API.Admin.Settings
import
Gargantext.API.Ngrams
(
saveNodeStoryImmediate
)
import
Gargantext.API.Ngrams
(
saveNodeStoryImmediate
)
import
Gargantext.API.Prelude
import
Gargantext.API.Prelude
import
Gargantext.Core.NLP
(
nlpServerMap
)
import
Gargantext.Core.NLP
(
nlpServerMap
)
import
Gargantext.Core.NodeStory
import
Gargantext.Core.NodeStory
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
Cmd
'
,
Cmd
''
,
databaseParameters
,
runCmd
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Prelude.Config
(
readConfig
)
import
Gargantext.Prelude.Config
(
readConfig
)
import
qualified
Gargantext.Prelude.Mail
as
Mail
import
Gargantext.Prelude.Mail
qualified
as
Mail
import
qualified
Gargantext.Prelude.NLP
as
NLP
import
Gargantext.Prelude.NLP
qualified
as
NLP
import
Gargantext.System.Logging
import
Servant
import
Servant
import
System.IO
(
FilePath
)
import
System.IO
(
FilePath
)
import
Gargantext.System.Logging
type
IniPath
=
FilePath
type
IniPath
=
FilePath
-------------------------------------------------------------------
-------------------------------------------------------------------
...
...
src/Gargantext/API/GraphQL/Context.hs
View file @
4ef66cea
...
@@ -211,8 +211,8 @@ toHyperdataRowDocumentGQL hyperdata =
...
@@ -211,8 +211,8 @@ toHyperdataRowDocumentGQL hyperdata =
}
}
HyperdataRowContact
{
}
->
Nothing
HyperdataRowContact
{
}
->
Nothing
updateNodeContextCategory
::
(
CmdCommon
env
,
HasSettings
env
)
=>
updateNodeContextCategory
::
(
CmdCommon
env
,
HasSettings
env
)
NodeContextCategoryMArgs
->
GqlM'
e
env
[
Int
]
=>
NodeContextCategoryMArgs
->
GqlM'
e
env
[
Int
]
updateNodeContextCategory
NodeContextCategoryMArgs
{
context_id
,
node_id
,
category
}
=
do
updateNodeContextCategory
NodeContextCategoryMArgs
{
context_id
,
node_id
,
category
}
=
do
_
<-
lift
$
DNC
.
updateNodeContextCategory
(
NodeId
context_id
)
(
NodeId
node_id
)
category
_
<-
lift
$
DNC
.
updateNodeContextCategory
(
NodeId
context_id
)
(
NodeId
node_id
)
category
...
...
src/Gargantext/API/GraphQL/PolicyCheck.hs
View file @
4ef66cea
...
@@ -8,7 +8,7 @@ import Gargantext.API.Admin.Auth.Types
...
@@ -8,7 +8,7 @@ import Gargantext.API.Admin.Auth.Types
import
Gargantext.API.Auth.PolicyCheck
import
Gargantext.API.Auth.PolicyCheck
import
Gargantext.API.GraphQL.Types
import
Gargantext.API.GraphQL.Types
import
Gargantext.API.Prelude
import
Gargantext.API.Prelude
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
HasConnectionPool
,
HasConfig
)
withPolicy
::
(
HasConnectionPool
env
,
HasConfig
env
)
withPolicy
::
(
HasConnectionPool
env
,
HasConfig
env
)
=>
AuthenticatedUser
=>
AuthenticatedUser
...
...
src/Gargantext/API/GraphQL/User.hs
View file @
4ef66cea
...
@@ -4,24 +4,21 @@
...
@@ -4,24 +4,21 @@
module
Gargantext.API.GraphQL.User
where
module
Gargantext.API.GraphQL.User
where
import
Data.Maybe
(
listToMaybe
)
import
Data.Maybe
(
listToMaybe
)
import
Data.Morpheus.Types
import
Data.Morpheus.Types
(
GQLType
,
lift
)
(
GQLType
,
lift
)
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.Admin.Auth.Types
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Auth.PolicyCheck
import
Gargantext.API.GraphQL.PolicyCheck
import
Gargantext.API.GraphQL.Types
import
Gargantext.API.GraphQL.Types
import
Gargantext.Core.Types.Individu
qualified
as
Individu
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataUser
(
..
))
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataUser
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
NodeId
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
NodeId
(
..
))
import
Gargantext.Database.Prelude
(
CmdCommon
)
import
Gargantext.Database.Prelude
(
CmdCommon
)
import
Gargantext.Database.Query.Table.User
qualified
as
DBUser
import
Gargantext.Database.Schema.User
(
UserLight
(
..
))
import
Gargantext.Database.Schema.User
(
UserLight
(
..
))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
qualified
Gargantext.Core.Types.Individu
as
Individu
import
qualified
Gargantext.Database.Query.Table.User
as
DBUser
import
Gargantext.API.Admin.Auth.Types
import
Gargantext.API.Auth.PolicyCheck
import
Gargantext.API.GraphQL.PolicyCheck
data
User
m
=
User
data
User
m
=
User
{
u_email
::
Text
{
u_email
::
Text
...
@@ -54,8 +51,7 @@ resolveUsers autUser mgr UserArgs { user_id } = do
...
@@ -54,8 +51,7 @@ resolveUsers autUser mgr UserArgs { user_id } = do
withPolicy
autUser
mgr
alwaysAllow
$
dbUsers
user_id
withPolicy
autUser
mgr
alwaysAllow
$
dbUsers
user_id
-- | Inner function to fetch the user from DB.
-- | Inner function to fetch the user from DB.
dbUsers
dbUsers
::
(
CmdCommon
env
)
::
(
CmdCommon
env
)
=>
Int
->
GqlM
e
env
[
User
(
GqlM
e
env
)]
=>
Int
->
GqlM
e
env
[
User
(
GqlM
e
env
)]
dbUsers
user_id
=
lift
(
map
toUser
<$>
DBUser
.
getUsersWithId
(
Individu
.
RootId
$
NodeId
user_id
))
dbUsers
user_id
=
lift
(
map
toUser
<$>
DBUser
.
getUsersWithId
(
Individu
.
RootId
$
NodeId
user_id
))
...
...
src/Gargantext/API/Metrics.hs
View file @
4ef66cea
...
@@ -35,7 +35,7 @@ import Gargantext.Core.Viz.Types
...
@@ -35,7 +35,7 @@ import Gargantext.Core.Viz.Types
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataList
(
..
),
hl_chart
,
hl_pie
,
hl_scatter
,
hl_tree
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataList
(
..
),
hl_chart
,
hl_pie
,
hl_scatter
,
hl_tree
)
import
Gargantext.Database.Admin.Types.Metrics
(
ChartMetrics
(
..
),
Metric
(
..
),
Metrics
(
..
))
import
Gargantext.Database.Admin.Types.Metrics
(
ChartMetrics
(
..
),
Metric
(
..
),
Metrics
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DBCmd
)
import
Gargantext.Database.Query.Table.Node
(
defaultList
,
getNodeWith
)
import
Gargantext.Database.Query.Table.Node
(
defaultList
,
getNodeWith
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
...
@@ -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 @
4ef66cea
...
@@ -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/List.hs
View file @
4ef66cea
...
@@ -16,12 +16,18 @@ Portability : POSIX
...
@@ -16,12 +16,18 @@ Portability : POSIX
module
Gargantext.API.Ngrams.List
module
Gargantext.API.Ngrams.List
where
where
import
Data.ByteString.Lazy
qualified
as
BSL
import
Data.Csv
qualified
as
Csv
import
Data.Either
(
Either
(
..
))
import
Data.Either
(
Either
(
..
))
import
Data.HashMap.Strict
(
HashMap
)
import
Data.HashMap.Strict
(
HashMap
)
import
Data.HashMap.Strict
qualified
as
HashMap
import
Data.Map.Strict
(
Map
,
toList
)
import
Data.Map.Strict
(
Map
,
toList
)
import
Data.Map.Strict
qualified
as
Map
import
Data.Maybe
(
fromMaybe
)
import
Data.Maybe
(
fromMaybe
)
import
Data.Set
qualified
as
Set
import
Data.Text
(
Text
,
concat
,
pack
,
splitOn
)
import
Data.Text
(
Text
,
concat
,
pack
,
splitOn
)
import
Data.Vector
(
Vector
)
import
Data.Vector
(
Vector
)
import
Data.Vector
qualified
as
Vec
import
Gargantext.API.Admin.EnvTypes
(
Env
,
GargJob
(
..
))
import
Gargantext.API.Admin.EnvTypes
(
Env
,
GargJob
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Ngrams
(
setListNgrams
)
import
Gargantext.API.Ngrams
(
setListNgrams
)
...
@@ -34,25 +40,18 @@ import Gargantext.Core.NodeStory
...
@@ -34,25 +40,18 @@ import Gargantext.Core.NodeStory
import
Gargantext.Core.Types.Main
(
ListType
(
..
))
import
Gargantext.Core.Types.Main
(
ListType
(
..
))
import
Gargantext.Database.Action.Flow
(
reIndexWith
)
import
Gargantext.Database.Action.Flow
(
reIndexWith
)
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
-- import Gargantext.Database.Action.Metrics.NgramsByContext (refreshNgramsMaterialized)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
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.Schema.Ngrams
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Database.Schema.Node
(
_node_parent_id
)
import
Gargantext.Database.Schema.Node
(
_node_parent_id
)
import
Gargantext.Database.Types
(
Indexed
(
..
))
import
Gargantext.Database.Types
(
Indexed
(
..
))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Utils.Jobs
(
serveJobsAPI
,
MonadJobStatus
(
..
))
import
Gargantext.Utils.Jobs
(
serveJobsAPI
,
MonadJobStatus
(
..
))
import
Gargantext.Utils.Servant
qualified
as
GUS
import
Prelude
qualified
import
Protolude
qualified
as
P
import
Servant
import
Servant
import
qualified
Data.ByteString.Lazy
as
BSL
import
qualified
Data.Csv
as
Csv
import
qualified
Data.HashMap.Strict
as
HashMap
import
qualified
Data.Map.Strict
as
Map
import
qualified
Data.Set
as
Set
import
qualified
Data.Vector
as
Vec
import
qualified
Gargantext.Database.Query.Table.Ngrams
as
TableNgrams
import
qualified
Gargantext.Utils.Servant
as
GUS
import
qualified
Prelude
import
qualified
Protolude
as
P
------------------------------------------------------------------------
------------------------------------------------------------------------
type
GETAPI
=
Summary
"Get List"
type
GETAPI
=
Summary
"Get List"
:>
"lists"
:>
"lists"
...
@@ -120,7 +119,7 @@ getCsv lId = do
...
@@ -120,7 +119,7 @@ getCsv lId = do
------------------------------------------------------------------------
------------------------------------------------------------------------
-- TODO : purge list
-- TODO : purge list
-- TODO talk
-- TODO talk
setList
::
FlowCmdM
env
err
m
setList
::
HasNodeStory
env
err
m
=>
ListId
=>
ListId
->
NgramsList
->
NgramsList
->
m
Bool
->
m
Bool
...
@@ -197,7 +196,7 @@ parseCsvData lst = Map.fromList $ conv <$> lst
...
@@ -197,7 +196,7 @@ parseCsvData lst = Map.fromList $ conv <$> lst
}
}
)
)
csvPost
::
FlowCmdM
env
err
m
csvPost
::
HasNodeStory
env
err
m
=>
ListId
=>
ListId
->
Text
->
Text
->
m
(
Either
Text
()
)
->
m
(
Either
Text
()
)
...
@@ -236,7 +235,7 @@ csvPostAsync lId =
...
@@ -236,7 +235,7 @@ csvPostAsync lId =
-- | This is for debugging the CSV parser in the REPL
-- | This is for debugging the CSV parser in the REPL
importCsvFile
::
FlowCmdM
env
err
m
importCsvFile
::
(
HasNodeStory
env
err
m
)
=>
ListId
->
P
.
FilePath
->
m
(
Either
Text
()
)
=>
ListId
->
P
.
FilePath
->
m
(
Either
Text
()
)
importCsvFile
lId
fp
=
do
importCsvFile
lId
fp
=
do
contents
<-
liftBase
$
P
.
readFile
fp
contents
<-
liftBase
$
P
.
readFile
fp
...
...
src/Gargantext/API/Ngrams/Prelude.hs
View file @
4ef66cea
src/Gargantext/API/Ngrams/Tools.hs
View file @
4ef66cea
...
@@ -25,7 +25,7 @@ import Data.Validity
...
@@ -25,7 +25,7 @@ import Data.Validity
import
Gargantext.API.Ngrams.Types
import
Gargantext.API.Ngrams.Types
import
Gargantext.Core.NodeStory
import
Gargantext.Core.NodeStory
import
Gargantext.Core.Types
(
ListType
(
..
),
NodeId
,
NodeType
(
..
),
ListId
)
import
Gargantext.Core.Types
(
ListType
(
..
),
NodeId
,
NodeType
(
..
),
ListId
)
import
Gargantext.Database.Prelude
(
CmdM
,
HasConnectionPool
(
..
))
import
Gargantext.Database.Prelude
(
HasConnectionPool
(
..
))
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
qualified
Data.HashMap.Strict
as
HM
import
qualified
Data.HashMap.Strict
as
HM
...
@@ -229,7 +229,7 @@ getCoocByNgrams'' (Diagonal diag) (f1,f2) (m1,m2) =
...
@@ -229,7 +229,7 @@ getCoocByNgrams'' (Diagonal diag) (f1,f2) (m1,m2) =
------------------------------------------
------------------------------------------
migrateFromDirToDb
::
(
CmdM
env
err
m
)
-- , HasNodeStory env err m)
migrateFromDirToDb
::
(
HasNodeStory
env
err
m
)
-- , HasNodeStory env err m)
=>
m
()
=>
m
()
migrateFromDirToDb
=
do
migrateFromDirToDb
=
do
pool
<-
view
connPool
pool
<-
view
connPool
...
...
src/Gargantext/API/Node.hs
View file @
4ef66cea
...
@@ -37,12 +37,19 @@ import GHC.Generics (Generic)
...
@@ -37,12 +37,19 @@ import GHC.Generics (Generic)
import
Gargantext.API.Admin.Auth
(
withAccess
,
withPolicy
)
import
Gargantext.API.Admin.Auth
(
withAccess
,
withPolicy
)
import
Gargantext.API.Admin.Auth.Types
(
PathId
(
..
),
AuthenticatedUser
(
..
))
import
Gargantext.API.Admin.Auth.Types
(
PathId
(
..
),
AuthenticatedUser
(
..
))
import
Gargantext.API.Admin.EnvTypes
import
Gargantext.API.Admin.EnvTypes
import
Gargantext.API.Auth.PolicyCheck
import
Gargantext.API.Metrics
import
Gargantext.API.Metrics
import
Gargantext.API.Ngrams
(
TableNgramsApi
,
apiNgramsTableCorpus
)
import
Gargantext.API.Ngrams
(
TableNgramsApi
,
apiNgramsTableCorpus
)
import
Gargantext.API.Ngrams.Types
(
TabType
(
..
))
import
Gargantext.API.Ngrams.Types
(
TabType
(
..
))
import
Gargantext.API.Node.DocumentUpload
qualified
as
DocumentUpload
import
Gargantext.API.Node.DocumentsFromWriteNodes
qualified
as
DocumentsFromWriteNodes
import
Gargantext.API.Node.File
import
Gargantext.API.Node.File
import
Gargantext.API.Node.FrameCalcUpload
qualified
as
FrameCalcUpload
import
Gargantext.API.Node.New
import
Gargantext.API.Node.New
import
Gargantext.API.Node.Share
qualified
as
Share
import
Gargantext.API.Node.Update
qualified
as
Update
import
Gargantext.API.Prelude
import
Gargantext.API.Prelude
import
Gargantext.API.Search
qualified
as
Search
import
Gargantext.API.Table
import
Gargantext.API.Table
import
Gargantext.Core.Types
(
NodeTableResult
)
import
Gargantext.Core.Types
(
NodeTableResult
)
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Types.Individu
(
User
(
..
))
...
@@ -50,15 +57,17 @@ import Gargantext.Core.Types.Main (Tree, NodeTree)
...
@@ -50,15 +57,17 @@ import Gargantext.Core.Types.Main (Tree, NodeTree)
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Core.Viz.Phylo.API
(
PhyloAPI
,
phyloAPI
)
import
Gargantext.Core.Viz.Phylo.API
(
PhyloAPI
,
phyloAPI
)
import
Gargantext.Database.Action.Delete
qualified
as
Action
(
deleteNode
)
import
Gargantext.Database.Action.Flow.Pairing
(
pairing
)
import
Gargantext.Database.Action.Flow.Pairing
(
pairing
)
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
-- (Cmd, CmdM
)
import
Gargantext.Database.Prelude
(
Cmd
,
JSONB
)
import
Gargantext.Database.Query.Facet
(
FacetDoc
,
OrderBy
(
..
))
import
Gargantext.Database.Query.Facet
(
FacetDoc
,
OrderBy
(
..
))
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node.Children
(
getChildren
)
import
Gargantext.Database.Query.Table.Node.Children
(
getChildren
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Database.Query.Table.Node.Update
(
Update
(
..
),
update
)
import
Gargantext.Database.Query.Table.Node.Update
(
Update
(
..
),
update
)
import
Gargantext.Database.Query.Table.Node.Update
qualified
as
U
(
update
,
Update
(
..
))
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Database.Query.Table.NodeContext
(
nodeContextsCategory
,
nodeContextsScore
)
import
Gargantext.Database.Query.Table.NodeContext
(
nodeContextsCategory
,
nodeContextsScore
)
import
Gargantext.Database.Query.Table.NodeNode
import
Gargantext.Database.Query.Table.NodeNode
...
@@ -67,15 +76,6 @@ import Gargantext.Prelude
...
@@ -67,15 +76,6 @@ import Gargantext.Prelude
import
Servant
import
Servant
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
import
qualified
Gargantext.API.Node.DocumentUpload
as
DocumentUpload
import
qualified
Gargantext.API.Node.DocumentsFromWriteNodes
as
DocumentsFromWriteNodes
import
qualified
Gargantext.API.Node.FrameCalcUpload
as
FrameCalcUpload
import
qualified
Gargantext.API.Node.Share
as
Share
import
qualified
Gargantext.API.Node.Update
as
Update
import
qualified
Gargantext.API.Search
as
Search
import
qualified
Gargantext.Database.Action.Delete
as
Action
(
deleteNode
)
import
qualified
Gargantext.Database.Query.Table.Node.Update
as
U
(
update
,
Update
(
..
))
import
Gargantext.API.Auth.PolicyCheck
-- | Admin NodesAPI
-- | Admin NodesAPI
...
...
src/Gargantext/API/Node/Corpus/Export.hs
View file @
4ef66cea
...
@@ -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/New/File.hs
View file @
4ef66cea
...
@@ -32,7 +32,7 @@ import Servant.Swagger.Internal
...
@@ -32,7 +32,7 @@ import Servant.Swagger.Internal
import
Gargantext.API.Node.Corpus.New.Types
import
Gargantext.API.Node.Corpus.New.Types
import
Gargantext.Core.Types
(
TODO
)
import
Gargantext.Core.Types
(
TODO
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
-- (Cmd, CmdM
)
import
Gargantext.Database.Prelude
(
Cmd
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Prelude.Crypto.Hash
(
hash
)
import
Gargantext.Prelude.Crypto.Hash
(
hash
)
...
...
src/Gargantext/API/Node/Corpus/Searx.hs
View file @
4ef66cea
...
@@ -3,43 +3,46 @@
...
@@ -3,43 +3,46 @@
module
Gargantext.API.Node.Corpus.Searx
where
module
Gargantext.API.Node.Corpus.Searx
where
import
Control.Lens
(
view
)
import
Control.Lens
(
view
)
import
Data.Aeson
qualified
as
Aeson
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Either
(
Either
(
..
))
import
Data.Either
(
Either
(
..
))
import
Data.HashMap.Strict
qualified
as
HashMap
import
Data.Text
qualified
as
T
import
Data.Text
qualified
as
Text
import
Data.Time.Calendar
(
Day
,
toGregorian
)
import
Data.Time.Calendar
(
Day
,
toGregorian
)
import
Data.Time.Format
(
defaultTimeLocale
,
formatTime
,
parseTimeM
)
import
Data.Time.Format
(
defaultTimeLocale
,
formatTime
,
parseTimeM
)
import
Data.Tuple.Select
(
sel1
,
sel2
,
sel3
)
import
Data.Tuple.Select
(
sel1
,
sel2
,
sel3
)
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core.NLP
(
nlpServerGet
)
import
Gargantext.Core.NLP
(
HasNLPServer
,
nlpServerGet
)
import
Gargantext.Core.NodeStory
(
HasNodeStory
)
import
Gargantext.Core.Text.Corpus.API
qualified
as
API
import
Gargantext.Core.Text.List
(
buildNgramsLists
)
import
Gargantext.Core.Text.List
(
buildNgramsLists
)
import
Gargantext.Core.Text.List.Group.WithStem
(
{-StopSize(..),-}
GroupParams
(
..
))
import
Gargantext.Core.Text.List.Group.WithStem
(
{-StopSize(..),-}
GroupParams
(
..
))
import
Gargantext.Core.Text.Terms
(
TermType
(
..
))
import
Gargantext.Core.Text.Terms
(
TermType
(
..
))
import
Gargantext.Core.Types
(
HasInvalidError
)
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Database.Action.Flow
(
addDocumentsToHyperCorpus
)
--, DataText(..))
import
Gargantext.Database.Action.Flow
(
addDocumentsToHyperCorpus
)
--, DataText(..))
import
Gargantext.Database.Action.Flow.List
(
flowList_DbRepo
)
import
Gargantext.Database.Action.Flow.List
(
flowList_DbRepo
)
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
import
Gargantext.Database.Action.User
(
getUserId
)
import
Gargantext.Database.Action.User
(
getUserId
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Query.Table.Node
(
insertDefaultNodeIfNotExists
)
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataCorpus
)
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.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Tree.Error
(
HasTreeError
)
import
Gargantext.Database.Query.Tree.Root
(
getOrMk_RootWithCorpus
)
import
Gargantext.Database.Query.Tree.Root
(
getOrMk_RootWithCorpus
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Prelude.Config
import
Gargantext.Prelude.Config
import
Gargantext.Utils.Jobs
(
JobHandle
,
MonadJobStatus
(
..
))
import
Gargantext.Utils.Jobs
(
JobHandle
,
MonadJobStatus
(
..
))
import
Network.HTTP.Client
import
Network.HTTP.Client
import
Network.HTTP.Client.TLS
import
Network.HTTP.Client.TLS
import
Prelude
qualified
import
Protolude
(
catMaybes
,
encodeUtf8
,
rightToMaybe
,
Text
,
void
)
import
Protolude
(
catMaybes
,
encodeUtf8
,
rightToMaybe
,
Text
,
void
)
import
qualified
Data.Aeson
as
Aeson
import
qualified
Data.HashMap.Strict
as
HashMap
import
qualified
Data.Text
as
T
import
qualified
Data.Text
as
Text
import
qualified
Gargantext.Core.Text.Corpus.API
as
API
import
qualified
Prelude
langToSearx
::
Lang
->
Text
langToSearx
::
Lang
->
Text
langToSearx
All
=
"en-US"
langToSearx
All
=
"en-US"
...
@@ -108,7 +111,12 @@ fetchSearxPage (FetchSearxParams { _fsp_language
...
@@ -108,7 +111,12 @@ fetchSearxPage (FetchSearxParams { _fsp_language
let
dec
=
Aeson
.
eitherDecode
$
responseBody
res
::
(
Either
Prelude
.
String
SearxResponse
)
let
dec
=
Aeson
.
eitherDecode
$
responseBody
res
::
(
Either
Prelude
.
String
SearxResponse
)
pure
dec
pure
dec
insertSearxResponse
::
(
MonadBase
IO
m
,
FlowCmdM
env
err
m
)
insertSearxResponse
::
(
MonadBase
IO
m
,
HasNodeStory
env
err
m
,
HasNLPServer
env
,
HasNodeError
err
,
HasTreeError
err
,
HasInvalidError
err
)
=>
User
=>
User
->
CorpusId
->
CorpusId
->
ListId
->
ListId
...
@@ -145,7 +153,13 @@ insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) =
...
@@ -145,7 +153,13 @@ insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) =
pure
()
pure
()
-- TODO Make an async task out of this?
-- TODO Make an async task out of this?
triggerSearxSearch
::
(
MonadBase
IO
m
,
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
triggerSearxSearch
::
(
MonadBase
IO
m
,
HasNodeStory
env
err
m
,
HasNLPServer
env
,
HasNodeError
err
,
HasTreeError
err
,
HasInvalidError
err
,
MonadJobStatus
m
)
=>
User
=>
User
->
CorpusId
->
CorpusId
->
API
.
RawQuery
->
API
.
RawQuery
...
@@ -167,12 +181,7 @@ triggerSearxSearch user cId q l jobHandle = do
...
@@ -167,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/API/Node/Corpus/Update.hs
View file @
4ef66cea
...
@@ -9,7 +9,7 @@ import Data.Proxy
...
@@ -9,7 +9,7 @@ import Data.Proxy
import
Gargantext.Core
import
Gargantext.Core
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DbCmd
'
)
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
...
...
src/Gargantext/API/Node/New.hs
View file @
4ef66cea
...
@@ -36,7 +36,7 @@ import Gargantext.API.Prelude
...
@@ -36,7 +36,7 @@ import Gargantext.API.Prelude
import
Gargantext.Database.Action.Flow.Types
import
Gargantext.Database.Action.Flow.Types
import
Gargantext.Database.Action.Node
import
Gargantext.Database.Action.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
Cmd
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Database.Query.Table.Node.User
import
Gargantext.Database.Query.Table.Node.User
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
...
...
src/Gargantext/API/Node/Share.hs
View file @
4ef66cea
...
@@ -27,7 +27,7 @@ import Gargantext.Database.Action.Share as DB (shareNodeWith, unPublish)
...
@@ -27,7 +27,7 @@ import Gargantext.Database.Action.Share as DB (shareNodeWith, unPublish)
import
Gargantext.Database.Action.User
import
Gargantext.Database.Action.User
import
Gargantext.Database.Action.User.New
import
Gargantext.Database.Action.User.New
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
CmdRandom
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Database.Query.Tree
(
findNodesWithType
)
import
Gargantext.Database.Query.Tree
(
findNodesWithType
)
import
Gargantext.Prelude
import
Gargantext.Prelude
...
...
src/Gargantext/API/Prelude.hs
View file @
4ef66cea
...
@@ -25,31 +25,31 @@ import Control.Exception (Exception)
...
@@ -25,31 +25,31 @@ import Control.Exception (Exception)
import
Control.Lens
(
Prism
'
,
(
#
))
import
Control.Lens
(
Prism
'
,
(
#
))
import
Control.Lens.TH
(
makePrisms
)
import
Control.Lens.TH
(
makePrisms
)
import
Control.Monad
(
mapM_
)
import
Control.Monad
(
mapM_
)
import
Control.Monad.Error.Class
(
MonadError
(
..
))
import
Control.Monad.Except
(
ExceptT
)
import
Control.Monad.Except
(
ExceptT
)
import
Control.Monad.Reader
(
ReaderT
)
import
Control.Monad.Reader
(
ReaderT
)
import
Control.Monad.Error.Class
(
MonadError
(
..
))
import
Crypto.JOSE.Error
as
Jose
import
Crypto.JOSE.Error
as
Jose
import
Data.Aeson.Types
import
Data.Aeson.Types
import
qualified
Data.Text
as
Text
import
Data.Typeable
import
Data.Typeable
import
Data.Validity
import
Data.Validity
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Types
import
Gargantext.API.Admin.Types
import
Gargantext.Core.Mail.Types
(
HasMail
)
import
Gargantext.Core.NLP
(
HasNLPServer
)
import
Gargantext.Core.NLP
(
HasNLPServer
)
import
Gargantext.Core.NodeStory
import
Gargantext.Core.NodeStory
import
Gargantext.Core.Mail.Types
(
HasMail
)
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
CmdM
,
CmdRandom
,
HasConnectionPool
,
HasConfig
)
import
Gargantext.Database.Query.Table.Node.Error
(
NodeError
(
..
),
HasNodeError
(
..
))
import
Gargantext.Database.Query.Table.Node.Error
(
NodeError
(
..
),
HasNodeError
(
..
))
import
Gargantext.Database.Query.Tree
import
Gargantext.Database.Query.Tree
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.System.Logging
import
Gargantext.Utils.Jobs.Monad
(
MonadJobStatus
(
..
),
JobHandle
)
import
Gargantext.Utils.Jobs.Monad
(
MonadJobStatus
(
..
),
JobHandle
)
import
qualified
Gargantext.Utils.Jobs.Mona
d
as
Jobs
import
Gargantext.Utils.Jobs.Monad
qualifie
d
as
Jobs
import
Servant
import
Servant
import
Servant.Job.Async
import
Servant.Job.Async
import
Servant.Job.Core
(
HasServerError
(
..
),
serverError
)
import
Servant.Job.Core
(
HasServerError
(
..
),
serverError
)
import
qualified
Servant.Job.Types
as
SJ
import
Servant.Job.Types
qualified
as
SJ
import
Gargantext.System.Logging
import
qualified
Data.Text
as
Text
class
HasJoseError
e
where
class
HasJoseError
e
where
_JoseError
::
Prism'
e
Jose
.
Error
_JoseError
::
Prism'
e
Jose
.
Error
...
...
src/Gargantext/API/Public.hs
View file @
4ef66cea
...
@@ -34,7 +34,7 @@ import qualified Data.Set as Set
...
@@ -34,7 +34,7 @@ import qualified Data.Set as Set
import
Gargantext.API.Prelude
import
Gargantext.API.Prelude
import
Gargantext.API.Node.File
import
Gargantext.API.Node.File
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
Cmd
,
DBCmd
)
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata.CorpusField
import
Gargantext.Database.Admin.Types.Hyperdata.CorpusField
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
...
@@ -79,7 +79,7 @@ api_node nId = do
...
@@ -79,7 +79,7 @@ api_node nId = do
selectPublic
::
HasNodeError
err
selectPublic
::
HasNodeError
err
=>
Cmd
err
[(
Node
HyperdataFolder
,
Maybe
Int
)]
=>
DB
Cmd
err
[(
Node
HyperdataFolder
,
Maybe
Int
)]
selectPublic
=
selectPublicNodes
selectPublic
=
selectPublicNodes
-- For tests only
-- For tests only
...
...
src/Gargantext/API/Table.hs
View file @
4ef66cea
...
@@ -35,12 +35,8 @@ import Data.Aeson.TH (deriveJSON)
...
@@ -35,12 +35,8 @@ import Data.Aeson.TH (deriveJSON)
import
Data.Maybe
import
Data.Maybe
import
Data.Swagger
import
Data.Swagger
import
Data.Text
(
Text
())
import
Data.Text
(
Text
())
import
Data.Text
qualified
as
T
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Prelude
import
Servant
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
import
Gargantext.API.HashedResponse
import
Gargantext.API.HashedResponse
import
Gargantext.API.Ngrams.Types
(
TabType
(
..
))
import
Gargantext.API.Ngrams.Types
(
TabType
(
..
))
import
Gargantext.API.Prelude
(
GargServer
)
import
Gargantext.API.Prelude
(
GargServer
)
...
@@ -51,12 +47,15 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
...
@@ -51,12 +47,15 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import
Gargantext.Database.Action.Learn
(
FavOrTrash
(
..
),
moreLike
)
import
Gargantext.Database.Action.Learn
(
FavOrTrash
(
..
),
moreLike
)
import
Gargantext.Database.Action.Search
import
Gargantext.Database.Action.Search
import
Gargantext.Database.Admin.Types.Node
hiding
(
ERROR
,
DEBUG
)
import
Gargantext.Database.Admin.Types.Node
hiding
(
ERROR
,
DEBUG
)
import
Gargantext.Database.Prelude
-- (Cmd, CmdM
)
import
Gargantext.Database.Prelude
(
CmdM
,
DbCmd
'
,
DBCmd
)
import
Gargantext.Database.Query.Facet
(
FacetDoc
,
runViewDocuments
,
runCountDocuments
,
OrderBy
(
..
),
runViewAuthorsDoc
)
import
Gargantext.Database.Query.Facet
(
FacetDoc
,
runViewDocuments
,
runCountDocuments
,
OrderBy
(
..
),
runViewAuthorsDoc
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.System.Logging
import
Gargantext.System.Logging
import
qualified
Data.Text
as
T
import
Prelude
import
Servant
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -156,7 +155,7 @@ getTableHashApi cId tabType = do
...
@@ -156,7 +155,7 @@ getTableHashApi cId tabType = do
HashedResponse
{
hash
=
h
}
<-
getTableApi
cId
tabType
Nothing
Nothing
Nothing
Nothing
Nothing
HashedResponse
{
hash
=
h
}
<-
getTableApi
cId
tabType
Nothing
Nothing
Nothing
Nothing
Nothing
pure
h
pure
h
searchInCorpus'
::
(
CmdM
env
err
m
,
MonadLogger
m
)
searchInCorpus'
::
(
DbCmd'
env
err
m
,
MonadLogger
m
)
=>
CorpusId
=>
CorpusId
->
Bool
->
Bool
->
RawQuery
->
RawQuery
...
@@ -185,7 +184,7 @@ getTable :: HasNodeError err
...
@@ -185,7 +184,7 @@ getTable :: HasNodeError err
->
Maybe
OrderBy
->
Maybe
OrderBy
->
Maybe
RawQuery
->
Maybe
RawQuery
->
Maybe
Text
->
Maybe
Text
->
Cmd
err
FacetTableResult
->
DB
Cmd
err
FacetTableResult
getTable
cId
ft
o
l
order
raw_query
year
=
do
getTable
cId
ft
o
l
order
raw_query
year
=
do
docs
<-
getTable'
cId
ft
o
l
order
query
year
docs
<-
getTable'
cId
ft
o
l
order
query
year
docsCount
<-
runCountDocuments
cId
(
ft
==
Just
Trash
)
query
year
docsCount
<-
runCountDocuments
cId
(
ft
==
Just
Trash
)
query
year
...
@@ -201,7 +200,7 @@ getTable' :: HasNodeError err
...
@@ -201,7 +200,7 @@ getTable' :: HasNodeError err
->
Maybe
OrderBy
->
Maybe
OrderBy
->
Maybe
Text
->
Maybe
Text
->
Maybe
Text
->
Maybe
Text
->
Cmd
err
[
FacetDoc
]
->
DB
Cmd
err
[
FacetDoc
]
getTable'
cId
ft
o
l
order
query
year
=
getTable'
cId
ft
o
l
order
query
year
=
case
ft
of
case
ft
of
(
Just
Docs
)
->
runViewDocuments
cId
False
o
l
order
query
year
(
Just
Docs
)
->
runViewDocuments
cId
False
o
l
order
query
year
...
@@ -213,7 +212,7 @@ getTable' cId ft o l order query year =
...
@@ -213,7 +212,7 @@ getTable' cId ft o l order query year =
getPair
::
ContactId
->
Maybe
TabType
getPair
::
ContactId
->
Maybe
TabType
->
Maybe
Offset
->
Maybe
Limit
->
Maybe
Offset
->
Maybe
Limit
->
Maybe
OrderBy
->
Cmd
err
[
FacetDoc
]
->
Maybe
OrderBy
->
DB
Cmd
err
[
FacetDoc
]
getPair
cId
ft
o
l
order
=
getPair
cId
ft
o
l
order
=
case
ft
of
case
ft
of
(
Just
Docs
)
->
runViewAuthorsDoc
cId
False
o
l
order
(
Just
Docs
)
->
runViewAuthorsDoc
cId
False
o
l
order
...
...
src/Gargantext/Core/Mail.hs
View file @
4ef66cea
...
@@ -14,16 +14,16 @@ module Gargantext.Core.Mail where
...
@@ -14,16 +14,16 @@ module Gargantext.Core.Mail where
import
Control.Lens
(
view
)
import
Control.Lens
(
view
)
import
Control.Monad.Reader
(
MonadReader
)
import
Control.Monad.Reader
(
MonadReader
)
import
Control.Monad.Trans.Control
(
MonadBaseControl
)
import
Control.Monad.Trans.Control
(
MonadBaseControl
)
import
Network.URI.Encode
(
encodeText
)
import
Data.List
qualified
as
List
import
Data.Text
(
Text
,
unlines
,
splitOn
)
import
Data.Text
(
Text
,
unlines
,
splitOn
)
import
Gargantext.Core.Types.Individu
import
Gargantext.Core.Types.Individu
import
Gargantext.Database.Prelude
(
HasConfig
(
..
))
import
Gargantext.Database.Schema.User
(
UserLight
(
..
))
import
Gargantext.Database.Schema.User
(
UserLight
(
..
))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Prelude.Config
(
gc_url
,
gc_backend_name
)
import
Gargantext.Prelude.Config
(
gc_url
,
gc_backend_name
)
import
Gargantext.Database.Prelude
import
Gargantext.Prelude.Mail
(
gargMail
,
GargMail
(
..
))
import
Gargantext.Prelude.Mail
(
gargMail
,
GargMail
(
..
))
import
Gargantext.Prelude.Mail.Types
(
MailConfig
)
import
Gargantext.Prelude.Mail.Types
(
MailConfig
)
import
qualified
Data.List
as
List
import
Network.URI.Encode
(
encodeText
)
-- | Tool to put elsewhere
-- | Tool to put elsewhere
...
...
src/Gargantext/Core/NodeStoryFile.hs
View file @
4ef66cea
...
@@ -23,7 +23,7 @@ import Control.Concurrent (MVar(), modifyMVar_, newMVar, readMVar, withMVar)
...
@@ -23,7 +23,7 @@ import Control.Concurrent (MVar(), modifyMVar_, newMVar, readMVar, withMVar)
import
Control.Debounce
(
mkDebounce
,
defaultDebounceSettings
,
debounceFreq
,
debounceAction
)
import
Control.Debounce
(
mkDebounce
,
defaultDebounceSettings
,
debounceFreq
,
debounceAction
)
import
Gargantext.Core.NodeStory
hiding
(
readNodeStoryEnv
)
import
Gargantext.Core.NodeStory
hiding
(
readNodeStoryEnv
)
import
Gargantext.Core.Types
(
ListId
,
NodeId
(
..
))
import
Gargantext.Core.Types
(
ListId
,
NodeId
(
..
))
import
Gargantext.Database.Prelude
(
CmdM
,
hasConfig
)
import
Gargantext.Database.Prelude
(
hasConfig
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Prelude.Config
(
gc_repofilepath
)
import
Gargantext.Prelude.Config
(
gc_repofilepath
)
import
System.Directory
(
renameFile
,
createDirectoryIfMissing
,
doesFileExist
,
removeFile
)
import
System.Directory
(
renameFile
,
createDirectoryIfMissing
,
doesFileExist
,
removeFile
)
...
@@ -46,7 +46,7 @@ getRepo listIds = do
...
@@ -46,7 +46,7 @@ getRepo listIds = do
-- v' <- liftBase $ readMVar v
-- v' <- liftBase $ readMVar v
-- pure $ v'
-- pure $ v'
getRepoReadConfig
::
(
CmdM
env
err
m
)
getRepoReadConfig
::
(
HasNodeStory
env
err
m
)
=>
[
ListId
]
->
m
NodeListStory
=>
[
ListId
]
->
m
NodeListStory
getRepoReadConfig
listIds
=
do
getRepoReadConfig
listIds
=
do
repoFP
<-
view
$
hasConfig
.
gc_repofilepath
repoFP
<-
view
$
hasConfig
.
gc_repofilepath
...
...
src/Gargantext/Core/Text/List.hs
View file @
4ef66cea
...
@@ -18,14 +18,19 @@ module Gargantext.Core.Text.List
...
@@ -18,14 +18,19 @@ module Gargantext.Core.Text.List
import
Control.Lens
hiding
(
both
)
-- ((^.), view, over, set, (_1), (_2))
import
Control.Lens
hiding
(
both
)
-- ((^.), view, over, set, (_1), (_2))
import
Data.HashMap.Strict
(
HashMap
)
import
Data.HashMap.Strict
(
HashMap
)
import
Data.HashMap.Strict
qualified
as
HashMap
import
Data.HashSet
(
HashSet
)
import
Data.HashSet
(
HashSet
)
import
Data.HashSet
qualified
as
HashSet
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.Monoid
(
mempty
)
import
Data.Monoid
(
mempty
)
import
Data.Ord
(
Down
(
..
))
import
Data.Ord
(
Down
(
..
))
import
Data.Set
(
Set
)
import
Data.Set
(
Set
)
-- import Data.Text (Text)
import
Data.Set
qualified
as
Set
import
Data.Tuple.Extra
(
both
)
import
Data.Tuple.Extra
(
both
)
import
Gargantext.API.Ngrams.Types
(
NgramsElement
,
NgramsTerm
(
..
))
import
Gargantext.API.Ngrams.Types
(
NgramsElement
,
NgramsTerm
(
..
))
import
Gargantext.Core.NLP
(
HasNLPServer
)
import
Gargantext.Core.NodeStory
import
Gargantext.Core.NodeStory
import
Gargantext.Core.Text
(
size
)
import
Gargantext.Core.Text
(
size
)
import
Gargantext.Core.Text.List.Group
import
Gargantext.Core.Text.List.Group
...
@@ -36,10 +41,11 @@ import Gargantext.Core.Text.List.Social.Prelude
...
@@ -36,10 +41,11 @@ import Gargantext.Core.Text.List.Social.Prelude
import
Gargantext.Core.Text.Metrics
(
scored'
,
Scored
(
..
),
scored_speExc
,
scored_genInc
,
normalizeGlobal
,
normalizeLocal
,
scored_terms
)
import
Gargantext.Core.Text.Metrics
(
scored'
,
Scored
(
..
),
scored_speExc
,
scored_genInc
,
normalizeGlobal
,
normalizeLocal
,
scored_terms
)
import
Gargantext.Core.Types
(
ListType
(
..
),
MasterCorpusId
,
UserCorpusId
)
import
Gargantext.Core.Types
(
ListType
(
..
),
MasterCorpusId
,
UserCorpusId
)
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Data.HashMap.Strict.Utils
qualified
as
HashMap
import
Gargantext.Database.Action.Metrics.NgramsByContext
(
getContextsByNgramsUser
,
getContextsByNgramsOnlyUser
)
import
Gargantext.Database.Action.Metrics.NgramsByContext
(
getContextsByNgramsUser
,
getContextsByNgramsOnlyUser
)
import
Gargantext.Database.Action.Metrics.TFICF
(
getTficf_withSample
)
import
Gargantext.Database.Action.Metrics.TFICF
(
getTficf_withSample
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.Database.Prelude
(
CmdM
)
import
Gargantext.Database.Prelude
(
DBCmd
)
import
Gargantext.Database.Query.Table.Ngrams
(
text2ngrams
)
import
Gargantext.Database.Query.Table.Ngrams
(
text2ngrams
)
import
Gargantext.Database.Query.Table.NgramsPostag
(
selectLems
)
import
Gargantext.Database.Query.Table.NgramsPostag
(
selectLems
)
import
Gargantext.Database.Query.Table.Node
(
defaultList
)
import
Gargantext.Database.Query.Table.Node
(
defaultList
)
...
@@ -47,12 +53,6 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
...
@@ -47,12 +53,6 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
import
Gargantext.Database.Query.Tree.Error
(
HasTreeError
)
import
Gargantext.Database.Query.Tree.Error
(
HasTreeError
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
),
Ngrams
(
..
))
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
),
Ngrams
(
..
))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
qualified
Data.HashMap.Strict
as
HashMap
import
qualified
Data.HashSet
as
HashSet
import
qualified
Data.List
as
List
import
qualified
Data.Map.Strict
as
Map
import
qualified
Data.Set
as
Set
import
qualified
Gargantext.Data.HashMap.Strict.Utils
as
HashMap
{-
{-
-- TODO maybe useful for later
-- TODO maybe useful for later
...
@@ -65,7 +65,7 @@ isStopTerm (StopSize n) x = Text.length x < n || any isStopChar (Text.unpack x)
...
@@ -65,7 +65,7 @@ isStopTerm (StopSize n) x = Text.length x < n || any isStopChar (Text.unpack x)
-- | TODO improve grouping functions of Authors, Sources, Institutes..
-- | TODO improve grouping functions of Authors, Sources, Institutes..
buildNgramsLists
::
(
HasNodeStory
env
err
m
buildNgramsLists
::
(
HasNodeStory
env
err
m
,
CmdM
env
err
m
,
HasNLPServer
env
,
HasTreeError
err
,
HasTreeError
err
,
HasNodeError
err
,
HasNodeError
err
)
)
...
@@ -90,7 +90,7 @@ data MapListSize = MapListSize { unMapListSize :: !Int }
...
@@ -90,7 +90,7 @@ data MapListSize = MapListSize { unMapListSize :: !Int }
data
MaxListSize
=
MaxListSize
{
unMaxListSize
::
!
Int
}
data
MaxListSize
=
MaxListSize
{
unMaxListSize
::
!
Int
}
buildNgramsOthersList
::
(
HasNodeError
err
buildNgramsOthersList
::
(
HasNodeError
err
,
CmdM
env
err
m
,
HasNLPServer
env
,
HasNodeStory
env
err
m
,
HasNodeStory
env
err
m
,
HasTreeError
err
,
HasTreeError
err
)
)
...
@@ -134,11 +134,9 @@ buildNgramsOthersList user uCid mfslw _groupParams (nt, MapListSize mapListSize,
...
@@ -134,11 +134,9 @@ buildNgramsOthersList user uCid mfslw _groupParams (nt, MapListSize mapListSize,
getGroupParams
::
(
HasNodeError
err
getGroupParams
::
(
HasNodeError
err
,
CmdM
env
err
m
,
HasNodeStory
env
err
m
,
HasTreeError
err
,
HasTreeError
err
)
)
=>
GroupParams
->
HashSet
Ngrams
->
m
GroupParams
=>
GroupParams
->
HashSet
Ngrams
->
DBCmd
err
GroupParams
getGroupParams
gp
@
(
GroupWithPosTag
l
nsc
_m
)
ng
=
do
getGroupParams
gp
@
(
GroupWithPosTag
l
nsc
_m
)
ng
=
do
!
hashMap
<-
HashMap
.
fromList
<$>
selectLems
l
nsc
(
HashSet
.
toList
ng
)
!
hashMap
<-
HashMap
.
fromList
<$>
selectLems
l
nsc
(
HashSet
.
toList
ng
)
-- printDebug "hashMap" hashMap
-- printDebug "hashMap" hashMap
...
@@ -148,7 +146,7 @@ getGroupParams gp _ = pure gp
...
@@ -148,7 +146,7 @@ getGroupParams gp _ = pure gp
-- TODO use ListIds
-- TODO use ListIds
buildNgramsTermsList
::
(
HasNodeError
err
buildNgramsTermsList
::
(
HasNodeError
err
,
CmdM
env
err
m
,
HasNLPServer
env
,
HasNodeStory
env
err
m
,
HasNodeStory
env
err
m
,
HasTreeError
err
,
HasTreeError
err
)
)
...
...
src/Gargantext/Core/Text/List/Social.hs
View file @
4ef66cea
...
@@ -17,29 +17,29 @@ import Control.Lens (view)
...
@@ -17,29 +17,29 @@ import Control.Lens (view)
import
Control.Monad
(
mzero
)
import
Control.Monad
(
mzero
)
import
Data.Aeson
import
Data.Aeson
import
Data.HashMap.Strict
(
HashMap
)
import
Data.HashMap.Strict
(
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.Monoid
(
mconcat
)
import
Data.Monoid
(
mconcat
)
import
Data.Pool
import
Data.Pool
import
Data.Swagger
import
Data.Swagger
import
Data.Text
qualified
as
T
import
Data.Vector
qualified
as
V
import
GHC.Generics
import
GHC.Generics
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
,
NgramsPatch
)
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
,
NgramsPatch
)
import
Gargantext.Core.NodeStory
(
HasNodeStory
,
getNodesArchiveHistory
)
import
Gargantext.Core.NodeStory
(
getNodesArchiveHistory
)
import
Gargantext.Core.Text.List.Social.Find
(
findListsId
)
import
Gargantext.Core.Text.List.Social.Find
(
findListsId
)
import
Gargantext.Core.Text.List.Social.Patch
(
addScorePatches
)
import
Gargantext.Core.Text.List.Social.Patch
(
addScorePatches
)
import
Gargantext.Core.Text.List.Social.Prelude
(
FlowCont
,
FlowListScores
)
import
Gargantext.Core.Text.List.Social.Prelude
(
FlowCont
,
FlowListScores
)
import
Gargantext.Core.Types.Individu
(
User
)
import
Gargantext.Core.Types.Individu
(
User
)
import
Gargantext.Database.Admin.Types.Node
(
ListId
,
NodeId
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
ListId
,
NodeId
(
..
))
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DBCmd
,
connPool
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Tree
(
NodeMode
(
Private
),
HasTreeError
)
import
Gargantext.Database.Query.Tree
(
NodeMode
(
Private
),
HasTreeError
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Test.QuickCheck
import
Test.QuickCheck
import
Web.Internal.HttpApiData
(
ToHttpApiData
,
FromHttpApiData
,
parseUrlPiece
,
toUrlPiece
)
import
Web.Internal.HttpApiData
(
ToHttpApiData
,
FromHttpApiData
,
parseUrlPiece
,
toUrlPiece
)
import
qualified
Data.List
as
List
import
qualified
Data.Map.Strict
as
Map
import
qualified
Data.Text
as
T
import
qualified
Data.Vector
as
V
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Main parameters
-- | Main parameters
...
@@ -116,84 +116,72 @@ keepAllParents _ = KeepAllParents True
...
@@ -116,84 +116,72 @@ keepAllParents _ = KeepAllParents True
-}
-}
------------------------------------------------------------------------
------------------------------------------------------------------------
flowSocialList
::
(
HasNodeStory
env
err
m
flowSocialList
::
(
HasNodeError
err
,
CmdM
env
err
m
,
HasNodeError
err
,
HasTreeError
err
,
HasTreeError
err
)
)
=>
Maybe
FlowSocialListWith
=>
Maybe
FlowSocialListWith
->
User
->
User
->
NgramsType
->
NgramsType
->
FlowCont
NgramsTerm
FlowListScores
->
FlowCont
NgramsTerm
FlowListScores
->
m
(
FlowCont
NgramsTerm
FlowListScores
)
->
DBCmd
err
(
FlowCont
NgramsTerm
FlowListScores
)
flowSocialList
Nothing
u
=
flowSocialList'
MySelfFirst
u
flowSocialList
Nothing
u
=
flowSocialList'
MySelfFirst
u
flowSocialList
(
Just
(
FlowSocialListWithPriority
p
))
u
=
flowSocialList'
p
u
flowSocialList
(
Just
(
FlowSocialListWithPriority
p
))
u
=
flowSocialList'
p
u
flowSocialList
(
Just
(
FlowSocialListWithLists
ls
))
_
=
getHistoryScores
ls
flowSocialList
(
Just
(
FlowSocialListWithLists
ls
))
_
=
getHistoryScores
ls
flowSocialList
(
Just
(
NoList
_
))
_u
=
panic
"[G.C.T.L.Social] Should not be executed"
flowSocialList
(
Just
(
NoList
_
))
_u
=
panic
"[G.C.T.L.Social] Should not be executed"
flowSocialList'
::
(
HasNodeStory
env
err
m
flowSocialList'
::
(
HasNodeError
err
,
CmdM
env
err
m
,
HasNodeError
err
,
HasTreeError
err
,
HasTreeError
err
)
)
=>
FlowSocialListPriority
=>
FlowSocialListPriority
->
User
->
NgramsType
->
User
->
NgramsType
->
FlowCont
NgramsTerm
FlowListScores
->
FlowCont
NgramsTerm
FlowListScores
->
m
(
FlowCont
NgramsTerm
FlowListScores
)
->
DBCmd
err
(
FlowCont
NgramsTerm
FlowListScores
)
flowSocialList'
flowPriority
user
nt
flc
=
flowSocialList'
flowPriority
user
nt
flc
=
mconcat
<$>
mapM
(
flowSocialListByMode'
user
nt
flc
)
mconcat
<$>
mapM
(
flowSocialListByMode'
user
nt
flc
)
(
flowSocialListPriority
flowPriority
)
(
flowSocialListPriority
flowPriority
)
where
where
flowSocialListByMode'
::
(
HasNodeStory
env
err
m
flowSocialListByMode'
::
(
HasNodeError
err
,
CmdM
env
err
m
,
HasNodeError
err
,
HasTreeError
err
,
HasTreeError
err
)
)
=>
User
->
NgramsType
=>
User
->
NgramsType
->
FlowCont
NgramsTerm
FlowListScores
->
FlowCont
NgramsTerm
FlowListScores
->
NodeMode
->
NodeMode
->
m
(
FlowCont
NgramsTerm
FlowListScores
)
->
DBCmd
err
(
FlowCont
NgramsTerm
FlowListScores
)
flowSocialListByMode'
user'
nt'
flc'
mode
=
flowSocialListByMode'
user'
nt'
flc'
mode
=
findListsId
user'
mode
findListsId
user'
mode
>>=
flowSocialListByModeWith
nt'
flc'
>>=
flowSocialListByModeWith
nt'
flc'
flowSocialListByModeWith
::
(
HasNodeStory
env
err
m
flowSocialListByModeWith
::
(
HasNodeError
err
,
CmdM
env
err
m
,
HasNodeError
err
,
HasTreeError
err
,
HasTreeError
err
)
)
=>
NgramsType
=>
NgramsType
->
FlowCont
NgramsTerm
FlowListScores
->
FlowCont
NgramsTerm
FlowListScores
->
[
ListId
]
->
[
ListId
]
->
m
(
FlowCont
NgramsTerm
FlowListScores
)
->
DBCmd
err
(
FlowCont
NgramsTerm
FlowListScores
)
flowSocialListByModeWith
nt''
flc''
listes
=
flowSocialListByModeWith
nt''
flc''
listes
=
getHistoryScores
listes
nt''
flc''
getHistoryScores
listes
nt''
flc''
-----------------------------------------------------------------
-----------------------------------------------------------------
getHistoryScores
::
(
HasNodeStory
env
err
m
getHistoryScores
::
(
HasNodeError
err
,
CmdM
env
err
m
,
HasNodeError
err
,
HasTreeError
err
,
HasTreeError
err
)
)
=>
[
ListId
]
=>
[
ListId
]
->
NgramsType
->
NgramsType
->
FlowCont
NgramsTerm
FlowListScores
->
FlowCont
NgramsTerm
FlowListScores
->
m
(
FlowCont
NgramsTerm
FlowListScores
)
->
DBCmd
err
(
FlowCont
NgramsTerm
FlowListScores
)
getHistoryScores
lists
nt
fl
=
getHistoryScores
lists
nt
fl
=
addScorePatches
nt
lists
fl
<$>
getHistory
[
nt
]
lists
addScorePatches
nt
lists
fl
<$>
getHistory
[
nt
]
lists
getHistory
::
(
HasNodeStory
env
err
m
getHistory
::
(
HasNodeError
err
,
CmdM
env
err
m
,
HasNodeError
err
,
HasTreeError
err
,
HasTreeError
err
)
)
=>
[
NgramsType
]
=>
[
NgramsType
]
->
[
ListId
]
->
[
ListId
]
->
m
(
Map
ListId
(
Map
NgramsType
[
HashMap
NgramsTerm
NgramsPatch
]))
->
DBCmd
err
(
Map
ListId
(
Map
NgramsType
[
HashMap
NgramsTerm
NgramsPatch
]))
getHistory
types
listsId
=
do
getHistory
types
listsId
=
do
pool
<-
view
connPool
pool
<-
view
connPool
nsp
<-
liftBase
$
withResource
pool
$
\
c
->
getNodesArchiveHistory
c
listsId
nsp
<-
liftBase
$
withResource
pool
$
\
c
->
getNodesArchiveHistory
c
listsId
...
...
src/Gargantext/Core/Text/List/Social/Find.hs
View file @
4ef66cea
...
@@ -17,7 +17,7 @@ import Control.Lens (view)
...
@@ -17,7 +17,7 @@ import Control.Lens (view)
import
Gargantext.Core.Types.Individu
import
Gargantext.Core.Types.Individu
import
Gargantext.Database.Admin.Config
import
Gargantext.Database.Admin.Config
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DBCmd
)
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Query.Tree
import
Gargantext.Database.Query.Tree
import
Gargantext.Database.Query.Tree.Root
(
getRootId
)
import
Gargantext.Database.Query.Tree.Root
(
getRootId
)
...
@@ -25,7 +25,7 @@ import Gargantext.Prelude
...
@@ -25,7 +25,7 @@ import Gargantext.Prelude
------------------------------------------------------------------------
------------------------------------------------------------------------
findListsId
::
(
HasNodeError
err
,
HasTreeError
err
)
findListsId
::
(
HasNodeError
err
,
HasTreeError
err
)
=>
User
->
NodeMode
->
Cmd
err
[
NodeId
]
=>
User
->
NodeMode
->
DB
Cmd
err
[
NodeId
]
findListsId
u
mode
=
do
findListsId
u
mode
=
do
rootId
<-
getRootId
u
rootId
<-
getRootId
u
ns
<-
map
(
view
dt_nodeId
)
<$>
filter
((
==
nodeTypeId
NodeList
)
.
(
view
dt_typeId
))
ns
<-
map
(
view
dt_nodeId
)
<$>
filter
((
==
nodeTypeId
NodeList
)
.
(
view
dt_typeId
))
...
@@ -40,7 +40,7 @@ findListsId u mode = do
...
@@ -40,7 +40,7 @@ findListsId u mode = do
findNodes'
::
(
HasTreeError
err
,
HasNodeError
err
)
findNodes'
::
(
HasTreeError
err
,
HasNodeError
err
)
=>
RootId
=>
RootId
->
NodeMode
->
NodeMode
->
Cmd
err
[
DbTreeNode
]
->
DB
Cmd
err
[
DbTreeNode
]
findNodes'
r
Private
=
do
findNodes'
r
Private
=
do
pv
<-
(
findNodes
r
Private
$
[
NodeFolderPrivate
]
<>
commonNodes
)
pv
<-
(
findNodes
r
Private
$
[
NodeFolderPrivate
]
<>
commonNodes
)
sh
<-
(
findNodes'
r
Shared
)
sh
<-
(
findNodes'
r
Shared
)
...
@@ -52,3 +52,5 @@ findNodes' r PublicDirect = findNodes r Public $ [NodeFolderPublic ] <
...
@@ -52,3 +52,5 @@ findNodes' r PublicDirect = findNodes r Public $ [NodeFolderPublic ] <
commonNodes
::
[
NodeType
]
commonNodes
::
[
NodeType
]
commonNodes
=
[
NodeFolder
,
NodeCorpus
,
NodeList
,
NodeFolderShared
,
NodeTeam
]
commonNodes
=
[
NodeFolder
,
NodeCorpus
,
NodeList
,
NodeFolderShared
,
NodeTeam
]
src/Gargantext/Core/Viz/Chart.hs
View file @
4ef66cea
...
@@ -25,7 +25,7 @@ import Gargantext.Core.NodeStory (HasNodeStory)
...
@@ -25,7 +25,7 @@ import Gargantext.Core.NodeStory (HasNodeStory)
import
Gargantext.Core.Text.Metrics.Count
(
occurrencesWith
)
import
Gargantext.Core.Text.Metrics.Count
(
occurrencesWith
)
import
Gargantext.Core.Types.Main
import
Gargantext.Core.Types.Main
import
Gargantext.Database.Admin.Config
import
Gargantext.Database.Admin.Config
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DBCmd
)
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node.Select
import
Gargantext.Database.Query.Table.Node.Select
import
Gargantext.Database.Query.Table.NodeContext
(
selectDocsDates
)
import
Gargantext.Database.Query.Table.NodeContext
(
selectDocsDates
)
...
...
src/Gargantext/Core/Viz/Graph/API.hs
View file @
4ef66cea
...
@@ -108,7 +108,7 @@ getGraph _uId nId = do
...
@@ -108,7 +108,7 @@ getGraph _uId nId = do
let
defaultEdgesStrength
=
Strong
let
defaultEdgesStrength
=
Strong
let
defaultBridgenessMethod
=
BridgenessMethod_Basic
let
defaultBridgenessMethod
=
BridgenessMethod_Basic
graph'
<-
computeGraph
cId
defaultPartitionMethod
defaultBridgenessMethod
(
withMetric
defaultMetric
)
defaultEdgesStrength
(
NgramsTerms
,
NgramsTerms
)
repo
graph'
<-
computeGraph
cId
defaultPartitionMethod
defaultBridgenessMethod
(
withMetric
defaultMetric
)
defaultEdgesStrength
(
NgramsTerms
,
NgramsTerms
)
repo
mt
<-
defaultGraphMetadata
cId
"Title"
repo
defaultMetric
defaultEdgesStrength
mt
<-
defaultGraphMetadata
cId
listId
"Title"
repo
defaultMetric
defaultEdgesStrength
let
let
graph''
=
set
graph_metadata
(
Just
mt
)
graph'
graph''
=
set
graph_metadata
(
Just
mt
)
graph'
hg
=
HyperdataGraphAPI
graph''
camera
hg
=
HyperdataGraphAPI
graph''
camera
...
@@ -167,7 +167,7 @@ recomputeGraph _uId nId partitionMethod bridgeMethod maybeSimilarity maybeStreng
...
@@ -167,7 +167,7 @@ recomputeGraph _uId nId partitionMethod bridgeMethod maybeSimilarity maybeStreng
case
graph
of
case
graph
of
Nothing
->
do
Nothing
->
do
mt
<-
defaultGraphMetadata
cId
"Title"
repo
(
fromMaybe
Order1
maybeSimilarity
)
strength
mt
<-
defaultGraphMetadata
cId
listId
"Title"
repo
(
fromMaybe
Order1
maybeSimilarity
)
strength
g
<-
computeG
$
Just
mt
g
<-
computeG
$
Just
mt
pure
$
trace
"[G.V.G.API.recomputeGraph] Graph empty, computed"
g
pure
$
trace
"[G.V.G.API.recomputeGraph] Graph empty, computed"
g
Just
graph'
->
if
(
listVersion
==
Just
v
)
&&
(
not
force
)
Just
graph'
->
if
(
listVersion
==
Just
v
)
&&
(
not
force
)
...
@@ -225,14 +225,13 @@ computeGraph corpusId partitionMethod bridgeMethod similarity strength (nt1,nt2)
...
@@ -225,14 +225,13 @@ computeGraph corpusId partitionMethod bridgeMethod similarity strength (nt1,nt2)
defaultGraphMetadata
::
HasNodeError
err
defaultGraphMetadata
::
HasNodeError
err
=>
CorpusId
=>
CorpusId
->
ListId
->
Text
->
Text
->
NodeListStory
->
NodeListStory
->
GraphMetric
->
GraphMetric
->
Strength
->
Strength
->
DBCmd
err
GraphMetadata
->
DBCmd
err
GraphMetadata
defaultGraphMetadata
cId
t
repo
gm
str
=
do
defaultGraphMetadata
cId
lId
t
repo
gm
str
=
do
lId
<-
defaultList
cId
pure
$
GraphMetadata
{
_gm_title
=
t
pure
$
GraphMetadata
{
_gm_title
=
t
,
_gm_metric
=
gm
,
_gm_metric
=
gm
,
_gm_edgesStrength
=
Just
str
,
_gm_edgesStrength
=
Just
str
...
@@ -282,11 +281,14 @@ type GraphVersionsAPI = Summary "Graph versions"
...
@@ -282,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
...
@@ -303,13 +305,7 @@ graphVersions n nId = do
...
@@ -303,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
...
@@ -317,7 +313,6 @@ graphVersions n nId = do
...
@@ -317,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
...
@@ -325,10 +320,11 @@ recomputeVersions :: HasNodeStory env err m
...
@@ -325,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
...
...
src/Gargantext/Core/Viz/Phylo/Legacy/LegacyMain.hs
View file @
4ef66cea
...
@@ -16,42 +16,34 @@ Portability : POSIX
...
@@ -16,42 +16,34 @@ Portability : POSIX
module
Gargantext.Core.Viz.Phylo.Legacy.LegacyMain
module
Gargantext.Core.Viz.Phylo.Legacy.LegacyMain
where
where
-- import Data.GraphViz
-- import qualified Data.ByteString as DB
import
Control.Lens
hiding
(
Level
)
import
Control.Lens
hiding
(
Level
)
import
qualified
Data.List
as
List
import
Data.HashMap.Strict
qualified
as
HashMap
import
Data.List
qualified
as
List
import
Data.Maybe
import
Data.Maybe
import
Data.Proxy
import
Data.Proxy
import
Data.Set
qualified
as
Set
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
Data.Text
qualified
as
Text
import
Debug.Trace
(
trace
)
import
Debug.Trace
(
trace
)
import
GHC.IO
(
FilePath
)
import
GHC.IO
(
FilePath
)
import
Gargantext.API.Ngrams.Tools
(
getTermsWith
)
import
Gargantext.API.Ngrams.Tools
(
getTermsWith
)
import
Gargantext.API.Ngrams.Types
import
Gargantext.API.Ngrams.Types
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Core
(
HasDBid
,
withDefaultLanguage
)
import
Gargantext.Core.NodeStory
(
HasNodeStory
)
import
Gargantext.Core.Text.Context
(
TermList
)
import
Gargantext.Core.Text.Context
(
TermList
)
import
Gargantext.Core.Text.Terms.WithList
import
Gargantext.Core.Text.Terms.WithList
import
Gargantext.Database.Query.Table.Node
(
defaultList
,
getNodeWith
)
import
Gargantext.Core.Types
import
Gargantext.Prelude
import
Gargantext.Database.Action.Flow.Types
import
Gargantext.Core.Viz.LegacyPhylo
hiding
(
Svg
,
Dot
)
import
Gargantext.Core.Viz.LegacyPhylo
hiding
(
Svg
,
Dot
)
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Query.Table.Node
(
defaultList
,
getNodeWith
)
import
Gargantext.Database.Query.Table.NodeContext
(
selectDocs
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Query.Table.NodeContext
(
selectDocs
)
import
Gargantext.Prelude
import
Gargantext.Core.Types
import
Gargantext.Core
(
HasDBid
,
withDefaultLanguage
)
-- import Gargantext.Core.Viz.Phylo.LevelMaker (toPhylo)
-- import Gargantext.Core.Viz.Phylo.Tools
-- import Gargantext.Core.Viz.Phylo.View.Export
-- import Gargantext.Core.Viz.Phylo.View.ViewMaker -- TODO Just Maker is fine
import
qualified
Data.HashMap.Strict
as
HashMap
import
qualified
Data.Set
as
Set
import
qualified
Data.Text
as
Text
type
MinSizeBranch
=
Int
type
MinSizeBranch
=
Int
flowPhylo
::
(
FlowCmdM
env
err
m
,
HasDBid
NodeType
)
flowPhylo
::
(
HasNodeStory
env
err
m
,
HasDBid
NodeType
)
=>
CorpusId
=>
CorpusId
->
m
Phylo
->
m
Phylo
flowPhylo
cId
=
do
flowPhylo
cId
=
do
...
...
src/Gargantext/Database.hs
View file @
4ef66cea
...
@@ -26,7 +26,7 @@ module Gargantext.Database ( module Gargantext.Database.Prelude
...
@@ -26,7 +26,7 @@ module Gargantext.Database ( module Gargantext.Database.Prelude
where
where
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Database.Prelude
-- (connectGargandb)
import
Gargantext.Database.Prelude
(
DBCmd
)
-- (connectGargandb)
-- import Gargantext.Database.Schema.Node
-- import Gargantext.Database.Schema.Node
-- import Gargantext.Database.Query.Table.Node
-- import Gargantext.Database.Query.Table.Node
...
@@ -36,11 +36,11 @@ import Gargantext.Database.Query.Table.NodeNode
...
@@ -36,11 +36,11 @@ import Gargantext.Database.Query.Table.NodeNode
class
InsertDB
a
where
class
InsertDB
a
where
insertDB
::
a
->
Cmd
err
Int
insertDB
::
a
->
DB
Cmd
err
Int
{-
{-
class DeleteDB a where
class DeleteDB a where
deleteDB :: a -> Cmd err Int
deleteDB :: a ->
DB
Cmd err Int
-}
-}
instance
InsertDB
[
NodeNode
]
where
instance
InsertDB
[
NodeNode
]
where
...
...
src/Gargantext/Database/Action/Flow.hs
View file @
4ef66cea
...
@@ -77,7 +77,7 @@ import Gargantext.Core (Lang(..), PosTagAlgo(..), NLPServerConfig)
...
@@ -77,7 +77,7 @@ import Gargantext.Core (Lang(..), PosTagAlgo(..), NLPServerConfig)
import
Gargantext.Core
(
withDefaultLanguage
)
import
Gargantext.Core
(
withDefaultLanguage
)
import
Gargantext.Core.Ext.IMTUser
(
readFile_Annuaire
)
import
Gargantext.Core.Ext.IMTUser
(
readFile_Annuaire
)
import
Gargantext.Core.Flow.Types
import
Gargantext.Core.Flow.Types
import
Gargantext.Core.NLP
(
nlpServerGet
)
import
Gargantext.Core.NLP
(
HasNLPServer
,
nlpServerGet
)
import
Gargantext.Core.NodeStory
(
HasNodeStory
)
import
Gargantext.Core.NodeStory
(
HasNodeStory
)
import
Gargantext.Core.Text
import
Gargantext.Core.Text
import
Gargantext.Core.Text.Corpus.API
qualified
as
API
import
Gargantext.Core.Text.Corpus.API
qualified
as
API
...
@@ -88,7 +88,7 @@ import Gargantext.Core.Text.List.Social (FlowSocialListWith(..))
...
@@ -88,7 +88,7 @@ import Gargantext.Core.Text.List.Social (FlowSocialListWith(..))
import
Gargantext.Core.Text.Terms
import
Gargantext.Core.Text.Terms
import
Gargantext.Core.Text.Terms.Mono.Stem.En
(
stemIt
)
import
Gargantext.Core.Text.Terms.Mono.Stem.En
(
stemIt
)
import
Gargantext.Core.Text.Terms.WithList
(
MatchedText
,
buildPatternsWith
,
termsInText
)
import
Gargantext.Core.Text.Terms.WithList
(
MatchedText
,
buildPatternsWith
,
termsInText
)
import
Gargantext.Core.Types
(
POS
(
NP
),
TermsCount
)
import
Gargantext.Core.Types
(
HasInvalidError
,
POS
(
NP
),
TermsCount
)
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Types.Main
import
Gargantext.Core.Types.Main
import
Gargantext.Core.Types.Query
(
Limit
)
import
Gargantext.Core.Types.Query
(
Limit
)
...
@@ -103,7 +103,7 @@ import Gargantext.Database.Action.Search (searchDocInDatabase)
...
@@ -103,7 +103,7 @@ import Gargantext.Database.Action.Search (searchDocInDatabase)
import
Gargantext.Database.Admin.Config
(
userMaster
,
corpusMasterName
)
import
Gargantext.Database.Admin.Config
(
userMaster
,
corpusMasterName
)
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Node
hiding
(
DEBUG
)
-- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
import
Gargantext.Database.Admin.Types.Node
hiding
(
DEBUG
)
-- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DbCmd
'
,
DBCmd
)
import
Gargantext.Database.Query.Table.ContextNodeNgrams2
import
Gargantext.Database.Query.Table.ContextNodeNgrams2
import
Gargantext.Database.Query.Table.Ngrams
import
Gargantext.Database.Query.Table.Ngrams
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node
...
@@ -127,7 +127,7 @@ import PUBMED.Types qualified as PUBMED
...
@@ -127,7 +127,7 @@ import PUBMED.Types qualified as PUBMED
------------------------------------------------------------------------
------------------------------------------------------------------------
-- Imports for upgrade function
-- Imports for upgrade function
import
Gargantext.Database.Query.Tree.Root
(
getRootId
)
import
Gargantext.Database.Query.Tree.Root
(
getRootId
)
import
Gargantext.Database.Query.Tree
(
findNodesId
)
import
Gargantext.Database.Query.Tree
(
findNodesId
,
HasTreeError
)
------------------------------------------------------------------------
------------------------------------------------------------------------
-- TODO use internal with API name (could be old data)
-- TODO use internal with API name (could be old data)
...
@@ -157,13 +157,13 @@ printDataText (DataNew (maybeInt, conduitData)) = do
...
@@ -157,13 +157,13 @@ printDataText (DataNew (maybeInt, conduitData)) = do
putText
$
show
(
maybeInt
,
res
)
putText
$
show
(
maybeInt
,
res
)
-- TODO use the split parameter in config file
-- TODO use the split parameter in config file
getDataText
::
FlowCmdM
env
err
m
getDataText
::
(
HasNodeError
err
)
=>
DataOrigin
=>
DataOrigin
->
TermType
Lang
->
TermType
Lang
->
API
.
RawQuery
->
API
.
RawQuery
->
Maybe
PUBMED
.
APIKey
->
Maybe
PUBMED
.
APIKey
->
Maybe
API
.
Limit
->
Maybe
API
.
Limit
->
m
(
Either
API
.
GetCorpusError
DataText
)
->
DBCmd
err
(
Either
API
.
GetCorpusError
DataText
)
getDataText
(
ExternalOrigin
api
)
la
q
mPubmedAPIKey
li
=
do
getDataText
(
ExternalOrigin
api
)
la
q
mPubmedAPIKey
li
=
do
eRes
<-
liftBase
$
API
.
get
api
(
_tt_lang
la
)
q
mPubmedAPIKey
li
eRes
<-
liftBase
$
API
.
get
api
(
_tt_lang
la
)
q
mPubmedAPIKey
li
pure
$
DataNew
<$>
eRes
pure
$
DataNew
<$>
eRes
...
@@ -175,12 +175,12 @@ getDataText (InternalOrigin _) _la q _ _li = do
...
@@ -175,12 +175,12 @@ getDataText (InternalOrigin _) _la q _ _li = do
ids
<-
map
fst
<$>
searchDocInDatabase
cId
(
stemIt
$
API
.
getRawQuery
q
)
ids
<-
map
fst
<$>
searchDocInDatabase
cId
(
stemIt
$
API
.
getRawQuery
q
)
pure
$
Right
$
DataOld
ids
pure
$
Right
$
DataOld
ids
getDataText_Debug
::
FlowCmdM
env
err
m
getDataText_Debug
::
(
HasNodeError
err
)
=>
DataOrigin
=>
DataOrigin
->
TermType
Lang
->
TermType
Lang
->
API
.
RawQuery
->
API
.
RawQuery
->
Maybe
API
.
Limit
->
Maybe
API
.
Limit
->
m
()
->
DBCmd
err
()
getDataText_Debug
a
l
q
li
=
do
getDataText_Debug
a
l
q
li
=
do
result
<-
getDataText
a
l
q
Nothing
li
result
<-
getDataText
a
l
q
Nothing
li
case
result
of
case
result
of
...
@@ -190,7 +190,12 @@ getDataText_Debug a l q li = do
...
@@ -190,7 +190,12 @@ getDataText_Debug a l q li = do
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
flowDataText
::
forall
env
err
m
.
flowDataText
::
forall
env
err
m
.
(
FlowCmdM
env
err
m
(
DbCmd'
env
err
m
,
HasNodeStory
env
err
m
,
MonadLogger
m
,
HasNLPServer
env
,
HasTreeError
err
,
HasInvalidError
err
,
MonadJobStatus
m
,
MonadJobStatus
m
)
)
=>
User
=>
User
...
@@ -214,7 +219,13 @@ flowDataText u (DataNew (mLen, txtC)) tt cid mfslw jobHandle = do
...
@@ -214,7 +219,13 @@ flowDataText u (DataNew (mLen, txtC)) tt cid mfslw jobHandle = do
------------------------------------------------------------------------
------------------------------------------------------------------------
-- TODO use proxy
-- TODO use proxy
flowAnnuaire
::
(
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
flowAnnuaire
::
(
DbCmd'
env
err
m
,
HasNodeStory
env
err
m
,
MonadLogger
m
,
HasNLPServer
env
,
HasTreeError
err
,
HasInvalidError
err
,
MonadJobStatus
m
)
=>
User
=>
User
->
Either
CorpusName
[
CorpusId
]
->
Either
CorpusName
[
CorpusId
]
->
(
TermType
Lang
)
->
(
TermType
Lang
)
...
@@ -227,7 +238,13 @@ flowAnnuaire u n l filePath jobHandle = do
...
@@ -227,7 +238,13 @@ flowAnnuaire u n l filePath jobHandle = do
flow
(
Nothing
::
Maybe
HyperdataAnnuaire
)
u
n
l
Nothing
(
fromIntegral
$
length
docs
,
yieldMany
docs
)
jobHandle
flow
(
Nothing
::
Maybe
HyperdataAnnuaire
)
u
n
l
Nothing
(
fromIntegral
$
length
docs
,
yieldMany
docs
)
jobHandle
------------------------------------------------------------------------
------------------------------------------------------------------------
flowCorpusFile
::
(
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
flowCorpusFile
::
(
DbCmd'
env
err
m
,
HasNodeStory
env
err
m
,
MonadLogger
m
,
HasNLPServer
env
,
HasTreeError
err
,
HasInvalidError
err
,
MonadJobStatus
m
)
=>
User
=>
User
->
Either
CorpusName
[
CorpusId
]
->
Either
CorpusName
[
CorpusId
]
->
Limit
-- Limit the number of docs (for dev purpose)
->
Limit
-- Limit the number of docs (for dev purpose)
...
@@ -250,7 +267,14 @@ flowCorpusFile u n _l la ft ff fp mfslw jobHandle = do
...
@@ -250,7 +267,14 @@ flowCorpusFile u n _l la ft ff fp mfslw jobHandle = do
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | TODO improve the needed type to create/update a corpus
-- | TODO improve the needed type to create/update a corpus
-- (For now, Either is enough)
-- (For now, Either is enough)
flowCorpus
::
(
FlowCmdM
env
err
m
,
FlowCorpus
a
,
MonadJobStatus
m
)
flowCorpus
::
(
DbCmd'
env
err
m
,
HasNodeStory
env
err
m
,
MonadLogger
m
,
HasNLPServer
env
,
HasTreeError
err
,
HasInvalidError
err
,
FlowCorpus
a
,
MonadJobStatus
m
)
=>
User
=>
User
->
Either
CorpusName
[
CorpusId
]
->
Either
CorpusName
[
CorpusId
]
->
TermType
Lang
->
TermType
Lang
...
@@ -262,7 +286,12 @@ flowCorpus = flow (Nothing :: Maybe HyperdataCorpus)
...
@@ -262,7 +286,12 @@ flowCorpus = flow (Nothing :: Maybe HyperdataCorpus)
flow
::
forall
env
err
m
a
c
.
flow
::
forall
env
err
m
a
c
.
(
FlowCmdM
env
err
m
(
DbCmd'
env
err
m
,
HasNodeStory
env
err
m
,
MonadLogger
m
,
HasNLPServer
env
,
HasTreeError
err
,
HasInvalidError
err
,
FlowCorpus
a
,
FlowCorpus
a
,
MkCorpus
c
,
MkCorpus
c
,
MonadJobStatus
m
,
MonadJobStatus
m
...
@@ -338,7 +367,11 @@ createNodes user corpusName ctype = do
...
@@ -338,7 +367,11 @@ createNodes user corpusName ctype = do
pure
(
userId
,
userCorpusId
,
listId
)
pure
(
userId
,
userCorpusId
,
listId
)
flowCorpusUser
::
(
FlowCmdM
env
err
m
flowCorpusUser
::
(
HasNodeError
err
,
HasInvalidError
err
,
HasNLPServer
env
,
HasTreeError
err
,
HasNodeStory
env
err
m
,
MkCorpus
c
,
MkCorpus
c
)
)
=>
Lang
=>
Lang
...
@@ -589,7 +622,8 @@ instance HasText a => HasText (Node a)
...
@@ -589,7 +622,8 @@ instance HasText a => HasText (Node a)
-- | TODO putelsewhere
-- | TODO putelsewhere
-- | Upgrade function
-- | Upgrade function
-- Suppose all documents are English (this is the case actually)
-- Suppose all documents are English (this is the case actually)
indexAllDocumentsWithPosTag
::
FlowCmdM
env
err
m
indexAllDocumentsWithPosTag
::
(
HasNodeStory
env
err
m
,
HasNLPServer
env
)
=>
m
()
=>
m
()
indexAllDocumentsWithPosTag
=
do
indexAllDocumentsWithPosTag
=
do
rootId
<-
getRootId
(
UserName
userMaster
)
rootId
<-
getRootId
(
UserName
userMaster
)
...
@@ -598,7 +632,8 @@ indexAllDocumentsWithPosTag = do
...
@@ -598,7 +632,8 @@ indexAllDocumentsWithPosTag = do
_
<-
mapM
extractInsert
(
splitEvery
1000
docs
)
_
<-
mapM
extractInsert
(
splitEvery
1000
docs
)
pure
()
pure
()
extractInsert
::
FlowCmdM
env
err
m
extractInsert
::
(
HasNodeStory
env
err
m
,
HasNLPServer
env
)
=>
[
Node
HyperdataDocument
]
->
m
()
=>
[
Node
HyperdataDocument
]
->
m
()
extractInsert
docs
=
do
extractInsert
docs
=
do
let
documentsWithId
=
map
(
\
doc
->
Indexed
(
doc
^.
node_id
)
doc
)
docs
let
documentsWithId
=
map
(
\
doc
->
Indexed
(
doc
^.
node_id
)
doc
)
docs
...
...
src/Gargantext/Database/Action/Flow/List.hs
View file @
4ef66cea
...
@@ -17,27 +17,26 @@ Portability : POSIX
...
@@ -17,27 +17,26 @@ Portability : POSIX
module
Gargantext.Database.Action.Flow.List
module
Gargantext.Database.Action.Flow.List
where
where
-- import Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams
import
Control.Concurrent
import
Control.Concurrent
import
Control.Lens
((
^.
),
(
+~
),
(
%~
),
at
,
(
.~
),
_Just
)
import
Control.Lens
((
^.
),
(
+~
),
(
%~
),
at
,
(
.~
),
_Just
)
import
Control.Monad.Reader
import
Control.Monad.Reader
import
Data.List
qualified
as
List
import
Data.Map.Strict
(
Map
,
toList
)
import
Data.Map.Strict
(
Map
,
toList
)
import
Data.Map.Strict
qualified
as
Map
import
Data.Map.Strict.Patch
qualified
as
PM
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
Gargantext.API.Ngrams
(
saveNodeStory
)
import
Gargantext.API.Ngrams
(
saveNodeStory
)
import
Gargantext.API.Ngrams.Tools
(
getNodeStoryVar
)
import
Gargantext.API.Ngrams.Tools
(
getNodeStoryVar
)
import
Gargantext.API.Ngrams.Types
import
Gargantext.API.Ngrams.Types
import
Gargantext.Core.NodeStory
import
Gargantext.Core.Types
(
HasInvalidError
(
..
),
assertValid
)
import
Gargantext.Core.Types
(
HasInvalidError
(
..
),
assertValid
)
import
Gargantext.Core.Types.Main
(
ListType
(
CandidateTerm
))
import
Gargantext.Core.Types.Main
(
ListType
(
CandidateTerm
))
import
Gargantext.Core.NodeStory
import
Gargantext.Database.Action.Flow.Types
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Query.Table.Ngrams
qualified
as
TableNgrams
import
Gargantext.Database.Query.Table.NodeNgrams
(
NodeNgramsPoly
(
..
),
NodeNgramsW
,
listInsertDb
,
{- getCgramsId -}
)
import
Gargantext.Database.Query.Table.NodeNgrams
(
NodeNgramsPoly
(
..
),
NodeNgramsW
,
listInsertDb
,
{- getCgramsId -}
)
-- import Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
qualified
Data.List
as
List
import
qualified
Data.Map.Strict
as
Map
import
qualified
Data.Map.Strict.Patch
as
PM
import
qualified
Gargantext.Database.Query.Table.Ngrams
as
TableNgrams
-- FLOW LIST
-- FLOW LIST
-- 1. select specific terms of the corpus when compared with others langs
-- 1. select specific terms of the corpus when compared with others langs
...
@@ -82,7 +81,7 @@ flowList_Tficf' u m nt f = do
...
@@ -82,7 +81,7 @@ flowList_Tficf' u m nt f = do
------------------------------------------------------------------------
------------------------------------------------------------------------
flowList_DbRepo
::
FlowCmdM
env
err
m
flowList_DbRepo
::
(
HasInvalidError
err
,
HasNodeStory
env
err
m
)
=>
ListId
=>
ListId
->
Map
NgramsType
[
NgramsElement
]
->
Map
NgramsType
[
NgramsElement
]
->
m
ListId
->
m
ListId
...
@@ -157,7 +156,7 @@ toNodeNgramsW' l'' ngs = [ NodeNgrams { _nng_id = Nothing
...
@@ -157,7 +156,7 @@ toNodeNgramsW' l'' ngs = [ NodeNgrams { _nng_id = Nothing
]
]
listInsert
::
FlowCmdM
env
err
m
listInsert
::
(
HasInvalidError
err
,
HasNodeStory
env
err
m
)
=>
ListId
=>
ListId
->
Map
NgramsType
[
NgramsElement
]
->
Map
NgramsType
[
NgramsElement
]
->
m
()
->
m
()
...
...
src/Gargantext/Database/Action/Flow/Pairing.hs
View file @
4ef66cea
...
@@ -16,13 +16,18 @@ module Gargantext.Database.Action.Flow.Pairing
...
@@ -16,13 +16,18 @@ module Gargantext.Database.Action.Flow.Pairing
-- (pairing)
-- (pairing)
where
where
import
Debug.Trace
(
trace
)
import
Control.Lens
(
_Just
,
(
^.
),
view
)
import
Control.Lens
(
_Just
,
(
^.
),
view
)
import
Data.Hashable
(
Hashable
)
import
Data.HashMap.Strict
(
HashMap
)
import
Data.HashMap.Strict
(
HashMap
)
import
Data.HashMap.Strict
qualified
as
HM
import
Data.HashMap.Strict
qualified
as
HashMap
import
Data.Hashable
(
Hashable
)
import
Data.List
qualified
as
List
import
Data.Maybe
(
fromMaybe
,
catMaybes
)
import
Data.Maybe
(
fromMaybe
,
catMaybes
)
import
Data.Set
(
Set
)
import
Data.Set
(
Set
)
import
Data.Set
qualified
as
Set
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
Data.Text
qualified
as
Text
import
Debug.Trace
(
trace
)
import
Gargantext.API.Ngrams.Tools
import
Gargantext.API.Ngrams.Tools
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
(
..
))
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
(
..
))
import
Gargantext.Core
import
Gargantext.Core
...
@@ -42,16 +47,11 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
...
@@ -42,16 +47,11 @@ 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_NodeContext
(
insertNodeContext_NodeContext
)
import
Gargantext.Database.Query.Table.NodeContext_NodeContext
(
insertNodeContext_NodeContext
)
import
Gargantext.Database.Query.Table.NodeNode
(
insertNodeNode
)
import
Gargantext.Database.Query.Table.NodeNode
(
insertNodeNode
)
import
Gargantext.Database.Prelude
(
Cmd
,
runOpaQuery
)
import
Gargantext.Database.Schema.Ngrams
-- (NgramsType(..))
import
Gargantext.Database.Schema.Ngrams
-- (NgramsType(..))
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
-- import Gargantext.Database.Schema.Context
import
qualified
Data.HashMap.Strict
as
HM
import
Gargantext.Prelude
hiding
(
sum
)
import
Gargantext.Prelude
hiding
(
sum
)
import
Opaleye
import
Opaleye
import
qualified
Data.HashMap.Strict
as
HashMap
import
qualified
Data.List
as
List
import
qualified
Data.Set
as
Set
import
qualified
Data.Text
as
Text
-- | isPairedWith
-- | isPairedWith
-- All NodeAnnuaire paired with a Corpus of NodeId nId:
-- All NodeAnnuaire paired with a Corpus of NodeId nId:
...
...
src/Gargantext/Database/Action/Learn.hs
View file @
4ef66cea
...
@@ -15,19 +15,19 @@ Portability : POSIX
...
@@ -15,19 +15,19 @@ Portability : POSIX
module
Gargantext.Database.Action.Learn
module
Gargantext.Database.Action.Learn
where
where
import
Data.List
qualified
as
List
import
Data.Maybe
import
Data.Maybe
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
Data.Text
qualified
as
Text
import
Gargantext.Core
import
Gargantext.Core
import
Gargantext.Core.Text.Learn
import
Gargantext.Core.Types.Query
(
Offset
,
Limit
(
..
))
import
Gargantext.Core.Types.Query
(
Offset
,
Limit
(
..
))
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
DBCmd
)
import
Gargantext.Database.Query.Facet
import
Gargantext.Database.Query.Facet
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Prelude
(
Cmd
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Core.Text.Learn
import
qualified
Data.List
as
List
import
qualified
Data.Text
as
Text
data
FavOrTrash
=
IsFav
|
IsTrash
data
FavOrTrash
=
IsFav
|
IsTrash
deriving
(
Eq
)
deriving
(
Eq
)
...
@@ -35,14 +35,14 @@ data FavOrTrash = IsFav | IsTrash
...
@@ -35,14 +35,14 @@ data FavOrTrash = IsFav | IsTrash
moreLike
::
(
HasDBid
NodeType
,
HasNodeError
err
)
moreLike
::
(
HasDBid
NodeType
,
HasNodeError
err
)
=>
CorpusId
->
Maybe
Offset
->
Maybe
Limit
->
Maybe
OrderBy
=>
CorpusId
->
Maybe
Offset
->
Maybe
Limit
->
Maybe
OrderBy
->
FavOrTrash
->
Cmd
err
[
FacetDoc
]
->
FavOrTrash
->
DB
Cmd
err
[
FacetDoc
]
moreLike
cId
o
_l
order
ft
=
do
moreLike
cId
o
_l
order
ft
=
do
priors
<-
getPriors
ft
cId
priors
<-
getPriors
ft
cId
moreLikeWith
cId
o
(
Just
3
)
order
ft
priors
moreLikeWith
cId
o
(
Just
3
)
order
ft
priors
---------------------------------------------------------------------------
---------------------------------------------------------------------------
getPriors
::
(
HasDBid
NodeType
,
HasNodeError
err
)
getPriors
::
(
HasDBid
NodeType
,
HasNodeError
err
)
=>
FavOrTrash
->
CorpusId
->
Cmd
err
(
Events
Bool
)
=>
FavOrTrash
->
CorpusId
->
DB
Cmd
err
(
Events
Bool
)
getPriors
ft
cId
=
do
getPriors
ft
cId
=
do
docs_fav
<-
filter
(
\
(
FacetDoc
_
_
_
_
f
_
_
)
->
f
==
Just
2
)
docs_fav
<-
filter
(
\
(
FacetDoc
_
_
_
_
f
_
_
)
->
f
==
Just
2
)
...
@@ -60,7 +60,7 @@ getPriors ft cId = do
...
@@ -60,7 +60,7 @@ getPriors ft cId = do
moreLikeWith
::
(
HasDBid
NodeType
,
HasNodeError
err
)
moreLikeWith
::
(
HasDBid
NodeType
,
HasNodeError
err
)
=>
CorpusId
->
Maybe
Offset
->
Maybe
Limit
->
Maybe
OrderBy
=>
CorpusId
->
Maybe
Offset
->
Maybe
Limit
->
Maybe
OrderBy
->
FavOrTrash
->
Events
Bool
->
Cmd
err
[
FacetDoc
]
->
FavOrTrash
->
Events
Bool
->
DB
Cmd
err
[
FacetDoc
]
moreLikeWith
cId
o
l
order
ft
priors
=
do
moreLikeWith
cId
o
l
order
ft
priors
=
do
docs_test
<-
filter
(
\
(
FacetDoc
_
_
_
_
f
_
_
)
->
f
==
Just
1
)
docs_test
<-
filter
(
\
(
FacetDoc
_
_
_
_
f
_
_
)
->
f
==
Just
1
)
...
...
src/Gargantext/Database/Action/Mail.hs
View file @
4ef66cea
...
@@ -18,7 +18,7 @@ import Gargantext.Core.Mail (mail, MailModel(..))
...
@@ -18,7 +18,7 @@ import Gargantext.Core.Mail (mail, MailModel(..))
import
Gargantext.Core.Mail.Types
(
mailSettings
)
import
Gargantext.Core.Mail.Types
(
mailSettings
)
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Database.Action.User
import
Gargantext.Database.Action.User
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
CmdM
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Database.Schema.User
import
Gargantext.Database.Schema.User
import
Gargantext.Prelude
import
Gargantext.Prelude
...
...
src/Gargantext/Database/Action/Metrics.hs
View file @
4ef66cea
...
@@ -184,15 +184,13 @@ updateContextScore cId lId = do
...
@@ -184,15 +184,13 @@ updateContextScore cId lId = do
-- Used for scores in Doc Table
-- Used for scores in Doc Table
getContextsNgramsScore
::
--(FlowCmdM env err m)
getContextsNgramsScore
::
(
HasNodeStory
env
err
m
)
(
HasNodeStory
env
err
m
)
=>
CorpusId
->
ListId
->
TabType
->
ListType
->
Maybe
Limit
=>
CorpusId
->
ListId
->
TabType
->
ListType
->
Maybe
Limit
->
m
(
Map
ContextId
Int
)
->
m
(
Map
ContextId
Int
)
getContextsNgramsScore
cId
lId
tabType
listType
maybeLimit
getContextsNgramsScore
cId
lId
tabType
listType
maybeLimit
=
Map
.
map
Set
.
size
<$>
getContextsNgrams
cId
lId
tabType
listType
maybeLimit
=
Map
.
map
Set
.
size
<$>
getContextsNgrams
cId
lId
tabType
listType
maybeLimit
getContextsNgrams
::
--(FlowCmdM env err m)
getContextsNgrams
::
(
HasNodeStory
env
err
m
)
(
HasNodeStory
env
err
m
)
=>
CorpusId
->
ListId
->
TabType
->
ListType
->
Maybe
Limit
=>
CorpusId
->
ListId
->
TabType
->
ListType
->
Maybe
Limit
->
m
(
Map
ContextId
(
Set
NgramsTerm
))
->
m
(
Map
ContextId
(
Set
NgramsTerm
))
getContextsNgrams
cId
lId
tabType
listType
maybeLimit
=
do
getContextsNgrams
cId
lId
tabType
listType
maybeLimit
=
do
...
...
src/Gargantext/Database/Action/Metrics/NgramsByContext.hs
View file @
4ef66cea
src/Gargantext/Database/Action/Metrics/TFICF.hs
View file @
4ef66cea
...
@@ -23,7 +23,7 @@ import Gargantext.Core
...
@@ -23,7 +23,7 @@ import Gargantext.Core
import
Gargantext.Core.Text.Metrics.TFICF
import
Gargantext.Core.Text.Metrics.TFICF
import
Gargantext.Database.Action.Metrics.NgramsByContext
(
getContextsByNgramsUser
,
{-getOccByNgramsOnlyFast,-}
getOccByNgramsOnlyFast_withSample
)
import
Gargantext.Database.Action.Metrics.NgramsByContext
(
getContextsByNgramsUser
,
{-getOccByNgramsOnlyFast,-}
getOccByNgramsOnlyFast_withSample
)
import
Gargantext.Database.Admin.Types.Node
-- (ListId, CorpusId, NodeId)
import
Gargantext.Database.Admin.Types.Node
-- (ListId, CorpusId, NodeId)
import
Gargantext.Database.Prelude
(
Cmd
)
import
Gargantext.Database.Prelude
(
DB
Cmd
)
import
Gargantext.Database.Query.Table.NodeContext
(
selectCountDocs
)
import
Gargantext.Database.Query.Table.NodeContext
(
selectCountDocs
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.API.Ngrams.Types
import
Gargantext.API.Ngrams.Types
...
@@ -61,7 +61,7 @@ getTficf_withSample :: HasDBid NodeType
...
@@ -61,7 +61,7 @@ getTficf_withSample :: HasDBid NodeType
=>
UserCorpusId
=>
UserCorpusId
->
MasterCorpusId
->
MasterCorpusId
->
NgramsType
->
NgramsType
->
Cmd
err
(
HashMap
NgramsTerm
Double
)
->
DB
Cmd
err
(
HashMap
NgramsTerm
Double
)
getTficf_withSample
cId
mId
nt
=
do
getTficf_withSample
cId
mId
nt
=
do
mapTextDoubleLocal
<-
HM
.
filter
(
>
1
)
mapTextDoubleLocal
<-
HM
.
filter
(
>
1
)
<$>
HM
.
map
(
fromIntegral
.
Set
.
size
)
<$>
HM
.
map
(
fromIntegral
.
Set
.
size
)
...
...
src/Gargantext/Database/Action/Node.hs
View file @
4ef66cea
...
@@ -30,7 +30,7 @@ import Gargantext.Database.Query.Table.Node.Error
...
@@ -30,7 +30,7 @@ import Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Prelude.Crypto.Hash
(
hash
)
import
Gargantext.Prelude.Crypto.Hash
(
hash
)
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DBCmd
,
HasConfig
(
..
))
import
Control.Lens
(
view
)
import
Control.Lens
(
view
)
import
Gargantext.Prelude.Config
(
GargConfig
(
..
))
import
Gargantext.Prelude.Config
(
GargConfig
(
..
))
...
...
src/Gargantext/Database/Action/Share.hs
View file @
4ef66cea
...
@@ -25,17 +25,17 @@ import Gargantext.Database.Action.User (getUserId)
...
@@ -25,17 +25,17 @@ import Gargantext.Database.Action.User (getUserId)
import
Gargantext.Database.Admin.Config
(
hasNodeType
,
isInNodeTypes
)
import
Gargantext.Database.Admin.Config
(
hasNodeType
,
isInNodeTypes
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataAny
(
..
))
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataAny
(
..
))
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
-- import Gargantext.Database.Query.Join (leftJoin3')
import
Gargantext.Database.Query.Table.Node
(
getNode
,
getNodesWith
)
import
Gargantext.Database.Query.Table.Node
(
getNode
,
getNodesWith
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
,
errorWith
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
,
errorWith
)
import
Gargantext.Database.Query.Table.NodeNode
(
deleteNodeNode
,
queryNodeNodeTable
)
import
Gargantext.Database.Query.Table.NodeNode
(
deleteNodeNode
,
queryNodeNodeTable
)
import
Gargantext.Database.Query.Table.User
import
Gargantext.Database.Query.Table.User
import
Gargantext.Database.Query.Tree.Root
(
getRootId
)
import
Gargantext.Database.Query.Tree.Root
(
getRootId
)
import
Gargantext.Database.Prelude
(
Cmd
,
runOpaQuery
)
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Utils.Tuple
(
uncurryMaybe
)
import
Gargantext.Utils.Tuple
(
uncurryMaybe
)
import
Opaleye
hiding
(
not
)
import
Opaleye
hiding
(
not
)
import
qualified
Opaleye
as
O
import
Opaleye
qualified
as
O
-- | TODO move in PhyloConfig of Gargantext
-- | TODO move in PhyloConfig of Gargantext
publicNodeTypes
::
[
NodeType
]
publicNodeTypes
::
[
NodeType
]
...
...
src/Gargantext/Database/Action/TSQuery.hs
View file @
4ef66cea
{-|
Module : Gargantext.Database.Action.TSQuery
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Here is a longer description of this module, containing some
commentary with @some markup@.
-}
module
Gargantext.Database.Action.TSQuery
where
module
Gargantext.Database.Action.TSQuery
where
import
Data.Aeson
import
Data.Aeson
...
@@ -8,11 +21,11 @@ import Data.Text (Text, words)
...
@@ -8,11 +21,11 @@ import Data.Text (Text, words)
import
Database.PostgreSQL.Simple
(
Query
)
import
Database.PostgreSQL.Simple
(
Query
)
import
Database.PostgreSQL.Simple.ToField
import
Database.PostgreSQL.Simple.ToField
import
Gargantext.Core
import
Gargantext.Core
import
Gargantext.Core.Text.Terms.Mono.Stem.En
(
stemIt
)
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Database.Prelude
(
Cmd
,
runPGSQuery
)
import
Gargantext.Database.Prelude
(
DB
Cmd
,
runPGSQuery
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Core.Text.Terms.Mono.Stem.En
(
stemIt
)
newtype
TSQuery
=
UnsafeTSQuery
[
Text
]
newtype
TSQuery
=
UnsafeTSQuery
[
Text
]
...
@@ -71,7 +84,7 @@ textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year' \
...
@@ -71,7 +84,7 @@ textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year' \
textSearch
::
HasDBid
NodeType
textSearch
::
HasDBid
NodeType
=>
TSQuery
->
ParentId
=>
TSQuery
->
ParentId
->
Limit
->
Offset
->
Order
->
Limit
->
Offset
->
Order
->
Cmd
err
[(
Int
,
Value
,
Value
,
Value
,
Value
,
Maybe
Int
)]
->
DB
Cmd
err
[(
Int
,
Value
,
Value
,
Value
,
Value
,
Maybe
Int
)]
textSearch
q
p
l
o
ord
=
runPGSQuery
textSearchQuery
(
q
,
p
,
p
,
typeId
,
ord
,
o
,
l
)
textSearch
q
p
l
o
ord
=
runPGSQuery
textSearchQuery
(
q
,
p
,
p
,
typeId
,
ord
,
o
,
l
)
where
where
typeId
=
toDBid
NodeDocument
typeId
=
toDBid
NodeDocument
src/Gargantext/Database/Action/User/New.hs
View file @
4ef66cea
...
@@ -29,7 +29,7 @@ import Gargantext.Core.Mail.Types (HasMail, mailSettings)
...
@@ -29,7 +29,7 @@ import Gargantext.Core.Mail.Types (HasMail, mailSettings)
import
Gargantext.Core.Types.Individu
import
Gargantext.Core.Types.Individu
import
Gargantext.Database.Action.Flow
(
getOrMkRoot
)
import
Gargantext.Database.Action.Flow
(
getOrMkRoot
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
Cmd
,
DBCmd
,
CmdM
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
),
nodeError
,
NodeError
(
..
))
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
),
nodeError
,
NodeError
(
..
))
import
Gargantext.Database.Query.Table.User
import
Gargantext.Database.Query.Table.User
import
Gargantext.Prelude
import
Gargantext.Prelude
...
@@ -135,12 +135,12 @@ _updateUsersPassword us = do
...
@@ -135,12 +135,12 @@ _updateUsersPassword us = do
pure
1
pure
1
------------------------------------------------------------------------
------------------------------------------------------------------------
_rmUser
::
HasNodeError
err
=>
User
->
Cmd
err
Int64
_rmUser
::
HasNodeError
err
=>
User
->
DB
Cmd
err
Int64
_rmUser
(
UserName
un
)
=
deleteUsers
[
un
]
_rmUser
(
UserName
un
)
=
deleteUsers
[
un
]
_rmUser
_
=
nodeError
NotImplYet
_rmUser
_
=
nodeError
NotImplYet
------------------------------------------------------------------------
------------------------------------------------------------------------
-- TODO
-- TODO
_rmUsers
::
HasNodeError
err
=>
[
User
]
->
Cmd
err
Int64
_rmUsers
::
HasNodeError
err
=>
[
User
]
->
DB
Cmd
err
Int64
_rmUsers
[]
=
pure
0
_rmUsers
[]
=
pure
0
_rmUsers
_
=
undefined
_rmUsers
_
=
undefined
src/Gargantext/Database/Prelude.hs
View file @
4ef66cea
...
@@ -144,17 +144,15 @@ runCountOpaQuery q = do
...
@@ -144,17 +144,15 @@ runCountOpaQuery q = do
-- countRows is guaranteed to return a list with exactly one row so DL.head is safe here
-- countRows is guaranteed to return a list with exactly one row so DL.head is safe here
pure
$
fromInt64ToInt
$
DL
.
head
counts
pure
$
fromInt64ToInt
$
DL
.
head
counts
formatPGSQuery
::
PGS
.
ToRow
a
=>
PGS
.
Query
->
a
->
Cmd
err
DB
.
ByteString
formatPGSQuery
::
PGS
.
ToRow
a
=>
PGS
.
Query
->
a
->
DB
Cmd
err
DB
.
ByteString
formatPGSQuery
q
a
=
mkCmd
$
\
conn
->
PGS
.
formatQuery
conn
q
a
formatPGSQuery
q
a
=
mkCmd
$
\
conn
->
PGS
.
formatQuery
conn
q
a
-- TODO use runPGSQueryDebug everywhere
-- TODO use runPGSQueryDebug everywhere
runPGSQuery'
::
(
PGS
.
ToRow
a
,
PGS
.
FromRow
b
)
=>
PGS
.
Query
->
a
->
Cmd
err
[
b
]
runPGSQuery'
::
(
PGS
.
ToRow
a
,
PGS
.
FromRow
b
)
=>
PGS
.
Query
->
a
->
DB
Cmd
err
[
b
]
runPGSQuery'
q
a
=
mkCmd
$
\
conn
->
PGS
.
query
conn
q
a
runPGSQuery'
q
a
=
mkCmd
$
\
conn
->
PGS
.
query
conn
q
a
runPGSQuery
::
(
DbCmd'
env
err
m
runPGSQuery
::
(
PGS
.
FromRow
r
,
PGS
.
ToRow
q
)
,
PGS
.
FromRow
r
,
PGS
.
ToRow
q
=>
PGS
.
Query
->
q
->
DBCmd
err
[
r
]
)
=>
PGS
.
Query
->
q
->
m
[
r
]
runPGSQuery
q
a
=
mkCmd
$
\
conn
->
catch
(
PGS
.
query
conn
q
a
)
(
printError
conn
)
runPGSQuery
q
a
=
mkCmd
$
\
conn
->
catch
(
PGS
.
query
conn
q
a
)
(
printError
conn
)
where
where
printError
c
(
SomeException
e
)
=
do
printError
c
(
SomeException
e
)
=
do
...
@@ -179,10 +177,8 @@ runPGSQueryFold q initialState consume = mkCmd $ \conn -> catch (PGS.fold_ conn
...
@@ -179,10 +177,8 @@ runPGSQueryFold q initialState consume = mkCmd $ \conn -> catch (PGS.fold_ conn
-- | TODO catch error
-- | TODO catch error
runPGSQuery_
::
(
CmdM
env
err
m
runPGSQuery_
::
(
PGS
.
FromRow
r
)
,
PGS
.
FromRow
r
=>
PGS
.
Query
->
DBCmd
err
[
r
]
)
=>
PGS
.
Query
->
m
[
r
]
runPGSQuery_
q
=
mkCmd
$
\
conn
->
catch
(
PGS
.
query_
conn
q
)
printError
runPGSQuery_
q
=
mkCmd
$
\
conn
->
catch
(
PGS
.
query_
conn
q
)
printError
where
where
printError
(
SomeException
e
)
=
do
printError
(
SomeException
e
)
=
do
...
@@ -227,7 +223,7 @@ fromField' field mb = do
...
@@ -227,7 +223,7 @@ fromField' field mb = do
printSqlOpa
::
Default
Unpackspec
a
a
=>
Select
a
->
IO
()
printSqlOpa
::
Default
Unpackspec
a
a
=>
Select
a
->
IO
()
printSqlOpa
=
putStrLn
.
maybe
"Empty query"
identity
.
showSql
printSqlOpa
=
putStrLn
.
maybe
"Empty query"
identity
.
showSql
dbCheck
::
CmdM
env
err
m
=>
m
Bool
dbCheck
::
DBCmd
err
Bool
dbCheck
=
do
dbCheck
=
do
r
::
[
PGS
.
Only
Text
]
<-
runPGSQuery_
"select username from public.auth_user"
r
::
[
PGS
.
Only
Text
]
<-
runPGSQuery_
"select username from public.auth_user"
case
r
of
case
r
of
...
...
src/Gargantext/Database/Query/Facet.hs
View file @
4ef66cea
...
@@ -43,7 +43,7 @@ import Data.Text qualified as T
...
@@ -43,7 +43,7 @@ import Data.Text qualified as T
import
Gargantext.Core
import
Gargantext.Core
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
,
IsTrash
)
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
,
IsTrash
)
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DBCmd
,
runCountOpaQuery
,
runOpaQuery
)
import
Gargantext.Database.Query.Facet.Types
import
Gargantext.Database.Query.Facet.Types
import
Gargantext.Database.Query.Filter
import
Gargantext.Database.Query.Filter
import
Gargantext.Database.Query.Table.Context
import
Gargantext.Database.Query.Table.Context
...
@@ -70,7 +70,7 @@ runViewAuthorsDoc :: HasDBid NodeType
...
@@ -70,7 +70,7 @@ runViewAuthorsDoc :: HasDBid NodeType
->
Maybe
Offset
->
Maybe
Offset
->
Maybe
Limit
->
Maybe
Limit
->
Maybe
OrderBy
->
Maybe
OrderBy
->
Cmd
err
[
FacetDoc
]
->
DB
Cmd
err
[
FacetDoc
]
runViewAuthorsDoc
cId
t
o
l
order
=
runOpaQuery
$
filterWith
o
l
order
$
viewAuthorsDoc
cId
t
ntId
runViewAuthorsDoc
cId
t
o
l
order
=
runOpaQuery
$
filterWith
o
l
order
$
viewAuthorsDoc
cId
t
ntId
where
where
ntId
=
NodeDocument
ntId
=
NodeDocument
...
@@ -125,11 +125,11 @@ runViewDocuments :: (HasDBid NodeType, HasNodeError err)
...
@@ -125,11 +125,11 @@ runViewDocuments :: (HasDBid NodeType, HasNodeError err)
->
Maybe
OrderBy
->
Maybe
OrderBy
->
Maybe
Text
->
Maybe
Text
->
Maybe
Text
->
Maybe
Text
->
Cmd
err
[
FacetDoc
]
->
DB
Cmd
err
[
FacetDoc
]
runViewDocuments
cId
t
o
l
order
query
year
=
do
runViewDocuments
cId
t
o
l
order
query
year
=
do
listId
<-
defaultList
cId
listId
<-
defaultList
cId
res
<-
runOpaQuery
$
filterWith'
o
l
order
(
sqlQuery
listId
)
::
Cmd
err
[
FacetDocAgg'
]
res
<-
runOpaQuery
$
filterWith'
o
l
order
(
sqlQuery
listId
)
::
DB
Cmd
err
[
FacetDocAgg'
]
pure
$
remapNgramsCount
<$>
res
pure
$
remapNgramsCount
<$>
res
where
where
sqlQuery
lId
=
viewDocuments
cId
lId
t
(
toDBid
NodeDocument
)
query
year
sqlQuery
lId
=
viewDocuments
cId
lId
t
(
toDBid
NodeDocument
)
query
year
...
@@ -140,7 +140,7 @@ runViewDocuments cId t o l order query year = do
...
@@ -140,7 +140,7 @@ runViewDocuments cId t o l order query year = do
,
..
}
,
..
}
runCountDocuments
::
(
HasDBid
NodeType
,
HasNodeError
err
)
runCountDocuments
::
(
HasDBid
NodeType
,
HasNodeError
err
)
=>
CorpusId
->
IsTrash
->
Maybe
Text
->
Maybe
Text
->
Cmd
err
Int
=>
CorpusId
->
IsTrash
->
Maybe
Text
->
Maybe
Text
->
DB
Cmd
err
Int
runCountDocuments
cId
t
mQuery
mYear
=
do
runCountDocuments
cId
t
mQuery
mYear
=
do
listId
<-
defaultList
cId
listId
<-
defaultList
cId
runCountOpaQuery
(
sqlQuery
listId
)
runCountOpaQuery
(
sqlQuery
listId
)
...
...
src/Gargantext/Database/Query/Table/Context.hs
View file @
4ef66cea
...
@@ -25,7 +25,7 @@ import Gargantext.Core
...
@@ -25,7 +25,7 @@ import Gargantext.Core
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DBCmd
,
JSONB
,
runOpaQuery
)
import
Gargantext.Database.Query.Filter
(
limit'
,
offset'
)
import
Gargantext.Database.Query.Filter
(
limit'
,
offset'
)
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Schema.Context
import
Gargantext.Database.Schema.Context
...
@@ -35,7 +35,7 @@ import Prelude hiding (null, id, map, sum)
...
@@ -35,7 +35,7 @@ import Prelude hiding (null, id, map, sum)
getContextWith
::
(
HasNodeError
err
,
JSONB
a
)
getContextWith
::
(
HasNodeError
err
,
JSONB
a
)
=>
ContextId
->
proxy
a
->
Cmd
err
(
Node
a
)
=>
ContextId
->
proxy
a
->
DB
Cmd
err
(
Node
a
)
getContextWith
nId
_
=
do
getContextWith
nId
_
=
do
maybeContext
<-
headMay
<$>
runOpaQuery
(
selectContext
(
pgNodeId
nId
))
maybeContext
<-
headMay
<$>
runOpaQuery
(
selectContext
(
pgNodeId
nId
))
case
maybeContext
of
case
maybeContext
of
...
@@ -51,7 +51,7 @@ selectContext id' = proc () -> do
...
@@ -51,7 +51,7 @@ selectContext id' = proc () -> do
restrict
-<
_context_id
row
.==
id'
restrict
-<
_context_id
row
.==
id'
returnA
-<
row
returnA
-<
row
runGetContexts
::
Select
ContextRead
->
Cmd
err
[
Context
HyperdataAny
]
runGetContexts
::
Select
ContextRead
->
DB
Cmd
err
[
Context
HyperdataAny
]
runGetContexts
=
runOpaQuery
runGetContexts
=
runOpaQuery
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -84,11 +84,11 @@ selectContextsWith' parentId maybeContextType = proc () -> do
...
@@ -84,11 +84,11 @@ selectContextsWith' parentId maybeContextType = proc () -> do
------------------------------------------------------------------------
------------------------------------------------------------------------
getDocumentsV3WithParentId
::
HasDBid
NodeType
=>
NodeId
->
Cmd
err
[
Context
HyperdataDocumentV3
]
getDocumentsV3WithParentId
::
HasDBid
NodeType
=>
NodeId
->
DB
Cmd
err
[
Context
HyperdataDocumentV3
]
getDocumentsV3WithParentId
n
=
runOpaQuery
$
selectContextsWith'
n
(
Just
NodeDocument
)
getDocumentsV3WithParentId
n
=
runOpaQuery
$
selectContextsWith'
n
(
Just
NodeDocument
)
-- TODO: merge with getDocumentsWithParentId by having a class IsHyperdataDocument
-- TODO: merge with getDocumentsWithParentId by having a class IsHyperdataDocument
getDocumentsWithParentId
::
HasDBid
NodeType
=>
NodeId
->
Cmd
err
[
Context
HyperdataDocument
]
getDocumentsWithParentId
::
HasDBid
NodeType
=>
NodeId
->
DB
Cmd
err
[
Context
HyperdataDocument
]
getDocumentsWithParentId
n
=
runOpaQuery
$
selectContextsWith'
n
(
Just
NodeDocument
)
getDocumentsWithParentId
n
=
runOpaQuery
$
selectContextsWith'
n
(
Just
NodeDocument
)
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -102,7 +102,8 @@ selectContextsWithParentID n = proc () -> do
...
@@ -102,7 +102,8 @@ selectContextsWithParentID n = proc () -> do
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Example of use:
-- | Example of use:
-- runCmdReplEasy (getNodesWithType NodeList (Proxy :: Proxy HyperdataList))
-- runCmdReplEasy (getNodesWithType NodeList (Proxy :: Proxy HyperdataList))
getContextsWithType
::
(
HasNodeError
err
,
JSONB
a
,
HasDBid
NodeType
)
=>
NodeType
->
proxy
a
->
Cmd
err
[
Context
a
]
getContextsWithType
::
(
HasNodeError
err
,
JSONB
a
,
HasDBid
NodeType
)
=>
NodeType
->
proxy
a
->
DBCmd
err
[
Context
a
]
getContextsWithType
nt
_
=
runOpaQuery
$
selectContextsWithType
nt
getContextsWithType
nt
_
=
runOpaQuery
$
selectContextsWithType
nt
where
where
selectContextsWithType
::
HasDBid
NodeType
selectContextsWithType
::
HasDBid
NodeType
...
@@ -112,7 +113,8 @@ getContextsWithType nt _ = runOpaQuery $ selectContextsWithType nt
...
@@ -112,7 +113,8 @@ getContextsWithType nt _ = runOpaQuery $ selectContextsWithType nt
restrict
-<
tn
.==
(
sqlInt4
$
toDBid
nt'
)
restrict
-<
tn
.==
(
sqlInt4
$
toDBid
nt'
)
returnA
-<
row
returnA
-<
row
getContextsIdWithType
::
(
HasNodeError
err
,
HasDBid
NodeType
)
=>
NodeType
->
Cmd
err
[
ContextId
]
getContextsIdWithType
::
(
HasNodeError
err
,
HasDBid
NodeType
)
=>
NodeType
->
DBCmd
err
[
ContextId
]
getContextsIdWithType
nt
=
do
getContextsIdWithType
nt
=
do
ns
<-
runOpaQuery
$
selectContextsIdWithType
nt
ns
<-
runOpaQuery
$
selectContextsIdWithType
nt
pure
(
map
NodeId
ns
)
pure
(
map
NodeId
ns
)
...
...
src/Gargantext/Database/Query/Table/Ngrams.hs
View file @
4ef66cea
...
@@ -28,7 +28,7 @@ import Data.HashMap.Strict (HashMap)
...
@@ -28,7 +28,7 @@ import Data.HashMap.Strict (HashMap)
import
Data.Map.Strict
(
Map
)
import
Data.Map.Strict
(
Map
)
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Database.Prelude
(
runOpaQuery
,
Cmd
,
formatPGSQuery
,
runPGSQuery
,
DBCmd
)
import
Gargantext.Database.Prelude
(
runOpaQuery
,
formatPGSQuery
,
runPGSQuery
,
DBCmd
)
import
Gargantext.Database.Query.Join
(
leftJoin3
)
import
Gargantext.Database.Query.Join
(
leftJoin3
)
import
Gargantext.Database.Query.Table.ContextNodeNgrams2
import
Gargantext.Database.Query.Table.ContextNodeNgrams2
import
Gargantext.Database.Query.Table.NodeNgrams
(
queryNodeNgramsTable
)
import
Gargantext.Database.Query.Table.NodeNgrams
(
queryNodeNgramsTable
)
...
@@ -45,7 +45,7 @@ import qualified Database.PostgreSQL.Simple as PGS
...
@@ -45,7 +45,7 @@ import qualified Database.PostgreSQL.Simple as PGS
queryNgramsTable
::
Select
NgramsRead
queryNgramsTable
::
Select
NgramsRead
queryNgramsTable
=
selectTable
ngramsTable
queryNgramsTable
=
selectTable
ngramsTable
selectNgramsByDoc
::
[
ListId
]
->
DocId
->
NgramsType
->
Cmd
err
[
Text
]
selectNgramsByDoc
::
[
ListId
]
->
DocId
->
NgramsType
->
DB
Cmd
err
[
Text
]
selectNgramsByDoc
lIds
dId
nt
=
runOpaQuery
(
query
lIds
dId
nt
)
selectNgramsByDoc
lIds
dId
nt
=
runOpaQuery
(
query
lIds
dId
nt
)
where
where
...
@@ -65,10 +65,10 @@ selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt)
...
@@ -65,10 +65,10 @@ selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt)
returnA
-<
ng
^.
ngrams_terms
returnA
-<
ng
^.
ngrams_terms
_postNgrams
::
CorpusId
->
DocId
->
[
Text
]
->
Cmd
err
Int
_postNgrams
::
CorpusId
->
DocId
->
[
Text
]
->
DB
Cmd
err
Int
_postNgrams
=
undefined
_postNgrams
=
undefined
_dbGetNgramsDb
::
Cmd
err
[
NgramsDB
]
_dbGetNgramsDb
::
DB
Cmd
err
[
NgramsDB
]
_dbGetNgramsDb
=
runOpaQuery
queryNgramsTable
_dbGetNgramsDb
=
runOpaQuery
queryNgramsTable
...
@@ -85,7 +85,7 @@ insertNgrams' ns = runPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
...
@@ -85,7 +85,7 @@ insertNgrams' ns = runPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
where
where
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
[
"text"
,
"int4"
]
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
[
"text"
,
"int4"
]
_insertNgrams_Debug
::
[(
Text
,
Size
)]
->
Cmd
err
ByteString
_insertNgrams_Debug
::
[(
Text
,
Size
)]
->
DB
Cmd
err
ByteString
_insertNgrams_Debug
ns
=
formatPGSQuery
queryInsertNgrams
(
PGS
.
Only
$
Values
fields
ns
)
_insertNgrams_Debug
ns
=
formatPGSQuery
queryInsertNgrams
(
PGS
.
Only
$
Values
fields
ns
)
where
where
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
[
"text"
,
"int4"
]
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
[
"text"
,
"int4"
]
...
@@ -111,13 +111,13 @@ queryInsertNgrams = [sql|
...
@@ -111,13 +111,13 @@ queryInsertNgrams = [sql|
--------------------------------------------------------------------------
--------------------------------------------------------------------------
selectNgramsId
::
[
Text
]
->
Cmd
err
(
Map
NgramsId
Text
)
selectNgramsId
::
[
Text
]
->
DB
Cmd
err
(
Map
NgramsId
Text
)
selectNgramsId
ns
=
selectNgramsId
ns
=
if
List
.
null
ns
if
List
.
null
ns
then
pure
Map
.
empty
then
pure
Map
.
empty
else
Map
.
fromList
<$>
map
(
\
(
Indexed
i
t
)
->
(
i
,
t
))
<$>
(
selectNgramsId'
ns
)
else
Map
.
fromList
<$>
map
(
\
(
Indexed
i
t
)
->
(
i
,
t
))
<$>
(
selectNgramsId'
ns
)
selectNgramsId'
::
[
Text
]
->
Cmd
err
[
Indexed
Int
Text
]
selectNgramsId'
::
[
Text
]
->
DB
Cmd
err
[
Indexed
Int
Text
]
selectNgramsId'
ns
=
runPGSQuery
querySelectNgramsId
(
PGS
.
Only
selectNgramsId'
ns
=
runPGSQuery
querySelectNgramsId
(
PGS
.
Only
$
Values
fields
ns
$
Values
fields
ns
)
)
...
...
src/Gargantext/Database/Query/Table/NgramsPostag.hs
View file @
4ef66cea
...
@@ -24,7 +24,7 @@ import Data.Hashable (Hashable)
...
@@ -24,7 +24,7 @@ import Data.Hashable (Hashable)
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
Gargantext.Core
import
Gargantext.Core
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Database.Prelude
(
Cmd
,
runPGSQuery
,
runPGSQuery_
,
DBCmd
)
import
Gargantext.Database.Prelude
(
runPGSQuery
,
runPGSQuery_
,
DBCmd
)
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Database.Schema.Prelude
import
Gargantext.Database.Schema.Prelude
import
Gargantext.Database.Query.Table.Ngrams
import
Gargantext.Database.Query.Table.Ngrams
...
@@ -155,7 +155,7 @@ SELECT terms,id FROM ins_form_ret
...
@@ -155,7 +155,7 @@ SELECT terms,id FROM ins_form_ret
-- TODO add lang and postag algo
-- TODO add lang and postag algo
-- TODO remove when form == lem in insert
-- TODO remove when form == lem in insert
selectLems
::
Lang
->
NLPServerConfig
->
[
Ngrams
]
->
Cmd
err
[(
Form
,
Lem
)]
selectLems
::
Lang
->
NLPServerConfig
->
[
Ngrams
]
->
DB
Cmd
err
[(
Form
,
Lem
)]
selectLems
l
(
NLPServerConfig
{
server
})
ns
=
runPGSQuery
querySelectLems
(
PGS
.
Only
$
Values
fields
datas
)
selectLems
l
(
NLPServerConfig
{
server
})
ns
=
runPGSQuery
querySelectLems
(
PGS
.
Only
$
Values
fields
datas
)
where
where
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
[
"int4"
,
"int4"
,
"text"
,
"int4"
]
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
[
"int4"
,
"int4"
,
"text"
,
"int4"
]
...
@@ -180,7 +180,7 @@ querySelectLems = [sql|
...
@@ -180,7 +180,7 @@ querySelectLems = [sql|
|]
|]
-- | Insert Table
-- | Insert Table
createTable_NgramsPostag
::
Cmd
err
[
Int
]
createTable_NgramsPostag
::
DB
Cmd
err
[
Int
]
createTable_NgramsPostag
=
map
(
\
(
PGS
.
Only
a
)
->
a
)
createTable_NgramsPostag
=
map
(
\
(
PGS
.
Only
a
)
->
a
)
<$>
runPGSQuery_
queryCreateTable
<$>
runPGSQuery_
queryCreateTable
where
where
...
...
src/Gargantext/Database/Query/Table/Node.hs
View file @
4ef66cea
...
@@ -25,22 +25,20 @@ import Control.Lens (set, view)
...
@@ -25,22 +25,20 @@ import Control.Lens (set, view)
import
Data.Aeson
import
Data.Aeson
import
Data.Maybe
(
fromMaybe
)
import
Data.Maybe
(
fromMaybe
)
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
Database.PostgreSQL.Simple
qualified
as
PGS
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Opaleye
hiding
(
FromField
)
import
Prelude
hiding
(
null
,
id
,
map
,
sum
)
import
Gargantext.Core
import
Gargantext.Core
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata.Default
import
Gargantext.Database.Admin.Types.Hyperdata.Default
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DBCmd
,
JSONB
,
mkCmd
,
runPGSQuery
,
runOpaQuery
)
import
Gargantext.Database.Query.Filter
(
limit'
,
offset'
)
import
Gargantext.Database.Query.Filter
(
limit'
,
offset'
)
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
import
Gargantext.Prelude
hiding
(
sum
,
head
)
import
Gargantext.Prelude
hiding
(
sum
,
head
)
import
Opaleye
hiding
(
FromField
)
import
qualified
Database.PostgreSQL.Simple
as
PGS
import
Prelude
hiding
(
null
,
id
,
map
,
sum
)
queryNodeSearchTable
::
Select
NodeSearchRead
queryNodeSearchTable
::
Select
NodeSearchRead
...
...
src/Gargantext/Database/Query/Table/Node/Children.hs
View file @
4ef66cea
...
@@ -22,15 +22,11 @@ import Gargantext.Core
...
@@ -22,15 +22,11 @@ import Gargantext.Core
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataDocument
,
HyperdataContact
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataDocument
,
HyperdataContact
)
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DBCmd
,
JSONB
,
runCountOpaQuery
,
runOpaQuery
)
import
Gargantext.Database.Query.Filter
import
Gargantext.Database.Query.Filter
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Context
import
Gargantext.Database.Schema.NodeContext
import
Gargantext.Database.Query.Table.NodeContext
import
Gargantext.Database.Query.Table.NodeContext
import
Gargantext.Database.Schema.Context
import
Gargantext.Database.Schema.Node
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Opaleye
import
Opaleye
...
...
src/Gargantext/Database/Query/Table/Node/Document/Add.hs
View file @
4ef66cea
...
@@ -28,7 +28,7 @@ import Database.PostgreSQL.Simple.ToRow (ToRow(..))
...
@@ -28,7 +28,7 @@ import Database.PostgreSQL.Simple.ToRow (ToRow(..))
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
Cmd
,
runPGSQuery
,
formatPGSQuery
,
DBCmd
)
import
Gargantext.Database.Prelude
(
runPGSQuery
,
formatPGSQuery
,
DBCmd
)
import
Gargantext.Prelude
import
Gargantext.Prelude
---------------------------------------------------------------------------
---------------------------------------------------------------------------
...
@@ -41,12 +41,12 @@ add pId ns = runPGSQuery queryAdd (Only $ Values fields inputData)
...
@@ -41,12 +41,12 @@ add pId ns = runPGSQuery queryAdd (Only $ Values fields inputData)
-- | Adds a single document. Useful for debugging purposes, but
-- | Adds a single document. Useful for debugging purposes, but
-- not as efficient as adding documents in bulk via 'add'.
-- not as efficient as adding documents in bulk via 'add'.
add_one
::
CorpusId
->
ContextId
->
Cmd
err
[
Only
Int
]
add_one
::
CorpusId
->
ContextId
->
DB
Cmd
err
[
Only
Int
]
add_one
pId
ctxId
=
runPGSQuery
queryAdd
(
Only
$
Values
fields
[
InputData
pId
ctxId
])
add_one
pId
ctxId
=
runPGSQuery
queryAdd
(
Only
$
Values
fields
[
InputData
pId
ctxId
])
where
where
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
inputSqlTypes
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
inputSqlTypes
add_debug
::
CorpusId
->
[
ContextId
]
->
Cmd
err
ByteString
add_debug
::
CorpusId
->
[
ContextId
]
->
DB
Cmd
err
ByteString
add_debug
pId
ns
=
formatPGSQuery
queryAdd
(
Only
$
Values
fields
inputData
)
add_debug
pId
ns
=
formatPGSQuery
queryAdd
(
Only
$
Values
fields
inputData
)
where
where
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
inputSqlTypes
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
inputSqlTypes
...
...
src/Gargantext/Database/Query/Table/Node/Select.hs
View file @
4ef66cea
...
@@ -16,16 +16,14 @@ module Gargantext.Database.Query.Table.Node.Select
...
@@ -16,16 +16,14 @@ module Gargantext.Database.Query.Table.Node.Select
where
where
import
Control.Arrow
(
returnA
)
import
Control.Arrow
(
returnA
)
import
Opaleye
import
Protolude
import
Gargantext.Core
import
Gargantext.Core
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Core.Types.Individu
(
Username
)
import
Gargantext.Core.Types.Individu
(
Username
)
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DBCmd
,
runOpaQuery
)
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.User
import
Gargantext.Database.Query.Table.User
import
Gargantext.Database.Query.Table.User
import
Gargantext.Database.Schema.Node
import
Opaleye
import
Protolude
selectNodesWithUsername
::
(
HasDBid
NodeType
)
=>
NodeType
->
Username
->
DBCmd
err
[
NodeId
]
selectNodesWithUsername
::
(
HasDBid
NodeType
)
=>
NodeType
->
Username
->
DBCmd
err
[
NodeId
]
selectNodesWithUsername
nt
u
=
runOpaQuery
$
proc
()
->
do
selectNodesWithUsername
nt
u
=
runOpaQuery
$
proc
()
->
do
...
...
src/Gargantext/Database/Query/Table/Node/Update.hs
View file @
4ef66cea
...
@@ -19,7 +19,7 @@ import Database.PostgreSQL.Simple
...
@@ -19,7 +19,7 @@ import Database.PostgreSQL.Simple
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Core.Types
(
Name
)
import
Gargantext.Core.Types
(
Name
)
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DBCmd
,
runPGSQuery
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
,
ParentId
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
,
ParentId
)
-- import Data.ByteString
-- import Data.ByteString
...
@@ -39,7 +39,7 @@ unOnly :: Only a -> a
...
@@ -39,7 +39,7 @@ unOnly :: Only a -> a
unOnly
(
Only
a
)
=
a
unOnly
(
Only
a
)
=
a
-- TODO-ACCESS
-- TODO-ACCESS
update
::
Update
->
Cmd
err
[
Int
]
update
::
Update
->
DB
Cmd
err
[
Int
]
update
(
Rename
nId
name
)
=
map
unOnly
<$>
runPGSQuery
"UPDATE nodes SET name=? where id=? returning id"
update
(
Rename
nId
name
)
=
map
unOnly
<$>
runPGSQuery
"UPDATE nodes SET name=? where id=? returning id"
(
DT
.
take
255
name
,
nId
)
(
DT
.
take
255
name
,
nId
)
update
(
Move
nId
pId
)
=
map
unOnly
<$>
runPGSQuery
"UPDATE nodes SET parent_id= ? where id=? returning id"
update
(
Move
nId
pId
)
=
map
unOnly
<$>
runPGSQuery
"UPDATE nodes SET parent_id= ? where id=? returning id"
...
...
src/Gargantext/Database/Query/Table/Node/UpdateOpaleye.hs
View file @
4ef66cea
...
@@ -22,7 +22,7 @@ import Gargantext.Prelude
...
@@ -22,7 +22,7 @@ import Gargantext.Prelude
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
Cmd
,
mkCmd
,
DBCmd
)
import
Gargantext.Database.Prelude
(
mkCmd
,
DBCmd
)
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Query.Table.Node.Error
...
@@ -49,7 +49,7 @@ updateHyperdataQuery i h = seq h' $ {- trace "updateHyperdataQuery: encoded JSON
...
@@ -49,7 +49,7 @@ updateHyperdataQuery i h = seq h' $ {- trace "updateHyperdataQuery: encoded JSON
updateNodesWithType
::
(
HasNodeError
err
updateNodesWithType
::
(
HasNodeError
err
,
HasDBid
NodeType
,
HasDBid
NodeType
,
HyperdataC
a
,
HyperdataC
a
)
=>
NodeType
->
proxy
a
->
(
a
->
a
)
->
Cmd
err
[
Int64
]
)
=>
NodeType
->
proxy
a
->
(
a
->
a
)
->
DB
Cmd
err
[
Int64
]
updateNodesWithType
nt
p
f
=
do
updateNodesWithType
nt
p
f
=
do
ns
<-
getNodesWithType
nt
p
ns
<-
getNodesWithType
nt
p
mapM
(
\
n
->
updateHyperdata
(
_node_id
n
)
(
f
$
_node_hyperdata
n
))
ns
mapM
(
\
n
->
updateHyperdata
(
_node_id
n
)
(
f
$
_node_hyperdata
n
))
ns
...
@@ -61,7 +61,7 @@ updateNodeWithType :: ( HasNodeError err
...
@@ -61,7 +61,7 @@ updateNodeWithType :: ( HasNodeError err
->
NodeType
->
NodeType
->
proxy
a
->
proxy
a
->
(
a
->
a
)
->
(
a
->
a
)
->
Cmd
err
[
Int64
]
->
DB
Cmd
err
[
Int64
]
updateNodeWithType
nId
nt
p
f
=
do
updateNodeWithType
nId
nt
p
f
=
do
ns
<-
getNodeWithType
nId
nt
p
ns
<-
getNodeWithType
nId
nt
p
mapM
(
\
n
->
updateHyperdata
(
_node_id
n
)
(
f
$
_node_hyperdata
n
))
ns
mapM
(
\
n
->
updateHyperdata
(
_node_id
n
)
(
f
$
_node_hyperdata
n
))
ns
...
@@ -71,7 +71,7 @@ updateNodeWithType nId nt p f = do
...
@@ -71,7 +71,7 @@ updateNodeWithType nId nt p f = do
updateNodesWithType_
::
(
HasNodeError
err
updateNodesWithType_
::
(
HasNodeError
err
,
HyperdataC
a
,
HyperdataC
a
,
HasDBid
NodeType
,
HasDBid
NodeType
)
=>
NodeType
->
a
->
Cmd
err
[
Int64
]
)
=>
NodeType
->
a
->
DB
Cmd
err
[
Int64
]
updateNodesWithType_
nt
h
=
do
updateNodesWithType_
nt
h
=
do
ns
<-
getNodesIdWithType
nt
ns
<-
getNodesIdWithType
nt
mapM
(
\
n
->
updateHyperdata
n
h
)
ns
mapM
(
\
n
->
updateHyperdata
n
h
)
ns
src/Gargantext/Database/Query/Table/Node/User.hs
View file @
4ef66cea
...
@@ -17,14 +17,14 @@ import Gargantext.Core
...
@@ -17,14 +17,14 @@ import Gargantext.Core
import
Gargantext.Core.Types
(
Name
)
import
Gargantext.Core.Types
(
Name
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataUser
(
..
),
defaultHyperdataUser
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataUser
(
..
),
defaultHyperdataUser
)
import
Gargantext.Database.Admin.Types.Node
(
Node
,
NodeId
(
..
),
UserId
,
NodeType
(
..
),
pgNodeId
)
import
Gargantext.Database.Admin.Types.Node
(
Node
,
NodeId
(
..
),
UserId
,
NodeType
(
..
),
pgNodeId
)
import
Gargantext.Database.Prelude
-- (fromField', Cmd
)
import
Gargantext.Database.Prelude
(
DBCmd
,
runOpaQuery
)
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Schema.Node
-- (Node(..))
import
Gargantext.Database.Schema.Node
-- (Node(..))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Opaleye
(
limit
)
import
Opaleye
(
limit
)
getNodeUser
::
NodeId
->
Cmd
err
(
Node
HyperdataUser
)
getNodeUser
::
NodeId
->
DB
Cmd
err
(
Node
HyperdataUser
)
getNodeUser
nId
=
do
getNodeUser
nId
=
do
fromMaybe
(
panic
$
"Node does not exist: "
<>
(
cs
$
show
nId
))
.
headMay
fromMaybe
(
panic
$
"Node does not exist: "
<>
(
cs
$
show
nId
))
.
headMay
<$>
runOpaQuery
(
limit
1
$
selectNode
(
pgNodeId
nId
))
<$>
runOpaQuery
(
limit
1
$
selectNode
(
pgNodeId
nId
))
...
...
src/Gargantext/Database/Query/Table/NodeContext.hs
View file @
4ef66cea
...
@@ -46,25 +46,23 @@ module Gargantext.Database.Query.Table.NodeContext
...
@@ -46,25 +46,23 @@ module Gargantext.Database.Query.Table.NodeContext
import
Control.Arrow
(
returnA
)
import
Control.Arrow
(
returnA
)
import
Control.Lens
(
view
,
(
^.
))
import
Control.Lens
(
view
,
(
^.
))
import
Data.Maybe
(
catMaybes
)
import
Data.Maybe
(
catMaybes
)
import
Data.Time
(
UTCTime
)
import
Data.Text
(
Text
,
splitOn
)
import
Data.Text
(
Text
,
splitOn
)
import
Data.Time
(
UTCTime
)
import
Database.PostgreSQL.Simple
qualified
as
PGS
(
In
(
..
),
Query
,
Only
(
..
))
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Opaleye
import
qualified
Database.PostgreSQL.Simple
as
PGS
(
In
(
..
),
Query
,
Only
(
..
))
import
qualified
Opaleye
as
O
import
Gargantext.Core
import
Gargantext.Core
import
Gargantext.Core.Types
import
Gargantext.Core.Types
-- import Gargantext.Core.Types.Search (HyperdataRow(..), toHyperdataRow)
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Prelude
(
DBCmd
,
execPGSQuery
,
mkCmd
,
restrictMaybe
,
runCountOpaQuery
,
runPGSQuery
,
runOpaQuery
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
,
NodeError
(
DoesNotExist
),
nodeError
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
,
NodeError
(
DoesNotExist
),
nodeError
)
import
Gargantext.Database.Prelude
import
Gargantext.Prelude.Crypto.Hash
(
Hash
)
import
Gargantext.Database.Schema.Context
import
Gargantext.Database.Schema.Context
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.NodeContext
import
Gargantext.Database.Schema.NodeContext
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Prelude.Crypto.Hash
(
Hash
)
import
Opaleye
import
Opaleye
qualified
as
O
queryNodeContextTable
::
Select
NodeContextRead
queryNodeContextTable
::
Select
NodeContextRead
queryNodeContextTable
=
selectTable
nodeContextTable
queryNodeContextTable
=
selectTable
nodeContextTable
...
...
src/Gargantext/Database/Query/Table/NodeContext_NodeContext.hs
View file @
4ef66cea
...
@@ -20,12 +20,12 @@ module Gargantext.Database.Query.Table.NodeContext_NodeContext
...
@@ -20,12 +20,12 @@ module Gargantext.Database.Query.Table.NodeContext_NodeContext
where
where
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
Database.PostgreSQL.Simple
qualified
as
PGS
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DBCmd
,
runPGSQuery
)
import
Gargantext.Database.Schema.NodeContext_NodeContext
import
Gargantext.Database.Schema.NodeContext_NodeContext
import
Gargantext.Database.Schema.Prelude
hiding
(
sum
)
import
Gargantext.Database.Schema.Prelude
hiding
(
sum
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
qualified
Database.PostgreSQL.Simple
as
PGS
{-
{-
queryNodeContext_NodeContextTable :: Select NodeContext_NodeContextRead
queryNodeContext_NodeContextTable :: Select NodeContext_NodeContextRead
...
...
src/Gargantext/Database/Query/Table/NodeNgrams.hs
View file @
4ef66cea
...
@@ -26,20 +26,20 @@ module Gargantext.Database.Query.Table.NodeNgrams
...
@@ -26,20 +26,20 @@ module Gargantext.Database.Query.Table.NodeNgrams
)
)
where
where
import
Data.List
qualified
as
List
import
Data.List.Extra
(
nubOrd
)
import
Data.List.Extra
(
nubOrd
)
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.Text
(
Text
)
import
Data.Text
(
Text
)
import
Database.PostgreSQL.Simple
qualified
as
PGS
(
Query
,
Only
(
..
))
import
Gargantext.Core
import
Gargantext.Core
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DBCmd
,
runPGSQuery
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
,
ngramsTypeId
,
fromNgramsTypeId
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
,
ngramsTypeId
,
fromNgramsTypeId
)
import
Gargantext.Database.Schema.NodeNgrams
import
Gargantext.Database.Schema.NodeNgrams
import
Gargantext.Database.Schema.Prelude
(
Select
,
FromRow
,
sql
,
fromRow
,
toField
,
field
,
Values
(
..
),
QualifiedIdentifier
(
..
),
selectTable
)
import
Gargantext.Database.Schema.Prelude
(
Select
,
FromRow
,
sql
,
fromRow
,
toField
,
field
,
Values
(
..
),
QualifiedIdentifier
(
..
),
selectTable
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
qualified
Data.List
as
List
import
qualified
Data.Map.Strict
as
Map
import
qualified
Database.PostgreSQL.Simple
as
PGS
(
Query
,
Only
(
..
))
queryNodeNgramsTable
::
Select
NodeNgramsRead
queryNodeNgramsTable
::
Select
NodeNgramsRead
...
@@ -62,11 +62,9 @@ getCgramsId mapId nt t = case Map.lookup nt mapId of
...
@@ -62,11 +62,9 @@ getCgramsId mapId nt t = case Map.lookup nt mapId of
Just
mapId'
->
Map
.
lookup
t
mapId'
Just
mapId'
->
Map
.
lookup
t
mapId'
-- insertDb :: ListId -> Map NgramsType [NgramsElement] -> Cmd err [Result]
listInsertDb
::
Show
a
=>
ListId
listInsertDb
::
Show
a
=>
ListId
->
(
ListId
->
a
->
[
NodeNgramsW
])
->
(
ListId
->
a
->
[
NodeNgramsW
])
->
a
->
a
-- -> Cmd err [Returning]
->
DBCmd
err
(
Map
NgramsType
(
Map
Text
Int
))
->
DBCmd
err
(
Map
NgramsType
(
Map
Text
Int
))
listInsertDb
l
f
ngs
=
Map
.
map
Map
.
fromList
listInsertDb
l
f
ngs
=
Map
.
map
Map
.
fromList
<$>
Map
.
fromListWith
(
<>
)
<$>
Map
.
fromListWith
(
<>
)
...
...
src/Gargantext/Database/Query/Table/NodeNode.hs
View file @
4ef66cea
...
@@ -35,20 +35,20 @@ module Gargantext.Database.Query.Table.NodeNode
...
@@ -35,20 +35,20 @@ module Gargantext.Database.Query.Table.NodeNode
import
Control.Arrow
(
returnA
)
import
Control.Arrow
(
returnA
)
import
Control.Lens
((
^.
),
view
)
import
Control.Lens
((
^.
),
view
)
import
Data.Text
(
Text
,
splitOn
)
import
Data.Maybe
(
catMaybes
)
import
Data.Maybe
(
catMaybes
)
import
Data.Text
(
Text
,
splitOn
)
import
Database.PostgreSQL.Simple
qualified
as
PGS
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Gargantext.Core
import
Gargantext.Core
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DBCmd
,
mkCmd
,
runPGSQuery
,
runCountOpaQuery
,
runOpaQuery
)
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.NodeNode
import
Gargantext.Database.Schema.NodeNode
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Opaleye
import
Opaleye
import
qualified
Database.PostgreSQL.Simple
as
PGS
import
Opaleye
qualified
as
O
import
qualified
Opaleye
as
O
queryNodeNodeTable
::
Select
NodeNodeRead
queryNodeNodeTable
::
Select
NodeNodeRead
queryNodeNodeTable
=
selectTable
nodeNodeTable
queryNodeNodeTable
=
selectTable
nodeNodeTable
...
...
src/Gargantext/Database/Query/Table/NodeNodeNgrams.hs
View file @
4ef66cea
...
@@ -23,7 +23,7 @@ module Gargantext.Database.Query.Table.NodeNodeNgrams
...
@@ -23,7 +23,7 @@ module Gargantext.Database.Query.Table.NodeNodeNgrams
where
where
import
Gargantext.Database.Admin.Types.Node
(
pgNodeId
)
import
Gargantext.Database.Admin.Types.Node
(
pgNodeId
)
import
Gargantext.Database.Prelude
(
Cmd
,
mkCmd
)
import
Gargantext.Database.Prelude
(
DB
Cmd
,
mkCmd
)
import
Gargantext.Database.Schema.Ngrams
(
pgNgramsTypeId
)
import
Gargantext.Database.Schema.Ngrams
(
pgNgramsTypeId
)
import
Gargantext.Database.Schema.NodeNodeNgrams
import
Gargantext.Database.Schema.NodeNodeNgrams
import
Gargantext.Database.Schema.Prelude
import
Gargantext.Database.Schema.Prelude
...
@@ -34,7 +34,7 @@ queryNodeNodeNgramsTable :: Query NodeNodeNgramsRead
...
@@ -34,7 +34,7 @@ queryNodeNodeNgramsTable :: Query NodeNodeNgramsRead
queryNodeNodeNgramsTable
=
selectTable
nodeNodeNgramsTable
queryNodeNodeNgramsTable
=
selectTable
nodeNodeNgramsTable
-- | Insert utils
-- | Insert utils
insertNodeNodeNgrams
::
[
NodeNodeNgrams
]
->
Cmd
err
Int
insertNodeNodeNgrams
::
[
NodeNodeNgrams
]
->
DB
Cmd
err
Int
insertNodeNodeNgrams
=
insertNodeNodeNgramsW
insertNodeNodeNgrams
=
insertNodeNodeNgramsW
.
map
(
\
(
NodeNodeNgrams
n1
n2
ng
nt
w
)
->
.
map
(
\
(
NodeNodeNgrams
n1
n2
ng
nt
w
)
->
NodeNodeNgrams
(
pgNodeId
n1
)
NodeNodeNgrams
(
pgNodeId
n1
)
...
@@ -44,7 +44,7 @@ insertNodeNodeNgrams = insertNodeNodeNgramsW
...
@@ -44,7 +44,7 @@ insertNodeNodeNgrams = insertNodeNodeNgramsW
(
sqlDouble
w
)
(
sqlDouble
w
)
)
)
insertNodeNodeNgramsW
::
[
NodeNodeNgramsWrite
]
->
Cmd
err
Int
insertNodeNodeNgramsW
::
[
NodeNodeNgramsWrite
]
->
DB
Cmd
err
Int
insertNodeNodeNgramsW
nnnw
=
insertNodeNodeNgramsW
nnnw
=
mkCmd
$
\
c
->
fromIntegral
<$>
runInsert_
c
insertNothing
mkCmd
$
\
c
->
fromIntegral
<$>
runInsert_
c
insertNothing
where
where
...
...
src/Gargantext/Database/Query/Table/User.hs
View file @
4ef66cea
...
@@ -58,7 +58,7 @@ import Gargantext.Core.Types.Individu
...
@@ -58,7 +58,7 @@ import Gargantext.Core.Types.Individu
import
qualified
Gargantext.Prelude.Crypto.Auth
as
Auth
import
qualified
Gargantext.Prelude.Crypto.Auth
as
Auth
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataUser
(
..
),
hu_pubmed_api_key
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataUser
(
..
),
hu_pubmed_api_key
)
import
Gargantext.Database.Admin.Types.Node
(
NodeType
(
NodeUser
),
Node
,
NodeId
(
..
),
pgNodeId
)
import
Gargantext.Database.Admin.Types.Node
(
NodeType
(
NodeUser
),
Node
,
NodeId
(
..
),
pgNodeId
)
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
(
DBCmd
,
mkCmd
,
runOpaQuery
)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateNodeWithType
)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateNodeWithType
)
import
Gargantext.Database.Schema.Node
(
NodeRead
,
node_hyperdata
,
queryNodeTable
,
node_id
,
node_user_id
,
node_typename
)
import
Gargantext.Database.Schema.Node
(
NodeRead
,
node_hyperdata
,
queryNodeTable
,
node_id
,
node_user_id
,
node_typename
)
import
Gargantext.Database.Schema.User
import
Gargantext.Database.Schema.User
...
@@ -76,14 +76,14 @@ insertUsers us = mkCmd $ \c -> runInsert c insert
...
@@ -76,14 +76,14 @@ insertUsers us = mkCmd $ \c -> runInsert c insert
where
where
insert
=
Insert
userTable
us
rCount
Nothing
insert
=
Insert
userTable
us
rCount
Nothing
deleteUsers
::
[
Username
]
->
Cmd
err
Int64
deleteUsers
::
[
Username
]
->
DB
Cmd
err
Int64
deleteUsers
us
=
mkCmd
$
\
c
->
runDelete_
c
deleteUsers
us
=
mkCmd
$
\
c
->
runDelete_
c
$
Delete
userTable
$
Delete
userTable
(
\
user
->
in_
(
map
sqlStrictText
us
)
(
user_username
user
))
(
\
user
->
in_
(
map
sqlStrictText
us
)
(
user_username
user
))
rCount
rCount
-- Updates email or password only (for now)
-- Updates email or password only (for now)
updateUserDB
::
UserWrite
->
Cmd
err
Int64
updateUserDB
::
UserWrite
->
DB
Cmd
err
Int64
updateUserDB
us
=
mkCmd
$
\
c
->
runUpdate_
c
(
updateUserQuery
us
)
updateUserDB
us
=
mkCmd
$
\
c
->
runUpdate_
c
(
updateUserQuery
us
)
where
where
updateUserQuery
::
UserWrite
->
Update
Int64
updateUserQuery
::
UserWrite
->
Update
Int64
...
@@ -119,7 +119,7 @@ toUserWrite (NewUser u m (Auth.PasswordHash p)) =
...
@@ -119,7 +119,7 @@ toUserWrite (NewUser u m (Auth.PasswordHash p)) =
,
user_forgot_password_uuid
=
Nothing
}
,
user_forgot_password_uuid
=
Nothing
}
------------------------------------------------------------------
------------------------------------------------------------------
getUsersWith
::
Username
->
Cmd
err
[
UserLight
]
getUsersWith
::
Username
->
DB
Cmd
err
[
UserLight
]
getUsersWith
u
=
map
toUserLight
<$>
runOpaQuery
(
selectUsersLightWith
u
)
getUsersWith
u
=
map
toUserLight
<$>
runOpaQuery
(
selectUsersLightWith
u
)
selectUsersLightWith
::
Username
->
Select
UserRead
selectUsersLightWith
::
Username
->
Select
UserRead
...
@@ -128,7 +128,7 @@ selectUsersLightWith u = proc () -> do
...
@@ -128,7 +128,7 @@ selectUsersLightWith u = proc () -> do
restrict
-<
user_username
row
.==
sqlStrictText
u
restrict
-<
user_username
row
.==
sqlStrictText
u
returnA
-<
row
returnA
-<
row
getUsersWithEmail
::
Text
->
Cmd
err
[
UserLight
]
getUsersWithEmail
::
Text
->
DB
Cmd
err
[
UserLight
]
getUsersWithEmail
e
=
map
toUserLight
<$>
runOpaQuery
(
selectUsersLightWithEmail
e
)
getUsersWithEmail
e
=
map
toUserLight
<$>
runOpaQuery
(
selectUsersLightWithEmail
e
)
selectUsersLightWithEmail
::
Text
->
Select
UserRead
selectUsersLightWithEmail
::
Text
->
Select
UserRead
...
@@ -137,7 +137,7 @@ selectUsersLightWithEmail e = proc () -> do
...
@@ -137,7 +137,7 @@ selectUsersLightWithEmail e = proc () -> do
restrict
-<
user_email
row
.==
sqlStrictText
e
restrict
-<
user_email
row
.==
sqlStrictText
e
returnA
-<
row
returnA
-<
row
getUsersWithForgotPasswordUUID
::
UUID
.
UUID
->
Cmd
err
[
UserLight
]
getUsersWithForgotPasswordUUID
::
UUID
.
UUID
->
DB
Cmd
err
[
UserLight
]
getUsersWithForgotPasswordUUID
uuid
=
map
toUserLight
<$>
runOpaQuery
(
selectUsersLightWithForgotPasswordUUID
uuid
)
getUsersWithForgotPasswordUUID
uuid
=
map
toUserLight
<$>
runOpaQuery
(
selectUsersLightWithForgotPasswordUUID
uuid
)
selectUsersLightWithForgotPasswordUUID
::
UUID
.
UUID
->
Select
UserRead
selectUsersLightWithForgotPasswordUUID
::
UUID
.
UUID
->
Select
UserRead
...
@@ -173,7 +173,7 @@ queryUserTable = selectTable userTable
...
@@ -173,7 +173,7 @@ queryUserTable = selectTable userTable
----------------------------------------------------------------------
----------------------------------------------------------------------
-- | Get hyperdata associated with user node.
-- | Get hyperdata associated with user node.
getUserHyperdata
::
User
->
Cmd
err
[
HyperdataUser
]
getUserHyperdata
::
User
->
DB
Cmd
err
[
HyperdataUser
]
getUserHyperdata
(
RootId
uId
)
=
do
getUserHyperdata
(
RootId
uId
)
=
do
runOpaQuery
(
selectUserHyperdataWithId
uId
)
runOpaQuery
(
selectUserHyperdataWithId
uId
)
where
where
...
@@ -195,7 +195,7 @@ getUserHyperdata _ = undefined
...
@@ -195,7 +195,7 @@ getUserHyperdata _ = undefined
-- | Same as `getUserHyperdata` but returns a `Node` type.
-- | Same as `getUserHyperdata` but returns a `Node` type.
getUserNodeHyperdata
::
User
->
Cmd
err
[
Node
HyperdataUser
]
getUserNodeHyperdata
::
User
->
DB
Cmd
err
[
Node
HyperdataUser
]
getUserNodeHyperdata
(
RootId
uId
)
=
do
getUserNodeHyperdata
(
RootId
uId
)
=
do
runOpaQuery
(
selectUserHyperdataWithId
uId
)
runOpaQuery
(
selectUserHyperdataWithId
uId
)
where
where
...
@@ -215,14 +215,14 @@ getUserNodeHyperdata (UserDBId uId) = do
...
@@ -215,14 +215,14 @@ getUserNodeHyperdata (UserDBId uId) = do
returnA
-<
row
returnA
-<
row
getUserNodeHyperdata
_
=
undefined
getUserNodeHyperdata
_
=
undefined
getUsersWithHyperdata
::
User
->
Cmd
err
[(
UserLight
,
HyperdataUser
)]
getUsersWithHyperdata
::
User
->
DB
Cmd
err
[(
UserLight
,
HyperdataUser
)]
getUsersWithHyperdata
i
=
do
getUsersWithHyperdata
i
=
do
u
<-
getUsersWithId
i
u
<-
getUsersWithId
i
h
<-
getUserHyperdata
i
h
<-
getUserHyperdata
i
-- printDebug "[getUsersWithHyperdata]" (u,h)
-- printDebug "[getUsersWithHyperdata]" (u,h)
pure
$
zip
u
h
pure
$
zip
u
h
getUsersWithNodeHyperdata
::
User
->
Cmd
err
[(
UserLight
,
Node
HyperdataUser
)]
getUsersWithNodeHyperdata
::
User
->
DB
Cmd
err
[(
UserLight
,
Node
HyperdataUser
)]
getUsersWithNodeHyperdata
i
=
do
getUsersWithNodeHyperdata
i
=
do
u
<-
getUsersWithId
i
u
<-
getUsersWithId
i
h
<-
getUserNodeHyperdata
i
h
<-
getUserNodeHyperdata
i
...
@@ -230,7 +230,7 @@ getUsersWithNodeHyperdata i = do
...
@@ -230,7 +230,7 @@ getUsersWithNodeHyperdata i = do
pure
$
zip
u
h
pure
$
zip
u
h
updateUserEmail
::
UserLight
->
Cmd
err
Int64
updateUserEmail
::
UserLight
->
DB
Cmd
err
Int64
updateUserEmail
(
UserLight
{
..
})
=
mkCmd
$
\
c
->
runUpdate_
c
updateUserQuery
updateUserEmail
(
UserLight
{
..
})
=
mkCmd
$
\
c
->
runUpdate_
c
updateUserQuery
where
where
updateUserQuery
::
Update
Int64
updateUserQuery
::
Update
Int64
...
@@ -240,7 +240,7 @@ updateUserEmail (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c updateUserQuery
...
@@ -240,7 +240,7 @@ updateUserEmail (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c updateUserQuery
,
uWhere
=
(
\
row
->
user_id
row
.==
(
sqlInt4
userLight_id
))
,
uWhere
=
(
\
row
->
user_id
row
.==
(
sqlInt4
userLight_id
))
,
uReturning
=
rCount
}
,
uReturning
=
rCount
}
updateUserPassword
::
UserLight
->
Cmd
err
Int64
updateUserPassword
::
UserLight
->
DB
Cmd
err
Int64
updateUserPassword
(
UserLight
{
userLight_password
=
GargPassword
password
,
..
})
=
mkCmd
$
\
c
->
runUpdate_
c
updateUserQuery
updateUserPassword
(
UserLight
{
userLight_password
=
GargPassword
password
,
..
})
=
mkCmd
$
\
c
->
runUpdate_
c
updateUserQuery
where
where
updateUserQuery
::
Update
Int64
updateUserQuery
::
Update
Int64
...
@@ -250,7 +250,7 @@ updateUserPassword (UserLight { userLight_password = GargPassword password, .. }
...
@@ -250,7 +250,7 @@ updateUserPassword (UserLight { userLight_password = GargPassword password, .. }
,
uWhere
=
\
row
->
user_id
row
.==
sqlInt4
userLight_id
,
uWhere
=
\
row
->
user_id
row
.==
sqlInt4
userLight_id
,
uReturning
=
rCount
}
,
uReturning
=
rCount
}
updateUserForgotPasswordUUID
::
UserLight
->
Cmd
err
Int64
updateUserForgotPasswordUUID
::
UserLight
->
DB
Cmd
err
Int64
updateUserForgotPasswordUUID
(
UserLight
{
..
})
=
mkCmd
$
\
c
->
runUpdate_
c
updateUserQuery
updateUserForgotPasswordUUID
(
UserLight
{
..
})
=
mkCmd
$
\
c
->
runUpdate_
c
updateUserQuery
where
where
pass
=
sqlStrictText
$
fromMaybe
""
userLight_forgot_password_uuid
pass
=
sqlStrictText
$
fromMaybe
""
userLight_forgot_password_uuid
...
@@ -261,7 +261,7 @@ updateUserForgotPasswordUUID (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c upd
...
@@ -261,7 +261,7 @@ updateUserForgotPasswordUUID (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c upd
,
uWhere
=
\
row
->
user_id
row
.==
sqlInt4
userLight_id
,
uWhere
=
\
row
->
user_id
row
.==
sqlInt4
userLight_id
,
uReturning
=
rCount
}
,
uReturning
=
rCount
}
getUserPubmedAPIKey
::
User
->
Cmd
err
(
Maybe
PUBMED
.
APIKey
)
getUserPubmedAPIKey
::
User
->
DB
Cmd
err
(
Maybe
PUBMED
.
APIKey
)
getUserPubmedAPIKey
user
=
do
getUserPubmedAPIKey
user
=
do
hs
<-
getUserHyperdata
user
hs
<-
getUserHyperdata
user
case
hs
of
case
hs
of
...
@@ -269,7 +269,7 @@ getUserPubmedAPIKey user = do
...
@@ -269,7 +269,7 @@ getUserPubmedAPIKey user = do
(
x
:
_
)
->
pure
$
_hu_pubmed_api_key
x
(
x
:
_
)
->
pure
$
_hu_pubmed_api_key
x
updateUserPubmedAPIKey
::
(
HasDBid
NodeType
,
HasNodeError
err
)
updateUserPubmedAPIKey
::
(
HasDBid
NodeType
,
HasNodeError
err
)
=>
User
->
PUBMED
.
APIKey
->
Cmd
err
Int64
=>
User
->
PUBMED
.
APIKey
->
DB
Cmd
err
Int64
updateUserPubmedAPIKey
(
RootId
uId
)
apiKey
=
do
updateUserPubmedAPIKey
(
RootId
uId
)
apiKey
=
do
_
<-
updateNodeWithType
uId
NodeUser
(
Proxy
::
Proxy
HyperdataUser
)
(
\
h
->
h
&
hu_pubmed_api_key
?~
apiKey
)
_
<-
updateNodeWithType
uId
NodeUser
(
Proxy
::
Proxy
HyperdataUser
)
(
\
h
->
h
&
hu_pubmed_api_key
?~
apiKey
)
pure
1
pure
1
...
@@ -303,7 +303,7 @@ getUser :: Username -> DBCmd err (Maybe UserLight)
...
@@ -303,7 +303,7 @@ getUser :: Username -> DBCmd err (Maybe UserLight)
getUser
u
=
userLightWithUsername
u
<$>
usersLight
getUser
u
=
userLightWithUsername
u
<$>
usersLight
----------------------------------------------------------------------
----------------------------------------------------------------------
insertNewUsers
::
[
NewUser
GargPassword
]
->
Cmd
err
Int64
insertNewUsers
::
[
NewUser
GargPassword
]
->
DB
Cmd
err
Int64
insertNewUsers
newUsers
=
do
insertNewUsers
newUsers
=
do
users'
<-
liftBase
$
mapM
toUserHash
newUsers
users'
<-
liftBase
$
mapM
toUserHash
newUsers
insertUsers
$
map
toUserWrite
users'
insertUsers
$
map
toUserWrite
users'
...
...
src/Gargantext/Database/Query/Tree.hs
View file @
4ef66cea
...
@@ -60,7 +60,7 @@ import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
...
@@ -60,7 +60,7 @@ import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
import
Gargantext.Database.Admin.Config
(
fromNodeTypeId
,
nodeTypeId
,
fromNodeTypeId
)
import
Gargantext.Database.Admin.Config
(
fromNodeTypeId
,
nodeTypeId
,
fromNodeTypeId
)
import
Gargantext.Database.Admin.Types.Hyperdata.Any
(
HyperdataAny
)
import
Gargantext.Database.Admin.Types.Hyperdata.Any
(
HyperdataAny
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
Cmd
,
runPGSQuery
,
DBCmd
)
import
Gargantext.Database.Prelude
(
runPGSQuery
,
DBCmd
)
import
Gargantext.Database.Query.Table.Node
(
getNodeWith
)
import
Gargantext.Database.Query.Table.Node
(
getNodeWith
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.NodeNode
(
getNodeNode
)
import
Gargantext.Database.Query.Table.NodeNode
(
getNodeNode
)
...
@@ -89,7 +89,7 @@ tree :: (HasTreeError err, HasNodeError err)
...
@@ -89,7 +89,7 @@ tree :: (HasTreeError err, HasNodeError err)
=>
TreeMode
=>
TreeMode
->
RootId
->
RootId
->
[
NodeType
]
->
[
NodeType
]
->
Cmd
err
(
Tree
NodeTree
)
->
DB
Cmd
err
(
Tree
NodeTree
)
tree
TreeBasic
=
tree_basic
tree
TreeBasic
=
tree_basic
tree
TreeAdvanced
=
tree_advanced
tree
TreeAdvanced
=
tree_advanced
tree
TreeFirstLevel
=
tree_first_level
tree
TreeFirstLevel
=
tree_first_level
...
@@ -100,7 +100,7 @@ tree TreeFirstLevel = tree_first_level
...
@@ -100,7 +100,7 @@ tree TreeFirstLevel = tree_first_level
tree_basic
::
(
HasTreeError
err
,
HasNodeError
err
)
tree_basic
::
(
HasTreeError
err
,
HasNodeError
err
)
=>
RootId
=>
RootId
->
[
NodeType
]
->
[
NodeType
]
->
Cmd
err
(
Tree
NodeTree
)
->
DB
Cmd
err
(
Tree
NodeTree
)
tree_basic
r
nodeTypes
=
tree_basic
r
nodeTypes
=
(
dbTree
r
nodeTypes
<&>
toTreeParent
)
>>=
toTree
(
dbTree
r
nodeTypes
<&>
toTreeParent
)
>>=
toTree
-- Same as (but easier to read) :
-- Same as (but easier to read) :
...
@@ -110,7 +110,7 @@ tree_basic r nodeTypes =
...
@@ -110,7 +110,7 @@ tree_basic r nodeTypes =
tree_advanced
::
(
HasTreeError
err
,
HasNodeError
err
)
tree_advanced
::
(
HasTreeError
err
,
HasNodeError
err
)
=>
RootId
=>
RootId
->
[
NodeType
]
->
[
NodeType
]
->
Cmd
err
(
Tree
NodeTree
)
->
DB
Cmd
err
(
Tree
NodeTree
)
tree_advanced
r
nodeTypes
=
do
tree_advanced
r
nodeTypes
=
do
-- let rPrefix s = "[tree_advanced] root = " <> show r <> " " <> s
-- let rPrefix s = "[tree_advanced] root = " <> show r <> " " <> s
mainRoot
<-
findNodes
r
Private
nodeTypes
mainRoot
<-
findNodes
r
Private
nodeTypes
...
@@ -128,7 +128,7 @@ tree_advanced r nodeTypes = do
...
@@ -128,7 +128,7 @@ tree_advanced r nodeTypes = do
tree_first_level
::
(
HasTreeError
err
,
HasNodeError
err
)
tree_first_level
::
(
HasTreeError
err
,
HasNodeError
err
)
=>
RootId
=>
RootId
->
[
NodeType
]
->
[
NodeType
]
->
Cmd
err
(
Tree
NodeTree
)
->
DB
Cmd
err
(
Tree
NodeTree
)
tree_first_level
r
nodeTypes
=
do
tree_first_level
r
nodeTypes
=
do
-- let rPrefix s = mconcat [ "[tree_first_level] root = "
-- let rPrefix s = mconcat [ "[tree_first_level] root = "
-- , show r
-- , show r
...
@@ -151,7 +151,7 @@ tree_flat :: (HasTreeError err, HasNodeError err)
...
@@ -151,7 +151,7 @@ tree_flat :: (HasTreeError err, HasNodeError err)
=>
RootId
=>
RootId
->
[
NodeType
]
->
[
NodeType
]
->
Maybe
Text
->
Maybe
Text
->
Cmd
err
[
NodeTree
]
->
DB
Cmd
err
[
NodeTree
]
tree_flat
r
nodeTypes
q
=
do
tree_flat
r
nodeTypes
q
=
do
mainRoot
<-
findNodes
r
Private
nodeTypes
mainRoot
<-
findNodes
r
Private
nodeTypes
publicRoots
<-
findNodes
r
Public
nodeTypes
publicRoots
<-
findNodes
r
Public
nodeTypes
...
@@ -169,7 +169,7 @@ findNodes :: (HasTreeError err, HasNodeError err)
...
@@ -169,7 +169,7 @@ findNodes :: (HasTreeError err, HasNodeError err)
=>
RootId
=>
RootId
->
NodeMode
->
NodeMode
->
[
NodeType
]
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
->
DB
Cmd
err
[
DbTreeNode
]
findNodes
r
Private
nt
=
dbTree
r
nt
findNodes
r
Private
nt
=
dbTree
r
nt
findNodes
r
Shared
nt
=
findShared
r
NodeFolderShared
nt
sharedTreeUpdate
findNodes
r
Shared
nt
=
findShared
r
NodeFolderShared
nt
sharedTreeUpdate
findNodes
r
SharedDirect
nt
=
findSharedDirect
r
NodeFolderShared
nt
sharedTreeUpdate
findNodes
r
SharedDirect
nt
=
findSharedDirect
r
NodeFolderShared
nt
sharedTreeUpdate
...
@@ -181,7 +181,7 @@ findNodes r PublicDirect nt = findSharedDirect r NodeFolderPublic nt publicTree
...
@@ -181,7 +181,7 @@ findNodes r PublicDirect nt = findSharedDirect r NodeFolderPublic nt publicTree
-- Queries the `nodes_nodes` table.
-- Queries the `nodes_nodes` table.
findShared
::
HasTreeError
err
findShared
::
HasTreeError
err
=>
RootId
->
NodeType
->
[
NodeType
]
->
UpdateTree
err
=>
RootId
->
NodeType
->
[
NodeType
]
->
UpdateTree
err
->
Cmd
err
[
DbTreeNode
]
->
DB
Cmd
err
[
DbTreeNode
]
findShared
r
nt
nts
fun
=
do
findShared
r
nt
nts
fun
=
do
foldersSharedId
<-
findNodesId
r
[
nt
]
foldersSharedId
<-
findNodesId
r
[
nt
]
trees
<-
mapM
(
updateTree
nts
fun
)
foldersSharedId
trees
<-
mapM
(
updateTree
nts
fun
)
foldersSharedId
...
@@ -192,7 +192,7 @@ findShared r nt nts fun = do
...
@@ -192,7 +192,7 @@ findShared r nt nts fun = do
-- and get the tree for its parent.
-- and get the tree for its parent.
findSharedDirect
::
(
HasTreeError
err
,
HasNodeError
err
)
findSharedDirect
::
(
HasTreeError
err
,
HasNodeError
err
)
=>
RootId
->
NodeType
->
[
NodeType
]
->
UpdateTree
err
=>
RootId
->
NodeType
->
[
NodeType
]
->
UpdateTree
err
->
Cmd
err
[
DbTreeNode
]
->
DB
Cmd
err
[
DbTreeNode
]
findSharedDirect
r
nt
nts
fun
=
do
findSharedDirect
r
nt
nts
fun
=
do
-- let rPrefix s = mconcat [ "[findSharedDirect] r = "
-- let rPrefix s = mconcat [ "[findSharedDirect] r = "
-- , show r
-- , show r
...
@@ -214,11 +214,11 @@ findSharedDirect r nt nts fun = do
...
@@ -214,11 +214,11 @@ findSharedDirect r nt nts fun = do
pure
$
concat
trees
pure
$
concat
trees
type
UpdateTree
err
=
ParentId
->
[
NodeType
]
->
NodeId
->
Cmd
err
[
DbTreeNode
]
type
UpdateTree
err
=
ParentId
->
[
NodeType
]
->
NodeId
->
DB
Cmd
err
[
DbTreeNode
]
updateTree
::
HasTreeError
err
updateTree
::
HasTreeError
err
=>
[
NodeType
]
->
UpdateTree
err
->
RootId
=>
[
NodeType
]
->
UpdateTree
err
->
RootId
->
Cmd
err
[
DbTreeNode
]
->
DB
Cmd
err
[
DbTreeNode
]
updateTree
nts
fun
r
=
do
updateTree
nts
fun
r
=
do
folders
<-
getNodeNode
r
folders
<-
getNodeNode
r
nodesSharedId
<-
mapM
(
fun
r
nts
)
nodesSharedId
<-
mapM
(
fun
r
nts
)
...
@@ -245,12 +245,12 @@ publicTreeUpdate p nt n = dbTree n nt
...
@@ -245,12 +245,12 @@ publicTreeUpdate p nt n = dbTree n nt
-- | findNodesId returns all nodes matching nodeType but the root (Nodeuser)
-- | findNodesId returns all nodes matching nodeType but the root (Nodeuser)
findNodesId
::
RootId
->
[
NodeType
]
->
Cmd
err
[
NodeId
]
findNodesId
::
RootId
->
[
NodeType
]
->
DB
Cmd
err
[
NodeId
]
findNodesId
r
nt
=
tail
findNodesId
r
nt
=
tail
<$>
map
_dt_nodeId
<$>
map
_dt_nodeId
<$>
dbTree
r
nt
<$>
dbTree
r
nt
findNodesWithType
::
RootId
->
[
NodeType
]
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
findNodesWithType
::
RootId
->
[
NodeType
]
->
[
NodeType
]
->
DB
Cmd
err
[
DbTreeNode
]
findNodesWithType
root
target
through
=
findNodesWithType
root
target
through
=
filter
isInTarget
<$>
dbTree
root
through
filter
isInTarget
<$>
dbTree
root
through
where
where
...
@@ -331,7 +331,7 @@ toSubtreeParent r ns = fromListWith (\a b -> nub $ a <> b) . map (\n -> (_dt_par
...
@@ -331,7 +331,7 @@ toSubtreeParent r ns = fromListWith (\a b -> nub $ a <> b) . map (\n -> (_dt_par
-- | Main DB Tree function
-- | Main DB Tree function
dbTree
::
RootId
dbTree
::
RootId
->
[
NodeType
]
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
->
DB
Cmd
err
[
DbTreeNode
]
dbTree
rootId
nodeTypes
=
map
(
\
(
nId
,
tId
,
pId
,
n
)
->
DbTreeNode
nId
tId
pId
n
)
dbTree
rootId
nodeTypes
=
map
(
\
(
nId
,
tId
,
pId
,
n
)
->
DbTreeNode
nId
tId
pId
n
)
<$>
runPGSQuery
[
sql
|
<$>
runPGSQuery
[
sql
|
WITH RECURSIVE
WITH RECURSIVE
...
@@ -383,7 +383,7 @@ isDescendantOf childId rootId = (== [Only True])
...
@@ -383,7 +383,7 @@ isDescendantOf childId rootId = (== [Only True])
|]
(
childId
,
rootId
)
|]
(
childId
,
rootId
)
-- TODO should we check the category?
-- TODO should we check the category?
isIn
::
NodeId
->
DocId
->
Cmd
err
Bool
isIn
::
NodeId
->
DocId
->
DB
Cmd
err
Bool
isIn
cId
docId
=
(
==
[
Only
True
])
isIn
cId
docId
=
(
==
[
Only
True
])
<$>
runPGSQuery
[
sql
|
SELECT COUNT(*) = 1
<$>
runPGSQuery
[
sql
|
SELECT COUNT(*) = 1
FROM nodes_nodes nn
FROM nodes_nodes nn
...
@@ -394,7 +394,7 @@ isIn cId docId = ( == [Only True])
...
@@ -394,7 +394,7 @@ isIn cId docId = ( == [Only True])
-- Recursive parents function to construct a breadcrumb
-- Recursive parents function to construct a breadcrumb
recursiveParents
::
NodeId
recursiveParents
::
NodeId
->
[
NodeType
]
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
->
DB
Cmd
err
[
DbTreeNode
]
recursiveParents
nodeId
nodeTypes
=
map
(
\
(
nId
,
tId
,
pId
,
n
)
->
DbTreeNode
nId
tId
pId
n
)
recursiveParents
nodeId
nodeTypes
=
map
(
\
(
nId
,
tId
,
pId
,
n
)
->
DbTreeNode
nId
tId
pId
n
)
<$>
runPGSQuery
[
sql
|
<$>
runPGSQuery
[
sql
|
WITH RECURSIVE recursiveParents AS
WITH RECURSIVE recursiveParents AS
...
...
test/Test/Database/Types.hs
View file @
4ef66cea
...
@@ -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