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
191
Issues
191
List
Board
Labels
Milestones
Merge Requests
8
Merge Requests
8
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
b0568522
Commit
b0568522
authored
May 12, 2025
by
Alfredo Di Napoli
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Make CLI compile again
parent
d4116e48
Pipeline
#7575
failed with stages
in 44 minutes and 14 seconds
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
17 additions
and
13 deletions
+17
-13
Init.hs
bin/gargantext-cli/CLI/Init.hs
+16
-13
gargantext.cabal
gargantext.cabal
+1
-0
No files found.
bin/gargantext-cli/CLI/Init.hs
View file @
b0568522
...
@@ -29,12 +29,13 @@ import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMkRootWithCorpus)
...
@@ -29,12 +29,13 @@ 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
,
DBCmdWithEnv
)
import
Gargantext.Database.Prelude
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
))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Options.Applicative
import
Options.Applicative
import
Gargantext.Core.Types.Individu
(
toUserHash
)
initCLI
::
InitArgs
->
IO
()
initCLI
::
InitArgs
->
IO
()
...
@@ -45,34 +46,36 @@ initCLI (InitArgs settingsPath) = do
...
@@ -45,34 +46,36 @@ initCLI (InitArgs settingsPath) = do
putStrLn
(
"Enter master user (gargantua) _email_ :"
::
Text
)
putStrLn
(
"Enter master user (gargantua) _email_ :"
::
Text
)
email
<-
getLine
email
<-
getLine
hashedUsers
<-
NE
.
fromList
<$>
mapM
toUserHash
(
NewUser
"gargantua"
(
cs
email
)
(
GargPassword
$
cs
password
)
:
arbitraryNewUsers
)
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
.
DBCmdWithEnv
env
BackendInternalError
Int64
let
createUsers
::
DBUpdate
BackendInternalError
Int64
createUsers
=
insertNewUsers
(
NewUser
"gargantua"
(
cs
email
)
(
GargPassword
$
cs
password
)
createUsers
=
insertNewUsers
hashedUsers
NE
.:|
arbitraryNewUsers
)
let
let
mkRoots
::
forall
env
.
DBCmdWithEnv
env
BackendInternalError
[(
UserId
,
RootId
)]
mkRoots
::
DBUpdate
BackendInternalError
[(
UserId
,
RootId
)]
mkRoots
=
mapM
getOrMkRoot
$
map
UserName
(
"gargantua"
:
arbitraryUsername
)
mkRoots
=
mapM
(
getOrMkRoot
cfg
)
$
map
UserName
(
"gargantua"
:
arbitraryUsername
)
-- TODO create all users roots
-- TODO create all users roots
let
let
initMaster
::
forall
env
.
DBCmdWithEnv
env
BackendInternalError
(
UserId
,
RootId
,
CorpusId
,
ListId
)
initMaster
::
DBUpdate
BackendInternalError
(
UserId
,
RootId
,
CorpusId
,
ListId
)
initMaster
=
do
initMaster
=
do
(
masterUserId
,
masterRootId
,
masterCorpusId
)
(
masterUserId
,
masterRootId
,
masterCorpusId
)
<-
getOrMkRootWithCorpus
MkCorpusUserMaster
<-
getOrMkRootWithCorpus
cfg
MkCorpusUserMaster
(
Nothing
::
Maybe
HyperdataCorpus
)
(
Nothing
::
Maybe
HyperdataCorpus
)
masterListId
<-
getOrMkList
masterCorpusId
masterUserId
masterListId
<-
getOrMkList
masterCorpusId
masterUserId
_triggers
<-
initLastTriggers
masterListId
_triggers
<-
initLastTriggers
masterListId
pure
(
masterUserId
,
masterRootId
,
masterCorpusId
,
masterListId
)
pure
(
masterUserId
,
masterRootId
,
masterCorpusId
,
masterListId
)
withDevEnv
settingsPath
$
\
env
->
do
withDevEnv
settingsPath
$
\
env
->
do
_
<-
runCmdDev
env
(
initFirstTriggers
secret
::
DBCmd
BackendInternalError
[
Int64
])
x
<-
runCmdDev
env
$
runDBTx
$
do
_
<-
runCmdDev
env
createUsers
_
<-
initFirstTriggers
secret
x
<-
runCmdDev
env
initMaster
_
<-
createUsers
_
<-
runCmdDev
env
mkRoots
x'
<-
initMaster
_
<-
mkRoots
pure
x'
putStrLn
(
show
x
::
Text
)
putStrLn
(
show
x
::
Text
)
initCmd
::
HasCallStack
=>
Mod
CommandFields
CLI
initCmd
::
HasCallStack
=>
Mod
CommandFields
CLI
...
...
gargantext.cabal
View file @
b0568522
...
@@ -707,6 +707,7 @@ executable gargantext
...
@@ -707,6 +707,7 @@ executable gargantext
, gargantext
, gargantext
, gargantext-prelude
, gargantext-prelude
, haskell-bee
, haskell-bee
, lens >= 5.2.2 && < 5.3
, MonadRandom ^>= 0.6
, MonadRandom ^>= 0.6
, optparse-applicative
, optparse-applicative
, postgresql-simple >= 0.6.4 && <= 0.7.0.0
, postgresql-simple >= 0.6.4 && <= 0.7.0.0
...
...
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