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
160
Issues
160
List
Board
Labels
Milestones
Merge Requests
14
Merge Requests
14
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
ac9731c7
Commit
ac9731c7
authored
Dec 02, 2024
by
Grégoire Locqueville
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Renamed `DBCmd'` -> `DBCmdWithEnv`
parent
e17737f3
Changes
9
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
31 additions
and
32 deletions
+31
-32
Init.hs
bin/gargantext-cli/CLI/Init.hs
+4
-5
New.hs
src/Gargantext/API/Node/New.hs
+2
-2
Corpus.hs
src/Gargantext/Core/Text/Corpus.hs
+2
-2
API.hs
src/Gargantext/Core/Viz/Graph/API.hs
+2
-2
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+3
-3
Node.hs
src/Gargantext/Database/Action/Node.hs
+4
-4
New.hs
src/Gargantext/Database/Action/User/New.hs
+4
-4
Prelude.hs
src/Gargantext/Database/Prelude.hs
+6
-6
Root.hs
src/Gargantext/Database/Query/Tree/Root.hs
+4
-4
No files found.
bin/gargantext-cli/CLI/Init.hs
View file @
ac9731c7
...
@@ -29,8 +29,7 @@ import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMkRootWithCorpus)
...
@@ -29,8 +29,7 @@ import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMkRootWithCorpus)
import
Gargantext.Database.Admin.Trigger.Init
(
initFirstTriggers
,
initLastTriggers
)
import
Gargantext.Database.Admin.Trigger.Init
(
initFirstTriggers
,
initLastTriggers
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataCorpus
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataCorpus
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
DBCmd
'
)
import
Gargantext.Database.Prelude
(
DBCmd
,
DBCmdWithEnv
)
import
Gargantext.Database.Prelude
(
DBCmd
)
import
Gargantext.Database.Query.Table.Node
(
getOrMkList
)
import
Gargantext.Database.Query.Table.Node
(
getOrMkList
)
import
Gargantext.Database.Query.Table.User
(
insertNewUsers
,
)
import
Gargantext.Database.Query.Table.User
(
insertNewUsers
,
)
import
Gargantext.Database.Query.Tree.Root
(
MkCorpusUser
(
MkCorpusUserMaster
))
import
Gargantext.Database.Query.Tree.Root
(
MkCorpusUser
(
MkCorpusUserMaster
))
...
@@ -49,18 +48,18 @@ initCLI (InitArgs settingsPath) = do
...
@@ -49,18 +48,18 @@ initCLI (InitArgs settingsPath) = do
cfg
<-
readConfig
settingsPath
cfg
<-
readConfig
settingsPath
let
secret
=
_s_secret_key
$
_gc_secrets
cfg
let
secret
=
_s_secret_key
$
_gc_secrets
cfg
let
createUsers
::
forall
env
.
DBCmd
'
env
BackendInternalError
Int64
let
createUsers
::
forall
env
.
DBCmd
WithEnv
env
BackendInternalError
Int64
createUsers
=
insertNewUsers
(
NewUser
"gargantua"
(
cs
email
)
(
GargPassword
$
cs
password
)
createUsers
=
insertNewUsers
(
NewUser
"gargantua"
(
cs
email
)
(
GargPassword
$
cs
password
)
NE
.:|
arbitraryNewUsers
NE
.:|
arbitraryNewUsers
)
)
let
let
mkRoots
::
forall
env
.
DBCmd
'
env
BackendInternalError
[(
UserId
,
RootId
)]
mkRoots
::
forall
env
.
DBCmd
WithEnv
env
BackendInternalError
[(
UserId
,
RootId
)]
mkRoots
=
mapM
getOrMkRoot
$
map
UserName
(
"gargantua"
:
arbitraryUsername
)
mkRoots
=
mapM
getOrMkRoot
$
map
UserName
(
"gargantua"
:
arbitraryUsername
)
-- TODO create all users roots
-- TODO create all users roots
let
let
initMaster
::
forall
env
.
DBCmd
'
env
BackendInternalError
(
UserId
,
RootId
,
CorpusId
,
ListId
)
initMaster
::
forall
env
.
DBCmd
WithEnv
env
BackendInternalError
(
UserId
,
RootId
,
CorpusId
,
ListId
)
initMaster
=
do
initMaster
=
do
(
masterUserId
,
masterRootId
,
masterCorpusId
)
(
masterUserId
,
masterRootId
,
masterCorpusId
)
<-
getOrMkRootWithCorpus
MkCorpusUserMaster
<-
getOrMkRootWithCorpus
MkCorpusUserMaster
...
...
src/Gargantext/API/Node/New.hs
View file @
ac9731c7
...
@@ -31,7 +31,7 @@ import Gargantext.Core.NLP (HasNLPServer)
...
@@ -31,7 +31,7 @@ import Gargantext.Core.NLP (HasNLPServer)
import
Gargantext.Core.Worker.Jobs.Types
qualified
as
Jobs
import
Gargantext.Core.Worker.Jobs.Types
qualified
as
Jobs
import
Gargantext.Database.Action.Node
(
mkNodeWithParent
)
import
Gargantext.Database.Action.Node
(
mkNodeWithParent
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
IsDBCmdExtra
,
DBCmd
'
)
import
Gargantext.Database.Prelude
(
IsDBCmdExtra
,
DBCmd
WithEnv
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Servant.Server.Generic
(
AsServerT
)
import
Servant.Server.Generic
(
AsServerT
)
...
@@ -47,7 +47,7 @@ postNode :: ( HasMail env
...
@@ -47,7 +47,7 @@ postNode :: ( HasMail env
->
NodeId
->
NodeId
->
PostNode
->
PostNode
-- -> m [NodeId]
-- -> m [NodeId]
->
DBCmd
'
env
err
[
NodeId
]
->
DBCmd
WithEnv
env
err
[
NodeId
]
postNode
authenticatedUser
nId
pn
=
do
postNode
authenticatedUser
nId
pn
=
do
postNode'
authenticatedUser
nId
pn
postNode'
authenticatedUser
nId
pn
...
...
src/Gargantext/Core/Text/Corpus.hs
View file @
ac9731c7
...
@@ -19,7 +19,7 @@ import Gargantext.Database.Action.Search (searchInCorpus)
...
@@ -19,7 +19,7 @@ import Gargantext.Database.Action.Search (searchInCorpus)
import
Gargantext.Database.Action.User
(
getUserId
)
import
Gargantext.Database.Action.User
(
getUserId
)
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataCorpus
,
hc_lang
)
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataCorpus
,
hc_lang
)
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
NodeId
(
UnsafeMkNodeId
),
NodeType
(
..
),
nodeId2ContextId
)
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
NodeId
(
UnsafeMkNodeId
),
NodeType
(
..
),
nodeId2ContextId
)
import
Gargantext.Database.Prelude
(
DBCmd
'
)
import
Gargantext.Database.Prelude
(
DBCmd
WithEnv
)
import
Gargantext.Database.Query.Facet.Types
(
facetDoc_id
)
import
Gargantext.Database.Query.Facet.Types
(
facetDoc_id
)
import
Gargantext.Database.Query.Table.Node
(
insertDefaultNode
,
copyNodeStories
,
defaultList
,
getNodeWithType
)
import
Gargantext.Database.Query.Table.Node
(
insertDefaultNode
,
copyNodeStories
,
defaultList
,
getNodeWithType
)
import
Gargantext.Database.Query.Table.Node.Document.Add
qualified
as
Document
(
add
)
import
Gargantext.Database.Query.Table.Node.Document.Add
qualified
as
Document
(
add
)
...
@@ -55,7 +55,7 @@ makeSubcorpusFromQuery :: ( HasNodeStoryEnv env
...
@@ -55,7 +55,7 @@ makeSubcorpusFromQuery :: ( HasNodeStoryEnv env
->
CorpusId
-- ^ ID of the parent corpus
->
CorpusId
-- ^ ID of the parent corpus
->
Q
.
Query
-- ^ The query to determine the subset of documents that will appear in the subcorpus
->
Q
.
Query
-- ^ The query to determine the subset of documents that will appear in the subcorpus
->
Bool
-- ^ Whether to reuse parent term list (True) or compute a new one based only on the documents in the subcorpus (False)
->
Bool
-- ^ Whether to reuse parent term list (True) or compute a new one based only on the documents in the subcorpus (False)
->
DBCmd
'
env
BackendInternalError
CorpusId
-- ^ The child corpus ID
->
DBCmd
WithEnv
env
BackendInternalError
CorpusId
-- ^ The child corpus ID
makeSubcorpusFromQuery
user
supercorpusId
query
reuseParentList
=
do
makeSubcorpusFromQuery
user
supercorpusId
query
reuseParentList
=
do
userId
<-
getUserId
user
userId
<-
getUserId
user
-- Insert the required nodes:
-- Insert the required nodes:
...
...
src/Gargantext/Core/Viz/Graph/API.hs
View file @
ac9731c7
...
@@ -37,7 +37,7 @@ import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOn
...
@@ -37,7 +37,7 @@ import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOn
import
Gargantext.Database.Action.Node
(
mkNodeWithParent
)
import
Gargantext.Database.Action.Node
(
mkNodeWithParent
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
DBCmd
,
DBCmd
'
)
import
Gargantext.Database.Prelude
(
DBCmd
,
DBCmd
WithEnv
)
import
Gargantext.Database.Query.Table.Node
(
getOrMkList
,
getNodeWith
,
defaultList
,
getClosestParentIdByType
)
import
Gargantext.Database.Query.Table.Node
(
getOrMkList
,
getNodeWith
,
defaultList
,
getClosestParentIdByType
)
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
)
...
@@ -281,7 +281,7 @@ graphClone :: (HasNodeError err)
...
@@ -281,7 +281,7 @@ graphClone :: (HasNodeError err)
=>
UserId
=>
UserId
->
NodeId
->
NodeId
->
HyperdataGraphAPI
->
HyperdataGraphAPI
->
DBCmd
'
env
err
NodeId
->
DBCmd
WithEnv
env
err
NodeId
graphClone
userId
pId
(
HyperdataGraphAPI
{
_hyperdataAPIGraph
=
graph
graphClone
userId
pId
(
HyperdataGraphAPI
{
_hyperdataAPIGraph
=
graph
,
_hyperdataAPICamera
=
camera
})
=
do
,
_hyperdataAPICamera
=
camera
})
=
do
let
nodeType
=
NodeGraph
let
nodeType
=
NodeGraph
...
...
src/Gargantext/Database/Action/Flow.hs
View file @
ac9731c7
...
@@ -94,7 +94,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact )
...
@@ -94,7 +94,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact )
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataAnnuaire
,
HyperdataCorpus
(
_hc_lang
)
)
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataAnnuaire
,
HyperdataCorpus
(
_hc_lang
)
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
ToHyperdataDocument
(
toHyperdataDocument
)
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
ToHyperdataDocument
(
toHyperdataDocument
)
)
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
(
IsDBCmd
,
DBCmd
'
)
import
Gargantext.Database.Prelude
(
IsDBCmd
,
DBCmd
WithEnv
)
import
Gargantext.Database.Query.Table.ContextNodeNgrams2
(
ContextNodeNgrams2Poly
(
..
),
insertContextNodeNgrams2
)
import
Gargantext.Database.Query.Table.ContextNodeNgrams2
(
ContextNodeNgrams2Poly
(
..
),
insertContextNodeNgrams2
)
import
Gargantext.Database.Query.Table.Node
(
MkCorpus
,
insertDefaultNodeIfNotExists
,
getOrMkList
,
getNodeWith
)
import
Gargantext.Database.Query.Table.Node
(
MkCorpus
,
insertDefaultNodeIfNotExists
,
getOrMkList
,
getNodeWith
)
import
Gargantext.Database.Query.Table.Node.Document.Add
qualified
as
Doc
(
add
)
import
Gargantext.Database.Query.Table.Node.Document.Add
qualified
as
Doc
(
add
)
...
@@ -136,7 +136,7 @@ getDataText :: (HasNodeError err)
...
@@ -136,7 +136,7 @@ getDataText :: (HasNodeError err)
->
Maybe
PUBMED
.
APIKey
->
Maybe
PUBMED
.
APIKey
->
Maybe
EPO
.
AuthKey
->
Maybe
EPO
.
AuthKey
->
Maybe
API
.
Limit
->
Maybe
API
.
Limit
->
DBCmd
'
env
err
(
Either
API
.
GetCorpusError
DataText
)
->
DBCmd
WithEnv
env
err
(
Either
API
.
GetCorpusError
DataText
)
getDataText
(
ExternalOrigin
api
)
la
q
mPubmedAPIKey
mAuthKey
li
=
do
getDataText
(
ExternalOrigin
api
)
la
q
mPubmedAPIKey
mAuthKey
li
=
do
cfg
<-
view
hasConfig
cfg
<-
view
hasConfig
eRes
<-
liftBase
$
API
.
get
api
(
_tt_lang
la
)
q
mPubmedAPIKey
mAuthKey
(
_ac_epo_api_url
$
_gc_apis
cfg
)
li
eRes
<-
liftBase
$
API
.
get
api
(
_tt_lang
la
)
q
mPubmedAPIKey
mAuthKey
(
_ac_epo_api_url
$
_gc_apis
cfg
)
li
...
@@ -151,7 +151,7 @@ getDataText_Debug :: (HasNodeError err)
...
@@ -151,7 +151,7 @@ getDataText_Debug :: (HasNodeError err)
->
TermType
Lang
->
TermType
Lang
->
API
.
RawQuery
->
API
.
RawQuery
->
Maybe
API
.
Limit
->
Maybe
API
.
Limit
->
DBCmd
'
env
err
()
->
DBCmd
WithEnv
env
err
()
getDataText_Debug
a
l
q
li
=
do
getDataText_Debug
a
l
q
li
=
do
result
<-
getDataText
a
l
q
Nothing
Nothing
li
result
<-
getDataText
a
l
q
Nothing
Nothing
li
case
result
of
case
result
of
...
...
src/Gargantext/Database/Action/Node.hs
View file @
ac9731c7
...
@@ -26,7 +26,7 @@ import Gargantext.Core.Types (Name)
...
@@ -26,7 +26,7 @@ import Gargantext.Core.Types (Name)
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.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
DBCmd
'
)
import
Gargantext.Database.Prelude
(
DBCmd
WithEnv
)
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
)
...
@@ -41,7 +41,7 @@ mkNodeWithParent :: (HasNodeError err, HasDBid NodeType)
...
@@ -41,7 +41,7 @@ mkNodeWithParent :: (HasNodeError err, HasDBid NodeType)
->
Maybe
ParentId
->
Maybe
ParentId
->
UserId
->
UserId
->
Name
->
Name
->
DBCmd
'
env
err
[
NodeId
]
->
DBCmd
WithEnv
env
err
[
NodeId
]
mkNodeWithParent
NodeUser
(
Just
pId
)
uid
_
=
nodeError
$
NodeCreationFailed
$
UserParentAlreadyExists
uid
pId
mkNodeWithParent
NodeUser
(
Just
pId
)
uid
_
=
nodeError
$
NodeCreationFailed
$
UserParentAlreadyExists
uid
pId
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -75,7 +75,7 @@ mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err, HasDBid NodeType)
...
@@ -75,7 +75,7 @@ mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err, HasDBid NodeType)
->
Maybe
ParentId
->
Maybe
ParentId
->
UserId
->
UserId
->
Name
->
Name
->
DBCmd
'
env
err
[
NodeId
]
->
DBCmd
WithEnv
env
err
[
NodeId
]
mkNodeWithParent_ConfigureHyperdata
Notes
(
Just
i
)
uId
name
=
mkNodeWithParent_ConfigureHyperdata
Notes
(
Just
i
)
uId
name
=
mkNodeWithParent_ConfigureHyperdata'
Notes
(
Just
i
)
uId
name
mkNodeWithParent_ConfigureHyperdata'
Notes
(
Just
i
)
uId
name
...
@@ -107,7 +107,7 @@ mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType)
...
@@ -107,7 +107,7 @@ mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType)
->
Maybe
ParentId
->
Maybe
ParentId
->
UserId
->
UserId
->
Name
->
Name
->
DBCmd
'
env
err
[
NodeId
]
->
DBCmd
WithEnv
env
err
[
NodeId
]
mkNodeWithParent_ConfigureHyperdata'
nt
(
Just
i
)
uId
name
=
do
mkNodeWithParent_ConfigureHyperdata'
nt
(
Just
i
)
uId
name
=
do
nodeId
<-
case
nt
of
nodeId
<-
case
nt
of
Notes
->
insertNode
Notes
(
Just
name
)
Nothing
i
uId
Notes
->
insertNode
Notes
(
Just
name
)
Nothing
i
uId
...
...
src/Gargantext/Database/Action/User/New.hs
View file @
ac9731c7
...
@@ -34,7 +34,7 @@ import Gargantext.Core.Mail.Types (HasMail, mailSettings)
...
@@ -34,7 +34,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
(
Cmd
,
DBCmd
,
IsDBCmdExtra
,
DBCmd
'
)
import
Gargantext.Database.Prelude
(
Cmd
,
DBCmd
,
IsDBCmdExtra
,
DBCmd
WithEnv
)
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
...
@@ -62,7 +62,7 @@ newUser emailAddress = do
...
@@ -62,7 +62,7 @@ newUser emailAddress = do
-- use 'newUser' instead for standard Gargantext code.
-- use 'newUser' instead for standard Gargantext code.
new_user
::
(
HasNodeError
err
)
new_user
::
(
HasNodeError
err
)
=>
NewUser
GargPassword
=>
NewUser
GargPassword
->
DBCmd
'
env
err
UserId
->
DBCmd
WithEnv
env
err
UserId
new_user
rq
=
do
new_user
rq
=
do
(
uid
NE
.:|
_
)
<-
new_users
(
rq
NE
.:|
[]
)
(
uid
NE
.:|
_
)
<-
new_users
(
rq
NE
.:|
[]
)
pure
uid
pure
uid
...
@@ -75,7 +75,7 @@ new_user rq = do
...
@@ -75,7 +75,7 @@ new_user rq = do
new_users
::
(
HasNodeError
err
)
new_users
::
(
HasNodeError
err
)
=>
NonEmpty
(
NewUser
GargPassword
)
=>
NonEmpty
(
NewUser
GargPassword
)
-- ^ A list of users to create.
-- ^ A list of users to create.
->
DBCmd
'
env
err
(
NonEmpty
UserId
)
->
DBCmd
WithEnv
env
err
(
NonEmpty
UserId
)
new_users
us
=
do
new_users
us
=
do
us'
<-
liftBase
$
mapM
toUserHash
us
us'
<-
liftBase
$
mapM
toUserHash
us
void
$
insertUsers
$
NE
.
map
toUserWrite
us'
void
$
insertUsers
$
NE
.
map
toUserWrite
us'
...
@@ -109,7 +109,7 @@ guessUserName n = case splitOn "@" n of
...
@@ -109,7 +109,7 @@ guessUserName n = case splitOn "@" n of
------------------------------------------------------------------------
------------------------------------------------------------------------
newUsers'
::
(
HasNodeError
err
)
newUsers'
::
(
HasNodeError
err
)
=>
MailConfig
->
NonEmpty
(
NewUser
GargPassword
)
->
DBCmd
'
env
err
(
NonEmpty
UserId
)
=>
MailConfig
->
NonEmpty
(
NewUser
GargPassword
)
->
DBCmd
WithEnv
env
err
(
NonEmpty
UserId
)
newUsers'
cfg
us
=
do
newUsers'
cfg
us
=
do
us'
<-
liftBase
$
mapM
toUserHash
us
us'
<-
liftBase
$
mapM
toUserHash
us
void
$
insertUsers
$
NE
.
map
toUserWrite
us'
void
$
insertUsers
$
NE
.
map
toUserWrite
us'
...
...
src/Gargantext/Database/Prelude.hs
View file @
ac9731c7
...
@@ -93,12 +93,12 @@ type CmdRandom env err m =
...
@@ -93,12 +93,12 @@ type CmdRandom env err m =
,
HasMail
env
,
HasMail
env
)
)
type
Cmd''
env
err
a
=
forall
m
.
CmdM''
env
err
m
=>
m
a
type
Cmd''
env
err
a
=
forall
m
.
CmdM''
env
err
m
=>
m
a
type
Cmd'
env
err
a
=
forall
m
.
IsCmd
env
err
m
=>
m
a
type
Cmd'
env
err
a
=
forall
m
.
IsCmd
env
err
m
=>
m
a
type
Cmd
err
a
=
forall
m
env
.
IsDBCmdExtra
env
err
m
=>
m
a
type
Cmd
err
a
=
forall
m
env
.
IsDBCmdExtra
env
err
m
=>
m
a
type
CmdR
err
a
=
forall
m
env
.
CmdRandom
env
err
m
=>
m
a
type
CmdR
err
a
=
forall
m
env
.
CmdRandom
env
err
m
=>
m
a
type
DBCmd
'
env
err
a
=
forall
m
.
IsDBCmd
env
err
m
=>
m
a
type
DBCmd
WithEnv
env
err
a
=
forall
m
.
IsDBCmd
env
err
m
=>
m
a
type
DBCmd
err
a
=
forall
m
env
.
IsDBCmd
env
err
m
=>
m
a
type
DBCmd
err
a
=
forall
m
env
.
IsDBCmd
env
err
m
=>
m
a
-- | Only the /minimum/ amount of class constraints required
-- | Only the /minimum/ amount of class constraints required
-- to use the Gargantext Database. It's important, to ease testability,
-- to use the Gargantext Database. It's important, to ease testability,
...
...
src/Gargantext/Database/Query/Tree/Root.hs
View file @
ac9731c7
...
@@ -22,7 +22,7 @@ import Gargantext.Database.Action.User (getUserId, getUsername)
...
@@ -22,7 +22,7 @@ import Gargantext.Database.Action.User (getUserId, getUsername)
import
Gargantext.Database.Admin.Config
(
corpusMasterName
,
userMaster
)
import
Gargantext.Database.Admin.Config
(
corpusMasterName
,
userMaster
)
import
Gargantext.Database.Admin.Types.Hyperdata.User
(
HyperdataUser
)
import
Gargantext.Database.Admin.Types.Hyperdata.User
(
HyperdataUser
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
runOpaQuery
,
DBCmd
,
DBCmd
'
)
import
Gargantext.Database.Prelude
(
runOpaQuery
,
DBCmd
,
DBCmd
WithEnv
)
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.User
(
queryUserTable
,
UserPoly
(
..
))
import
Gargantext.Database.Query.Table.User
(
queryUserTable
,
UserPoly
(
..
))
...
@@ -44,7 +44,7 @@ getRoot = runOpaQuery . selectRoot
...
@@ -44,7 +44,7 @@ getRoot = runOpaQuery . selectRoot
getOrMkRoot
::
(
HasNodeError
err
)
getOrMkRoot
::
(
HasNodeError
err
)
=>
User
=>
User
->
DBCmd
'
env
err
(
UserId
,
RootId
)
->
DBCmd
WithEnv
env
err
(
UserId
,
RootId
)
getOrMkRoot
user
=
do
getOrMkRoot
user
=
do
userId
<-
getUserId
user
userId
<-
getUserId
user
...
@@ -80,7 +80,7 @@ userFromMkCorpusUser (MkCorpusUserNormalCorpusName u _cname) = u
...
@@ -80,7 +80,7 @@ userFromMkCorpusUser (MkCorpusUserNormalCorpusName u _cname) = u
getOrMkRootWithCorpus
::
(
HasNodeError
err
,
MkCorpus
a
)
getOrMkRootWithCorpus
::
(
HasNodeError
err
,
MkCorpus
a
)
=>
MkCorpusUser
=>
MkCorpusUser
->
Maybe
a
->
Maybe
a
->
DBCmd
'
env
err
(
UserId
,
RootId
,
CorpusId
)
->
DBCmd
WithEnv
env
err
(
UserId
,
RootId
,
CorpusId
)
getOrMkRootWithCorpus
MkCorpusUserMaster
c
=
do
getOrMkRootWithCorpus
MkCorpusUserMaster
c
=
do
(
userId
,
rootId
)
<-
getOrMkRoot
(
UserName
userMaster
)
(
userId
,
rootId
)
<-
getOrMkRoot
(
UserName
userMaster
)
corpusId''
<-
do
corpusId''
<-
do
...
@@ -121,7 +121,7 @@ mkCorpus cName c rootId userId = do
...
@@ -121,7 +121,7 @@ mkCorpus cName c rootId userId = do
mkRoot
::
(
HasNodeError
err
)
mkRoot
::
(
HasNodeError
err
)
=>
User
=>
User
->
DBCmd
'
env
err
[
RootId
]
->
DBCmd
WithEnv
env
err
[
RootId
]
mkRoot
user
=
do
mkRoot
user
=
do
-- TODO
-- TODO
...
...
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