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
195
Issues
195
List
Board
Labels
Milestones
Merge Requests
12
Merge Requests
12
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