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
107
Issues
107
List
Board
Labels
Milestones
Merge Requests
6
Merge Requests
6
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
9a2f05e0
Commit
9a2f05e0
authored
Dec 04, 2023
by
Alfredo Di Napoli
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Move panicTrace to gargantext-prelude
parent
8e43cc9e
Pipeline
#5424
canceled with stages
Changes
74
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
74 changed files
with
97 additions
and
148 deletions
+97
-148
CleanCsvCorpus.hs
bin/gargantext-cli/CleanCsvCorpus.hs
+1
-1
Main.hs
bin/gargantext-cli/Main.hs
+1
-1
Main.hs
bin/gargantext-db-obfuscation/Main.hs
+3
-2
Main.hs
bin/gargantext-import/Main.hs
+1
-1
Main.hs
bin/gargantext-init/Main.hs
+1
-1
Main.hs
bin/gargantext-invitations/Main.hs
+1
-1
Main.hs
bin/gargantext-phylo/Main.hs
+2
-2
Main.hs
bin/gargantext-server/Main.hs
+2
-2
Main.hs
bin/gargantext-upgrade/Main.hs
+1
-1
update-cabal-project
bin/update-cabal-project
+1
-1
cabal.project
cabal.project
+1
-1
gargantext.cabal
gargantext.cabal
+0
-1
API.hs
src/Gargantext/API.hs
+1
-1
Orchestrator.hs
src/Gargantext/API/Admin/Orchestrator.hs
+1
-1
Types.hs
src/Gargantext/API/Admin/Orchestrator/Types.hs
+1
-1
Settings.hs
src/Gargantext/API/Admin/Settings.hs
+2
-2
Utils.hs
src/Gargantext/API/Admin/Utils.hs
+1
-1
GraphQL.hs
src/Gargantext/API/GraphQL.hs
+1
-1
Contact.sh
src/Gargantext/API/GraphQL/Contact.sh
+1
-1
Team.hs
src/Gargantext/API/GraphQL/Team.hs
+3
-3
UserInfo.hs
src/Gargantext/API/GraphQL/UserInfo.hs
+2
-2
Metrics.hs
src/Gargantext/API/Metrics.hs
+1
-1
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+1
-2
List.hs
src/Gargantext/API/Ngrams/List.hs
+1
-1
Tools.hs
src/Gargantext/API/Ngrams/Tools.hs
+5
-5
Types.hs
src/Gargantext/API/Ngrams/Types.hs
+2
-3
Node.hs
src/Gargantext/API/Node.hs
+1
-1
New.hs
src/Gargantext/API/Node/Corpus/New.hs
+2
-4
File.hs
src/Gargantext/API/Node/Corpus/New/File.hs
+2
-2
Types.hs
src/Gargantext/API/Node/Corpus/New/Types.hs
+1
-1
Export.hs
src/Gargantext/API/Node/Document/Export.hs
+1
-2
DocumentUpload.hs
src/Gargantext/API/Node/DocumentUpload.hs
+1
-1
DocumentsFromWriteNodes.hs
src/Gargantext/API/Node/DocumentsFromWriteNodes.hs
+1
-2
Types.hs
src/Gargantext/API/Node/Types.hs
+1
-1
Update.hs
src/Gargantext/API/Node/Update.hs
+4
-4
Server.hs
src/Gargantext/API/Server.hs
+0
-1
Table.hs
src/Gargantext/API/Table.hs
+3
-3
Core.hs
src/Gargantext/Core.hs
+0
-1
Types.hs
src/Gargantext/Core/Errors/Types.hs
+0
-37
IMTUser.hs
src/Gargantext/Core/Ext/IMTUser.hs
+5
-4
NodeStory.hs
src/Gargantext/Core/NodeStory.hs
+0
-1
Convert.hs
src/Gargantext/Core/Text/Convert.hs
+1
-1
Hal.hs
src/Gargantext/Core/Text/Corpus/API/Hal.hs
+1
-1
Isidore.hs
src/Gargantext/Core/Text/Corpus/API/Isidore.hs
+2
-2
Istex.hs
src/Gargantext/Core/Text/Corpus/API/Istex.hs
+1
-1
Parsers.hs
src/Gargantext/Core/Text/Corpus/Parsers.hs
+1
-1
Book.hs
src/Gargantext/Core/Text/Corpus/Parsers/Book.hs
+1
-1
CSV.hs
src/Gargantext/Core/Text/Corpus/Parsers/CSV.hs
+1
-1
Json2Csv.hs
src/Gargantext/Core/Text/Corpus/Parsers/Json2Csv.hs
+1
-1
Wikidata.hs
src/Gargantext/Core/Text/Corpus/Parsers/Wikidata.hs
+1
-1
CSV.hs
src/Gargantext/Core/Text/List/Formats/CSV.hs
+1
-1
Learn.hs
src/Gargantext/Core/Text/List/Learn.hs
+1
-1
Social.hs
src/Gargantext/Core/Text/List/Social.hs
+0
-1
TFICF.hs
src/Gargantext/Core/Text/Metrics/TFICF.hs
+2
-2
Terms.hs
src/Gargantext/Core/Text/Terms.hs
+0
-1
Stem.hs
src/Gargantext/Core/Text/Terms/Mono/Stem.hs
+1
-1
Multi.hs
src/Gargantext/Core/Text/Terms/Multi.hs
+1
-1
WithList.hs
src/Gargantext/Core/Text/Terms/WithList.hs
+2
-3
Main.hs
src/Gargantext/Core/Types/Main.hs
+1
-1
Phylo.hs
src/Gargantext/Core/Types/Phylo.hs
+3
-3
Utils.hs
src/Gargantext/Core/Utils.hs
+0
-1
Graph.hs
src/Gargantext/Core/Viz/Graph.hs
+0
-1
API.hs
src/Gargantext/Core/Viz/Phylo/API.hs
+2
-2
Delete.hs
src/Gargantext/Database/Action/Delete.hs
+1
-1
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+2
-2
Prelude.hs
src/Gargantext/Database/Prelude.hs
+1
-1
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+2
-2
User.hs
src/Gargantext/Database/Query/Table/Node/User.hs
+1
-1
Ngrams.hs
src/Gargantext/Database/Schema/Ngrams.hs
+1
-1
JohnSnowNLP.hs
src/Gargantext/Utils/JohnSnowNLP.hs
+0
-1
stack.yaml
stack.yaml
+1
-1
UpdateList.hs
test/Test/API/UpdateList.hs
+2
-3
Errors.hs
test/Test/Offline/Errors.hs
+1
-1
Jobs.hs
test/Test/Utils/Jobs.hs
+1
-0
No files found.
bin/gargantext-cli/CleanCsvCorpus.hs
View file @
9a2f05e0
...
...
@@ -52,4 +52,4 @@ main = do
putStrLn
(
"Mean size of docs:"
<>
show
(
CSV
.
docsSize
docs'
)
::
Text
)
CSV
.
writeFile
wPath
(
h
,
docs'
)
Left
e
->
panic
$
"Error: "
<>
e
Left
e
->
panic
Trace
$
"Error: "
<>
e
bin/gargantext-cli/Main.hs
View file @
9a2f05e0
...
...
@@ -95,7 +95,7 @@ main = do
-- r <- mapConcurrentlyChunked (filterTermsAndCooc patterns) (DM.toList corpus)
r
<-
mapConcurrently
(
filterTermsAndCooc
patterns
)
(
DM
.
toList
corpus
)
writeFile
outputFile
$
DTL
.
toStrict
$
TLE
.
decodeUtf8
$
encode
(
CoocByYears
r
)
Left
e
->
panic
$
"Error: "
<>
e
Left
e
->
panic
Trace
$
"Error: "
<>
e
...
...
bin/gargantext-db-obfuscation/Main.hs
View file @
9a2f05e0
...
...
@@ -34,7 +34,8 @@ module Main where
import
Data.Text
qualified
as
T
import
Database.PostgreSQL.Simple
qualified
as
PSQL
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Gargantext.Database.Admin.Config
(
nodeTypeId
)
import
Gargantext.Core
(
toDBid
)
import
Gargantext.Database.Admin.Config
()
import
Gargantext.Database.Admin.Types.Node
(
NodeType
(
..
))
import
Gargantext.Prelude
hiding
(
option
)
import
Gargantext.Prelude.Database
(
runPGSExecute
,
runPGSQuery
)
...
...
@@ -99,7 +100,7 @@ main = do
obfuscateNotes
::
PSQL
.
Connection
->
IO
()
obfuscateNotes
c
=
do
let
nt
=
nodeTypeI
d
Notes
let
nt
=
toDBi
d
Notes
_
<-
runPGSExecute
c
[
sql
|
UPDATE nodes SET name = concat('notes-', id) WHERE typename = ?;
|]
(
PSQL
.
Only
nt
)
...
...
bin/gargantext-import/Main.hs
View file @
9a2f05e0
...
...
@@ -43,7 +43,7 @@ main = do
tt
=
(
Multi
EN
)
format
=
CsvGargV3
-- CsvHal --WOS
limit'
=
case
(
readMaybe
limit
::
Maybe
Limit
)
of
Nothing
->
panic
$
"Cannot read limit: "
<>
(
Text
.
pack
limit
)
Nothing
->
panic
Trace
$
"Cannot read limit: "
<>
(
Text
.
pack
limit
)
Just
l
->
l
corpus
::
forall
m
.
(
FlowCmdM
DevEnv
BackendInternalError
m
,
MonadJobStatus
m
,
JobHandle
m
~
DevJobHandle
)
=>
m
CorpusId
corpus
=
flowCorpusFile
(
UserName
$
cs
user
)
(
Left
(
cs
name
::
Text
))
limit'
tt
format
Plain
corpusPath
Nothing
DevJobHandle
...
...
bin/gargantext-init/Main.hs
View file @
9a2f05e0
...
...
@@ -37,7 +37,7 @@ main = do
params
@
[
iniPath
]
<-
getArgs
_
<-
if
length
params
/=
1
then
panic
"USAGE: ./gargantext-init gargantext.ini"
then
panic
Trace
"USAGE: ./gargantext-init gargantext.ini"
else
pure
()
putStrLn
(
"Enter master user (gargantua) _password_ :"
::
Text
)
...
...
bin/gargantext-invitations/Main.hs
View file @
9a2f05e0
...
...
@@ -31,7 +31,7 @@ main = do
params
@
[
iniPath
,
user
,
node_id
,
email
]
<-
getArgs
_
<-
if
length
params
/=
4
then
panic
"USAGE: ./gargantext-init gargantext.ini username node_id student@university.edu"
then
panic
Trace
"USAGE: ./gargantext-init gargantext.ini username node_id student@university.edu"
else
pure
()
_cfg
<-
readConfig
iniPath
...
...
bin/gargantext-phylo/Main.hs
View file @
9a2f05e0
...
...
@@ -107,7 +107,7 @@ csvToDocs parser patterns time path =
Nothing
[]
time
)
<$>
snd
<$>
either
(
\
err
->
panic
$
"CSV error"
<>
(
show
err
))
identity
<$>
Csv
.
readCSVFile
path
)
<$>
snd
<$>
either
(
\
err
->
panic
Trace
$
"CSV error"
<>
(
show
err
))
identity
<$>
Csv
.
readCSVFile
path
Csv'
limit
->
Vector
.
toList
<$>
Vector
.
take
limit
<$>
Vector
.
map
(
\
row
->
Document
(
toPhyloDate
(
csv'_publication_year
row
)
(
csv'_publication_month
row
)
(
csv'_publication_day
row
)
time
)
...
...
@@ -139,7 +139,7 @@ fileToDocsDefault parser path timeUnits lst =
if
(
length
periods
<
3
)
then
fileToDocsDefault
parser
path
(
tail
timeUnits
)
lst
else
pure
docs
else
panic
"this corpus is incompatible with the phylomemy reconstruction"
else
panic
Trace
"this corpus is incompatible with the phylomemy reconstruction"
-- on passe à passer la time unit dans la conf envoyé au phyloMaker
-- dans le phyloMaker si default est true alors dans le setDefault ou pense à utiliser la TimeUnit de la conf
...
...
bin/gargantext-server/Main.hs
View file @
9a2f05e0
...
...
@@ -74,12 +74,12 @@ main = withLogger () $ \ioLogger -> do
Nothing
->
8008
myIniFile'
=
case
myIniFile
of
Nothing
->
panic
"[ERROR] gargantext.ini needed"
Nothing
->
panic
Trace
"[ERROR] gargantext.ini needed"
Just
i
->
i
---------------------------------------------------------------
let
start
=
case
myMode
of
Mock
->
panic
"[ERROR] Mock mode unsupported"
Mock
->
panic
Trace
"[ERROR] Mock mode unsupported"
_
->
startGargantext
myMode
myPort'
(
unpack
myIniFile'
)
logMsg
ioLogger
INFO
$
"Starting with "
<>
show
myMode
<>
" mode."
logMsg
ioLogger
INFO
$
"Machine locale: "
<>
show
currentLocale
...
...
bin/gargantext-upgrade/Main.hs
View file @
9a2f05e0
...
...
@@ -36,7 +36,7 @@ main = do
params
@
[
iniPath
]
<-
getArgs
_
<-
if
length
params
/=
1
then
panic
"Usage: ./gargantext-upgrade gargantext.ini"
then
panic
Trace
"Usage: ./gargantext-upgrade gargantext.ini"
else
pure
()
putStrLn
$
List
.
unlines
...
...
bin/update-cabal-project
View file @
9a2f05e0
...
...
@@ -11,7 +11,7 @@ STORE_DIR="${1:-$DEFAULT_STORE}"
# `expected_cabal_project_freeze_hash` with the
# `sha256sum` result calculated on the `cabal.project` and `cabal.project.freeze`.
# This ensures the files stay deterministic so that CI cache can kick in.
expected_cabal_project_hash
=
"
f2efe6832145c093cfe16832b17b06cd4e2d94e85dd0390e713c46c40ee9e461
"
expected_cabal_project_hash
=
"
69e03370a602f40243373515ff884a2cd50dc02eb6f52cd23ba9016a61fe8069
"
expected_cabal_project_freeze_hash
=
"796f0109611f3381278b1885ae1fa257c4177b99885eb04701938f1107c06ee5"
cabal
--store-dir
=
$STORE_DIR
v2-update
'hackage.haskell.org,2023-11-23T20:05:40Z'
...
...
cabal.project
View file @
9a2f05e0
...
...
@@ -119,7 +119,7 @@ source-repository-package
source
-
repository
-
package
type
:
git
location
:
https
://
gitlab
.
iscpif
.
fr
/
gargantext
/
haskell
-
gargantext
-
prelude
tag
:
fec7427ba8d1047fd68207afb79139f9dea339e0
tag
:
5
a8dc3a0a1a4774ec2eb9df5f0f0b0a7dd172f09
source
-
repository
-
package
type
:
git
...
...
gargantext.cabal
View file @
9a2f05e0
...
...
@@ -75,7 +75,6 @@ library
Gargantext.API.Prelude
Gargantext.API.Routes
Gargantext.Core
Gargantext.Core.Errors.Types
Gargantext.Core.Mail.Types
Gargantext.Core.Methods.Similarities
Gargantext.Core.NLP
...
...
src/Gargantext/API.hs
View file @
9a2f05e0
...
...
@@ -78,7 +78,7 @@ startGargantext mode port file = withLoggerHoisted mode $ \logger -> do
(
\
(
_
::
SomeException
)
->
pure
$
Right
False
)
case
r
of
Right
True
->
pure
()
_
->
panic
$
_
->
panic
Trace
$
"You must run 'gargantext-init "
<>
pack
file
<>
"' before running gargantext-server (only the first time)."
...
...
src/Gargantext/API/Admin/Orchestrator.hs
View file @
9a2f05e0
...
...
@@ -63,7 +63,7 @@ pipeline :: FromJSON e => URL -> ClientEnv -> ScraperInput
->
(
e
->
IO
()
)
->
IO
JobLog
pipeline
scrapyurl
client_env
input
log_status
=
do
e
<-
runJobMLog
client_env
log_status
$
callScraper
scrapyurl
input
either
(
panic
.
show
)
pure
e
-- TODO throwError
either
(
panic
Trace
.
show
)
pure
e
-- TODO throwError
-- TODO integrate to ServerT
-- use:
...
...
src/Gargantext/API/Admin/Orchestrator/Types.hs
View file @
9a2f05e0
...
...
@@ -23,7 +23,7 @@ import Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
instance
Arbitrary
a
=>
Arbitrary
(
JobStatus
'S
a
fe
a
)
where
arbitrary
=
panic
"TODO"
arbitrary
=
panic
Trace
"TODO"
instance
Arbitrary
a
=>
Arbitrary
(
JobOutput
a
)
where
arbitrary
=
JobOutput
<$>
arbitrary
...
...
src/Gargantext/API/Admin/Settings.hs
View file @
9a2f05e0
...
...
@@ -63,7 +63,7 @@ devSettings jwkFile = do
,
_logLevelLimit
=
LevelDebug
-- , _dbServer = "localhost"
,
_sendLoginEmails
=
LogEmailToConsole
,
_scrapydUrl
=
fromMaybe
(
panic
"Invalid scrapy URL"
)
$
parseBaseUrl
"http://localhost:6800"
,
_scrapydUrl
=
fromMaybe
(
panic
Trace
"Invalid scrapy URL"
)
$
parseBaseUrl
"http://localhost:6800"
,
_cookieSettings
=
defaultCookieSettings
{
cookieXsrfSetting
=
Just
xsrfCookieSetting
}
-- TODO-SECURITY tune
,
_jwtSettings
=
defaultJWTSettings
jwk
-- TODO-SECURITY tune
}
...
...
@@ -177,7 +177,7 @@ newEnv logger port file = do
!
manager_env
<-
newTlsManager
!
settings'
<-
devSettings
devJwkFile
<&>
appPort
.~
port
-- TODO read from 'file'
when
(
port
/=
settings'
^.
appPort
)
$
panic
"TODO: conflicting settings of port"
panic
Trace
"TODO: conflicting settings of port"
!
config_env
<-
readConfig
file
prios
<-
withLogger
()
$
\
ioLogger
->
Jobs
.
readPrios
ioLogger
(
file
<>
".jobs"
)
...
...
src/Gargantext/API/Admin/Utils.hs
View file @
9a2f05e0
...
...
@@ -29,4 +29,4 @@ infixr 4 ?!
-- Reverse infix form of "fromJust" with a custom error message
(
?!
)
::
Maybe
a
->
String
->
a
(
?!
)
ma'
msg
=
ma'
?|
panic
(
T
.
pack
msg
)
(
?!
)
ma'
msg
=
ma'
?|
panic
Trace
(
T
.
pack
msg
)
src/Gargantext/API/GraphQL.hs
View file @
9a2f05e0
...
...
@@ -179,4 +179,4 @@ api
::
(
Typeable
env
,
CmdCommon
env
,
HasJobEnv'
env
,
HasSettings
env
)
=>
ServerT
API
(
GargM
env
BackendInternalError
)
api
(
SAS
.
Authenticated
auser
)
=
(
httpPubApp
[]
.
app
auser
)
:<|>
pure
httpPlayground
api
_
=
panic
"401 in graphql"
-- SAS.throwAll (_ServerError # err401)
api
_
=
panic
Trace
"401 in graphql"
-- SAS.throwAll (_ServerError # err401)
src/Gargantext/API/GraphQL/Contact.sh
View file @
9a2f05e0
...
...
@@ -107,7 +107,7 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
lift
$
printDebug
"[updateUserInfo] ui_id"
ui_id
users
<- lift
(
getUsersWithNodeHyperdata ui_id
)
case
users
of
[]
-> panic
$
"[updateUserInfo] User with id "
<
>
(
T.pack
$
show ui_id
)
<
>
" doesn't exist."
[]
-> panic
Trace
$
"[updateUserInfo] User with id "
<
>
(
T.pack
$
show ui_id
)
<
>
" doesn't exist."
((
_u, node_u
)
:_
)
->
do
let
u_hyperdata
=
node_u ^. node_hyperdata
--
lift
$
printDebug
"[updateUserInfo] u"
u
...
...
src/Gargantext/API/GraphQL/Team.hs
View file @
9a2f05e0
...
...
@@ -73,7 +73,7 @@ dbTeam nodeId = do
shared_folder_id
=
unNodeId
fId
}
uId
Node
{
_node_user_id
}
=
_node_user_id
getUsername
[]
=
panic
"[resolveTeam] Team creator doesn't exist"
getUsername
[]
=
panic
Trace
"[resolveTeam] Team creator doesn't exist"
getUsername
((
UserLight
{
userLight_username
},
_
)
:
_
)
=
userLight_username
-- TODO: list as argument
...
...
@@ -83,11 +83,11 @@ deleteTeamMembership TeamDeleteMArgs { token, shared_folder_id, team_node_id } =
teamNode
<-
lift
$
getNode
$
UnsafeMkNodeId
team_node_id
userNodes
<-
lift
(
getUsersWithNodeHyperdata
$
Individu
.
UserDBId
$
uId
teamNode
)
case
userNodes
of
[]
->
panic
$
"[deleteTeamMembership] User with id "
<>
T
.
pack
(
show
$
uId
teamNode
)
<>
" doesn't exist."
[]
->
panic
Trace
$
"[deleteTeamMembership] User with id "
<>
T
.
pack
(
show
$
uId
teamNode
)
<>
" doesn't exist."
((
_
,
node_u
)
:
_
)
->
do
testAuthUser
<-
lift
$
authUser
(
nId
node_u
)
token
case
testAuthUser
of
Invalid
->
panic
"[deleteTeamMembership] failed to validate user"
Invalid
->
panic
Trace
"[deleteTeamMembership] failed to validate user"
Valid
->
do
lift
$
deleteMemberShip
[(
UnsafeMkNodeId
shared_folder_id
,
UnsafeMkNodeId
team_node_id
)]
where
...
...
src/Gargantext/API/GraphQL/UserInfo.hs
View file @
9a2f05e0
...
...
@@ -124,11 +124,11 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
-- lift $ printDebug "[updateUserInfo] ui_id" ui_id
users
<-
lift
(
getUsersWithNodeHyperdata
(
Individu
.
UserDBId
$
UnsafeMkUserId
ui_id
))
case
users
of
[]
->
panic
$
"[updateUserInfo] User with id "
<>
(
T
.
pack
$
show
ui_id
)
<>
" doesn't exist."
[]
->
panic
Trace
$
"[updateUserInfo] User with id "
<>
(
T
.
pack
$
show
ui_id
)
<>
" doesn't exist."
((
UserLight
{
..
},
node_u
)
:
_
)
->
do
testAuthUser
<-
lift
$
authUser
(
nId
node_u
)
token
case
testAuthUser
of
Invalid
->
panic
"[updateUserInfo] failed to validate user"
Invalid
->
panic
Trace
"[updateUserInfo] failed to validate user"
Valid
->
do
let
u_hyperdata
=
node_u
^.
node_hyperdata
-- lift $ printDebug "[updateUserInfo] u" u
...
...
src/Gargantext/API/Metrics.hs
View file @
9a2f05e0
...
...
@@ -119,7 +119,7 @@ updateScatter' cId listId tabType maybeLimit = do
,
m_y
=
s2
,
m_cat
=
listType
t
ngs'
})
$
fmap
normalizeLocal
scores
listType
t
m
=
maybe
(
panic
errorMsg
)
fst
$
HashMap
.
lookup
t
m
listType
t
m
=
maybe
(
panic
Trace
errorMsg
)
fst
$
HashMap
.
lookup
t
m
errorMsg
=
"API.Node.metrics: key absent"
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
...
...
src/Gargantext/API/Ngrams.hs
View file @
9a2f05e0
...
...
@@ -124,7 +124,6 @@ import Gargantext.Prelude hiding (log, to, toLower, (%))
import
Gargantext.Prelude.Clock
(
hasTime
,
getTime
)
import
Gargantext.Utils.Jobs
(
serveJobsAPI
,
MonadJobStatus
(
..
))
import
GHC.Conc
(
readTVar
,
writeTVar
)
import
Prelude
(
error
)
import
Servant
hiding
(
Patch
)
{-
...
...
@@ -215,7 +214,7 @@ ngramsStatePatchConflictResolution _ngramsType _ngramsTerm
-- they do not extend history,
-- they do not bump version.
insertNewOnly
::
a
->
Maybe
b
->
a
insertNewOnly
m
=
maybe
m
(
const
$
error
"insertNewOnly: impossible"
)
insertNewOnly
m
=
maybe
m
(
const
$
error
Trace
"insertNewOnly: impossible"
)
-- TODO error handling
{- unused
...
...
src/Gargantext/API/Ngrams/List.hs
View file @
9a2f05e0
...
...
@@ -129,7 +129,7 @@ postAsyncJSON l ngramsList jobHandle = do
markProgress
1
jobHandle
corpus_node
<-
getNode
l
-- (Proxy :: Proxy HyperdataList)
let
corpus_id
=
fromMaybe
(
panic
"no parent_id"
)
(
_node_parent_id
corpus_node
)
let
corpus_id
=
fromMaybe
(
panic
Trace
"no parent_id"
)
(
_node_parent_id
corpus_node
)
_
<-
reIndexWith
corpus_id
l
NgramsTerms
(
Set
.
fromList
[
MapTerm
,
CandidateTerm
])
markComplete
jobHandle
...
...
src/Gargantext/API/Ngrams/Tools.hs
View file @
9a2f05e0
...
...
@@ -14,6 +14,7 @@ Portability : POSIX
module
Gargantext.API.Ngrams.Tools
where
-- import Gargantext.Core.NodeStoryFile qualified as NSF
import
Control.Lens
(
_Just
,
(
^.
),
at
,
view
,
At
,
Index
,
IxValue
)
import
Control.Monad.Reader
import
Data.HashMap.Strict
(
HashMap
)
...
...
@@ -21,13 +22,12 @@ import Data.HashMap.Strict qualified as HM
import
Data.Map.Strict
qualified
as
Map
import
Data.Set
qualified
as
Set
import
Data.Validity
import
GHC.Conc
(
TVar
,
readTVar
)
import
Gargantext.API.Ngrams.Types
import
Gargantext.Core.NodeStory
-- import Gargantext.Core.NodeStoryFile qualified as NSF
import
Gargantext.Core.Types
(
ListType
(
..
),
NodeId
,
ListId
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
)
import
Gargantext.Prelude
import
GHC.Conc
(
TVar
,
readTVar
)
mergeNgramsElement
::
NgramsRepoElement
->
NgramsRepoElement
->
NgramsRepoElement
...
...
@@ -134,7 +134,7 @@ filterListWithRootHashMap lt m = snd <$> HM.filter isMapTerm m
isMapTerm
(
l
,
maybeRoot
)
=
case
maybeRoot
of
Nothing
->
l
==
lt
Just
r
->
case
HM
.
lookup
r
m
of
Nothing
->
panic
$
"[Garg.API.Ngrams.Tools] filterListWithRootHashMap, unknown key: "
<>
unNgramsTerm
r
Nothing
->
panic
Trace
$
"[Garg.API.Ngrams.Tools] filterListWithRootHashMap, unknown key: "
<>
unNgramsTerm
r
Just
(
l'
,
_
)
->
l'
==
lt
filterListWithRoot
::
[
ListType
]
...
...
@@ -145,7 +145,7 @@ filterListWithRoot lt m = snd <$> HM.filter isMapTerm m
isMapTerm
(
l
,
maybeRoot
)
=
case
maybeRoot
of
Nothing
->
elem
l
lt
Just
r
->
case
HM
.
lookup
r
m
of
Nothing
->
panic
$
"[Garg.API.Ngrams.Tools] filterListWithRoot, unknown key: "
<>
unNgramsTerm
r
Nothing
->
panic
Trace
$
"[Garg.API.Ngrams.Tools] filterListWithRoot, unknown key: "
<>
unNgramsTerm
r
Just
(
l'
,
_
)
->
elem
l'
lt
groupNodesByNgrams
::
(
Ord
a
...
...
@@ -160,7 +160,7 @@ groupNodesByNgrams syn occs = HM.fromListWith (<>) occs'
where
occs'
=
map
toSyn
(
HM
.
toList
occs
)
toSyn
(
t
,
ns
)
=
case
syn
^.
at
t
of
Nothing
->
panic
$
"[Garg.API.Ngrams.Tools.groupNodesByNgrams] unknown key: "
<>
unNgramsTerm
t
Nothing
->
panic
Trace
$
"[Garg.API.Ngrams.Tools.groupNodesByNgrams] unknown key: "
<>
unNgramsTerm
t
Just
r
->
case
r
of
Nothing
->
(
t
,
ns
)
Just
r'
->
(
r'
,
ns
)
...
...
src/Gargantext/API/Ngrams/Types.hs
View file @
9a2f05e0
...
...
@@ -32,7 +32,7 @@ import Data.Patch.Class (Replace, replace, Action(act), Group, Applicable(..), C
import
Data.Set
qualified
as
Set
import
Data.String
(
IsString
(
..
))
import
Data.Swagger
hiding
(
version
,
patch
)
import
Data.Text
(
pack
,
strip
,
unpack
)
import
Data.Text
(
pack
,
strip
)
import
Data.Validity
import
Database.PostgreSQL.Simple.FromField
(
FromField
,
fromField
,
fromJSONField
)
import
Database.PostgreSQL.Simple.ToField
(
ToField
,
toJSONField
,
toField
)
...
...
@@ -49,7 +49,6 @@ import Servant hiding (Patch)
import
Servant.Job.Utils
(
jsonOptions
)
import
Test.QuickCheck
(
elements
,
frequency
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
import
Gargantext.Core.Errors.Types
(
panicTrace
)
------------------------------------------------------------------------
...
...
@@ -792,7 +791,7 @@ ngramsTypeFromTabType tabType =
Authors
->
TableNgrams
.
Authors
Institutes
->
TableNgrams
.
Institutes
Terms
->
TableNgrams
.
NgramsTerms
_
->
panicTrace
$
unpack
$
here
<>
"No Ngrams for this tab"
_
->
panicTrace
$
here
<>
"No Ngrams for this tab"
-- TODO: This `panic` would disapear with custom NgramsType.
----
...
...
src/Gargantext/API/Node.hs
View file @
9a2f05e0
...
...
@@ -101,7 +101,7 @@ type Roots = Get '[JSON] [Node HyperdataUser]
-- | TODO: access by admin only
roots
::
GargServer
Roots
roots
=
getNodesWithParentId
Nothing
:<|>
pure
(
panic
"not implemented yet"
)
-- TODO use patch map to update what we need
:<|>
pure
(
panic
Trace
"not implemented yet"
)
-- TODO use patch map to update what we need
-------------------------------------------------------------------
-- | Node API Types management
...
...
src/Gargantext/API/Node/Corpus/New.hs
View file @
9a2f05e0
...
...
@@ -20,8 +20,6 @@ module Gargantext.API.Node.Corpus.New
where
-- import Servant.Multipart
-- import Test.QuickCheck (elements)
import
Conduit
import
Control.Lens
hiding
(
elements
,
Empty
)
import
Data.Aeson
...
...
@@ -307,7 +305,7 @@ addToCorpusWithForm user cid nwf jobHandle = do
let
data
'
=
case
(
nwf
^.
wf_fileformat
)
of
Plain
->
cs
(
nwf
^.
wf_data
)
ZIP
->
case
BSB64
.
decode
$
TE
.
encodeUtf8
(
nwf
^.
wf_data
)
of
Left
err
->
panic
$
T
.
pack
"[addToCorpusWithForm] error decoding base64: "
<>
T
.
pack
err
Left
err
->
panic
Trace
$
T
.
pack
"[addToCorpusWithForm] error decoding base64: "
<>
T
.
pack
err
Right
decoded
->
decoded
eDocsC
<-
liftBase
$
parseC
(
nwf
^.
wf_fileformat
)
data
'
case
eDocsC
of
...
...
@@ -325,7 +323,7 @@ addToCorpusWithForm user cid nwf jobHandle = do
,
")"
]
let
panicMsg
=
T
.
concat
$
T
.
pack
<$>
panicMsg'
--logStatus $ jobLogFailTotalWithMessage panicMsg jobLog
panic
panicMsg
panic
Trace
panicMsg
else
pure
doc
)
.|
mapC
toHyperdataDocument
...
...
src/Gargantext/API/Node/Corpus/New/File.hs
View file @
9a2f05e0
...
...
@@ -63,8 +63,8 @@ postUpload :: NodeId
->
Maybe
FileFormat
->
MultipartData
Mem
->
Cmd
err
[
Hash
]
postUpload
_
Nothing
_
_
=
panic
"fileType is a required parameter"
postUpload
_
_
Nothing
_
=
panic
"fileFormat is a required parameter"
postUpload
_
Nothing
_
_
=
panic
Trace
"fileType is a required parameter"
postUpload
_
_
Nothing
_
=
panic
Trace
"fileFormat is a required parameter"
postUpload
_
(
Just
_fileType
)
(
Just
_fileFormat
)
multipartData
=
do
-- printDebug "File Type: " fileType
-- printDebug "File format: " fileFormat
...
...
src/Gargantext/API/Node/Corpus/New/Types.hs
View file @
9a2f05e0
...
...
@@ -30,7 +30,7 @@ instance FromHttpApiData FileType where
parseUrlPiece
"WOS"
=
pure
WOS
parseUrlPiece
"Iramuteq"
=
pure
Iramuteq
parseUrlPiece
"JSON"
=
pure
JSON
parseUrlPiece
s
=
panic
$
"[G.A.A.Node.Corpus.New] File Type not implemented (yet): "
<>
s
parseUrlPiece
s
=
panic
Trace
$
"[G.A.A.Node.Corpus.New] File Type not implemented (yet): "
<>
s
instance
ToHttpApiData
FileType
where
toUrlPiece
=
pack
.
show
...
...
src/Gargantext/API/Node/Document/Export.hs
View file @
9a2f05e0
...
...
@@ -11,7 +11,6 @@ Portability : POSIX
module
Gargantext.API.Node.Document.Export
where
-- import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
import
Control.Lens
(
view
)
import
Data.Csv
(
encodeDefaultOrderedByName
)
import
Data.Version
(
showVersion
)
...
...
@@ -46,7 +45,7 @@ getDocumentsJSON :: NodeId
getDocumentsJSON
nodeUserId
pId
=
do
uId
<-
view
node_user_id
<$>
getNodeUser
nodeUserId
mcId
<-
getClosestParentIdByType
pId
NodeCorpus
let
cId
=
maybe
(
panic
"[G.A.N.D.Export] Node has no parent"
)
identity
mcId
let
cId
=
maybe
(
panic
Trace
"[G.A.N.D.Export] Node has no parent"
)
identity
mcId
docs
<-
runViewDocuments
cId
False
Nothing
Nothing
Nothing
Nothing
Nothing
pure
$
addHeader
(
T
.
concat
[
"attachment; filename=GarganText_DocsList-"
,
T
.
pack
$
show
pId
...
...
src/Gargantext/API/Node/DocumentUpload.hs
View file @
9a2f05e0
...
...
@@ -100,7 +100,7 @@ documentUpload nId doc = do
mcId
<-
getClosestParentIdByType'
nId
NodeCorpus
let
cId
=
case
mcId
of
Just
c
->
c
Nothing
->
panic
$
T
.
pack
$
"[G.A.N.DU] Node has no corpus parent: "
<>
show
nId
Nothing
->
panic
Trace
$
T
.
pack
$
"[G.A.N.DU] Node has no corpus parent: "
<>
show
nId
let
mDateS
=
Just
$
view
du_date
doc
let
(
theFullDate
,
(
year
,
month
,
day
))
=
mDateSplit
mDateS
...
...
src/Gargantext/API/Node/DocumentsFromWriteNodes.hs
View file @
9a2f05e0
...
...
@@ -46,7 +46,6 @@ import Gargantext.Database.Schema.Node (node_hyperdata, node_name, node_date)
import
Gargantext.Prelude
import
Gargantext.Utils.Jobs
(
serveJobsAPI
,
MonadJobStatus
(
..
))
import
Servant
-- import qualified Gargantext.Defaults as Defaults
------------------------------------------------------------------------
type
API
=
Summary
" Documents from Write nodes."
...
...
@@ -94,7 +93,7 @@ documentsFromWriteNodes authenticatedUser nId Params { selection, lang, paragrap
Nothing
->
do
let
msg
=
T
.
pack
$
"[G.A.N.DFWN] Node has no corpus parent: "
<>
show
nId
markFailed
(
Just
msg
)
jobHandle
panic
msg
panic
Trace
msg
frameWriteIds
<-
getChildrenByType
nId
Notes
...
...
src/Gargantext/API/Node/Types.hs
View file @
9a2f05e0
...
...
@@ -71,7 +71,7 @@ instance GargDB.SaveFile NewWithFile where
saveFile'
fp
(
NewWithFile
b64d
_
_
)
=
do
let
eDecoded
=
BSB64
.
decode
$
encodeUtf8
b64d
case
eDecoded
of
Left
err
->
panic
$
T
.
pack
$
"Error decoding: "
<>
err
Left
err
->
panic
Trace
$
T
.
pack
$
"Error decoding: "
<>
err
Right
decoded
->
BS
.
writeFile
fp
decoded
-- BS.writeFile fp $ BSB64.decodeLenient $ TE.encodeUtf8 b64d
...
...
src/Gargantext/API/Node/Update.hs
View file @
9a2f05e0
...
...
@@ -112,7 +112,7 @@ updateNode nid1 (LinkNodeReq nt nid2) jobHandle = do
_
<-
case
nt
of
NodeAnnuaire
->
pairing
nid2
nid1
Nothing
-- defaultList
NodeCorpus
->
pairing
nid1
nid2
Nothing
-- defaultList
_
->
panic
$
"[G.API.N.Update.updateNode] NodeType not implemented"
_
->
panic
Trace
$
"[G.API.N.Update.updateNode] NodeType not implemented"
<>
show
nt
<>
" nid1: "
<>
show
nid1
<>
" nid2: "
<>
show
nid2
markComplete
jobHandle
...
...
@@ -154,7 +154,7 @@ updateNode phyloId (UpdateNodePhylo config) jobHandle = do
corpusId'
<-
view
node_parent_id
<$>
getNode
phyloId
markProgress
1
jobHandle
let
corpusId
=
fromMaybe
(
panic
"
"
)
corpusId'
let
corpusId
=
fromMaybe
(
panic
Trace
"no corpus id
"
)
corpusId'
phy
<-
flowPhyloAPI
(
subConfigAPI2config
config
)
corpusId
markProgress
2
jobHandle
...
...
@@ -180,7 +180,7 @@ updateNode tId (UpdateNodeParamsTexts _mode) jobHandle = do
_
<-
case
corpusId
of
Just
cId
->
updateDocs
cId
Nothing
->
do
_
<-
panic
"[G.A.N.Update] updateNode/UpdateNodeParamsText: no corpus Id given"
_
<-
panic
Trace
"[G.A.N.Update] updateNode/UpdateNodeParamsText: no corpus Id given"
pure
()
markComplete
jobHandle
...
...
src/Gargantext/API/Server.hs
View file @
9a2f05e0
...
...
@@ -29,7 +29,6 @@ import Gargantext.API.Public qualified as Public
import
Gargantext.API.Routes
import
Gargantext.API.Swagger
(
swaggerDoc
)
import
Gargantext.API.ThrowAll
(
serverPrivateGargAPI
)
import
Gargantext.Core.Errors.Types
import
Gargantext.Database.Prelude
(
hasConfig
)
import
Gargantext.Prelude
hiding
(
Handler
,
catch
)
import
Gargantext.Prelude.Config
(
gc_url_backend_api
)
...
...
src/Gargantext/API/Table.hs
View file @
9a2f05e0
...
...
@@ -142,7 +142,7 @@ postTableApi cId tq = case tq of
$
(
logLocM
)
DEBUG
$
"New search with query "
<>
getRawQuery
q
searchInCorpus'
cId
False
q
(
Just
o
)
(
Just
l
)
(
Just
order
)
Trash
->
searchInCorpus'
cId
True
q
(
Just
o
)
(
Just
l
)
(
Just
order
)
x
->
panic
$
"not implemented in tableApi "
<>
(
show
x
)
x
->
panic
Trace
$
"not implemented in tableApi "
<>
(
show
x
)
getTableHashApi
::
(
CmdM
env
err
m
,
HasNodeError
err
,
MonadLogger
m
)
=>
NodeId
...
...
@@ -204,7 +204,7 @@ getTable' cId ft o l order query year =
(
Just
Trash
)
->
runViewDocuments
cId
True
o
l
order
query
year
(
Just
MoreFav
)
->
moreLike
cId
o
l
order
IsFav
(
Just
MoreTrash
)
->
moreLike
cId
o
l
order
IsTrash
x
->
panic
$
"not implemented in getTable: "
<>
(
show
x
)
x
->
panic
Trace
$
"not implemented in getTable: "
<>
(
show
x
)
getPair
::
ContactId
->
Maybe
TabType
...
...
@@ -214,4 +214,4 @@ getPair cId ft o l order =
case
ft
of
(
Just
Docs
)
->
runViewAuthorsDoc
cId
False
o
l
order
(
Just
Trash
)
->
runViewAuthorsDoc
cId
True
o
l
order
_
->
panic
$
"not implemented: get Pairing"
<>
(
show
ft
)
_
->
panic
Trace
$
"not implemented: get Pairing"
<>
(
show
ft
)
src/Gargantext/Core.hs
View file @
9a2f05e0
...
...
@@ -27,7 +27,6 @@ import Servant.API
import
Test.QuickCheck
import
Control.Exception
(
throw
)
import
Prelude
(
userError
)
import
Gargantext.Core.Errors.Types
(
WithStacktrace
(
..
))
------------------------------------------------------------------------
-- | Language of a Text
...
...
src/Gargantext/Core/Errors/Types.hs
deleted
100644 → 0
View file @
8e43cc9e
module
Gargantext.Core.Errors.Types
(
-- * Attaching callstacks to exceptions
WithStacktrace
(
..
)
,
UnexpectedPanic
(
..
)
,
withStacktrace
-- * Drop-in replacement for panic/error
,
panicTrace
)
where
import
Control.Exception
import
GHC.Stack
import
Prelude
-- | A 'WithStacktrace' carries an error alongside its
-- 'CallStack', to be able to print the correct source location
-- of where the error originated.
data
WithStacktrace
e
=
WithStacktrace
{
ct_callStack
::
!
CallStack
,
ct_error
::
!
e
}
deriving
Show
instance
Exception
e
=>
Exception
(
WithStacktrace
e
)
where
displayException
WithStacktrace
{
..
}
=
displayException
ct_error
<>
"
\n
"
<>
prettyCallStack
ct_callStack
withStacktrace
::
HasCallStack
=>
e
->
WithStacktrace
e
withStacktrace
=
withFrozenCallStack
.
WithStacktrace
callStack
newtype
UnexpectedPanic
=
UnexpectedPanic
String
deriving
Show
instance
Exception
UnexpectedPanic
panicTrace
::
HasCallStack
=>
String
->
x
panicTrace
=
throw
.
withFrozenCallStack
.
WithStacktrace
callStack
.
UnexpectedPanic
src/Gargantext/Core/Ext/IMTUser.hs
View file @
9a2f05e0
...
...
@@ -19,6 +19,7 @@ module Gargantext.Core.Ext.IMTUser -- (deserialiseImtUsersFromFile)
import
Codec.Serialise
import
Data.ByteString.Lazy
qualified
as
BL
import
Data.Csv
import
Data.Text
qualified
as
T
import
Data.Vector
(
Vector
)
import
Data.Vector
qualified
as
Vector
import
Gargantext.Core.Text.Corpus.Parsers.CSV
...
...
@@ -31,7 +32,7 @@ readFile_Annuaire :: FilePath -> IO [HyperdataContact]
readFile_Annuaire
fp
=
case
takeExtension
fp
of
".csv"
->
readCSVFile_Annuaire
fp
".data"
->
deserialiseImtUsersFromFile
fp
_
->
panic
"[G.C.E.I.readFile_Annuaire] extension unknown"
unknownExt
->
panicTrace
$
"[G.C.E.I.readFile_Annuaire] extension unknown: "
<>
T
.
pack
unknownExt
------------------------------------------------------------------------
data
IMTUser
=
IMTUser
...
...
@@ -119,7 +120,7 @@ readCSVFile_Annuaire' = fmap readCsvHalLazyBS' . BL.readFile
where
readCsvHalLazyBS'
::
BL
.
ByteString
->
(
Header
,
Vector
IMTUser
)
readCsvHalLazyBS'
bs
=
case
decodeByNameWith
(
csvDecodeOptions
Tab
)
bs
of
Left
e
->
panic
(
cs
e
)
Left
e
->
panic
Trace
(
cs
e
)
Right
rows
->
rows
------------------------------------------------------------------------
...
...
src/Gargantext/Core/NodeStory.hs
View file @
9a2f05e0
...
...
@@ -114,7 +114,6 @@ import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import
GHC.Conc
(
TVar
,
newTVar
,
readTVar
,
writeTVar
)
import
Gargantext.API.Ngrams.Types
import
Gargantext.Core
(
toDBid
)
import
Gargantext.Core.Errors.Types
(
panicTrace
)
import
Gargantext.Core.Types
(
ListId
,
NodeId
(
..
),
NodeType
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Database.Admin.Config
()
...
...
src/Gargantext/Core/Text/Convert.hs
View file @
9a2f05e0
...
...
@@ -26,7 +26,7 @@ risPress2csvWrite f = do
eContents
<-
parseFile
RisPresse
Plain
(
f
<>
".ris"
)
case
eContents
of
Right
contents
->
writeDocs2Csv
(
f
<>
".csv"
)
contents
Left
e
->
panic
$
"Error: "
<>
e
Left
e
->
panic
Trace
$
"Error: "
<>
e
src/Gargantext/Core/Text/Corpus/API/Hal.hs
View file @
9a2f05e0
...
...
@@ -30,7 +30,7 @@ import Servant.Client (ClientError)
get
::
Maybe
ISO639
.
ISO639_1
->
Text
->
Maybe
Int
->
IO
[
HyperdataDocument
]
get
la
q
ml
=
do
eDocs
<-
HAL
.
getMetadataWith
[
q
]
(
Just
0
)
(
fromIntegral
<$>
ml
)
la
either
(
panic
.
pack
.
show
)
(
\
d
->
mapM
(
toDoc'
la
)
$
HAL
.
_docs
d
)
eDocs
either
(
panic
Trace
.
pack
.
show
)
(
\
d
->
mapM
(
toDoc'
la
)
$
HAL
.
_docs
d
)
eDocs
getC
::
Maybe
ISO639
.
ISO639_1
->
Text
->
Maybe
Int
->
IO
(
Either
ClientError
(
Maybe
Integer
,
ConduitT
()
HyperdataDocument
IO
()
))
getC
la
q
ml
=
do
...
...
src/Gargantext/Core/Text/Corpus/API/Isidore.hs
View file @
9a2f05e0
...
...
@@ -31,8 +31,8 @@ get :: Lang -> Maybe Isidore.Limit
->
IO
[
HyperdataDocument
]
get
la
l
q
a
=
do
let
printErr
(
DecodeFailure
e
_
)
=
panic
e
printErr
e
=
panic
(
show
e
)
printErr
(
DecodeFailure
e
_
)
=
panic
Trace
e
printErr
e
=
panic
Trace
(
show
e
)
toIsidoreDocs
::
Reply
->
[
IsidoreDoc
]
toIsidoreDocs
(
ReplyOnly
r
)
=
[
r
]
...
...
src/Gargantext/Core/Text/Corpus/API/Istex.hs
View file @
9a2f05e0
...
...
@@ -58,7 +58,7 @@ get la query' maxResults = do
Right
(
ISTEX
.
Documents
{
_documents_hits
})
->
printDebug
"[Istex.get] length docs"
$
length
_documents_hits
--ISTEX.getMetadataScrollProgress q ((\_ -> pack $ "1m") <$> ml) Nothing progress errorHandler
case
eDocs
of
Left
err
->
panic
.
Text
.
pack
.
show
$
err
Left
err
->
panic
Trace
.
Text
.
pack
.
show
$
err
Right
docs
->
toDoc'
la
docs
--pure $ either (panic . pack . show) (toDoc' la) eDocs
-- where
...
...
src/Gargantext/Core/Text/Corpus/Parsers.hs
View file @
9a2f05e0
...
...
@@ -285,7 +285,7 @@ withParser RIS = RIS.parser
withParser
Iramuteq
=
Iramuteq
.
parser
--withParser ODT = odtParser
--withParser XML = xmlParser
withParser
_
=
panic
"[ERROR] Parser not implemented yet"
withParser
_
=
panic
Trace
"[ERROR] Parser not implemented yet"
runParser
::
FileType
->
DB
.
ByteString
->
IO
(
Either
Text
[[(
DB
.
ByteString
,
DB
.
ByteString
)]])
...
...
src/Gargantext/Core/Text/Corpus/Parsers/Book.hs
View file @
9a2f05e0
...
...
@@ -73,7 +73,7 @@ fileNameInfo fp = toFileInfo xs
where
xs
=
DT
.
splitOn
"_"
$
DT
.
pack
fp
toFileInfo
(
a
:
b
:
_
)
=
FileInfo
(
DT
.
splitOn
"-and-"
a
)
(
cs
b
)
toFileInfo
_
=
panic
"error"
toFileInfo
_
=
panic
Trace
"error"
---------------------------------------------------------------------
publiToHyperdata
::
Int
->
Publi
->
HyperdataDocument
...
...
src/Gargantext/Core/Text/Corpus/Parsers/CSV.hs
View file @
9a2f05e0
...
...
@@ -496,6 +496,6 @@ readWeightedCsv :: FilePath -> IO (Header, Vector Csv')
readWeightedCsv
fp
=
fmap
(
\
bs
->
case
decodeByNameWith
(
csvDecodeOptions
Tab
)
bs
of
Left
e
->
panic
(
pack
e
)
Left
e
->
panic
Trace
(
pack
e
)
Right
corpus
->
corpus
)
$
BL
.
readFile
fp
src/Gargantext/Core/Text/Corpus/Parsers/Json2Csv.hs
View file @
9a2f05e0
...
...
@@ -44,7 +44,7 @@ type FilePathOut = FilePath
json2csv
::
FilePathIn
->
FilePathOut
->
IO
()
json2csv
fin
fout
=
do
patents
<-
maybe
(
panic
"json2csv error"
)
identity
<$>
readPatents
fin
patents
<-
maybe
(
panic
Trace
"json2csv error"
)
identity
<$>
readPatents
fin
writeFile
fout
(
headerCsvGargV3
,
fromList
$
map
patent2csvDoc
patents
)
patent2csvDoc
::
Patent
->
CsvDoc
...
...
src/Gargantext/Core/Text/Corpus/Parsers/Wikidata.hs
View file @
9a2f05e0
...
...
@@ -114,7 +114,7 @@ unbound' l = map (map (unbound l))
toWikiResult
::
[
Maybe
Text
]
->
WikiResult
toWikiResult
(
c
:
t
:
u
:
ys
:
ye
:
yf
:
_
)
=
WikiResult
c
t
u
ys
ye
yf
toWikiResult
_
=
panic
"[G.C.T.C.Parsers.Wikidata.toWikiResult] error"
toWikiResult
_
=
panic
Trace
"[G.C.T.C.Parsers.Wikidata.toWikiResult] error"
wikidataRoute
::
EndPoint
wikidataRoute
=
"https://query.wikidata.org/sparql"
...
...
src/Gargantext/Core/Text/List/Formats/CSV.hs
View file @
9a2f05e0
...
...
@@ -88,7 +88,7 @@ fromCsvListFile :: FilePath -> IO (Header, Vector CsvList)
fromCsvListFile
fp
=
do
csvData
<-
BL
.
readFile
fp
case
decodeByNameWith
csvDecodeOptions
csvData
of
Left
e
->
panic
(
pack
e
)
Left
e
->
panic
Trace
(
pack
e
)
Right
csvList
->
pure
csvList
------------------------------------------------------------------------
toCsvListFile
::
FilePath
->
(
Header
,
Vector
CsvList
)
->
IO
()
...
...
src/Gargantext/Core/Text/List/Learn.hs
View file @
9a2f05e0
...
...
@@ -83,7 +83,7 @@ type Param = Double
grid
::
(
MonadBase
IO
m
)
=>
Param
->
Param
->
Train
->
[
Tests
]
->
m
(
Maybe
Model
)
grid
_
_
_
[]
=
panic
"Gargantext.Core.Text.List.Learn.grid : empty test data"
grid
_
_
_
[]
=
panic
Trace
"Gargantext.Core.Text.List.Learn.grid : empty test data"
grid
s
e
tr
te
=
do
let
grid'
::
(
MonadBase
IO
m
)
...
...
src/Gargantext/Core/Text/List/Social.hs
View file @
9a2f05e0
...
...
@@ -25,7 +25,6 @@ import Data.Vector qualified as V
import
GHC.Generics
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
,
NgramsPatch
)
import
Gargantext.Core.NodeStory
(
getNodesArchiveHistory
)
import
Gargantext.Core.Errors.Types
(
panicTrace
)
import
Gargantext.Core.Text.List.Social.Find
(
findListsId
)
import
Gargantext.Core.Text.List.Social.Patch
(
addScorePatches
)
import
Gargantext.Core.Text.List.Social.Prelude
(
FlowCont
,
FlowListScores
)
...
...
src/Gargantext/Core/Text/Metrics/TFICF.hs
View file @
9a2f05e0
...
...
@@ -47,11 +47,11 @@ tficf :: TficfContext Count Total
tficf
(
TficfInfra
(
Count
ic
)
(
Total
it
)
)
(
TficfSupra
(
Count
sc
)
(
Total
st
)
)
|
it
>=
ic
&&
st
>=
sc
&&
it
<=
st
=
(
it
/
ic
)
*
log
(
st
/
sc
)
|
otherwise
=
panic
|
otherwise
=
panic
Trace
$
"[ERR]"
<>
path
<>
" Frequency impossible"
tficf
_
_
=
panic
$
"[ERR]"
<>
path
<>
"Undefined for these contexts"
tficf
_
_
=
panic
Trace
$
"[ERR]"
<>
path
<>
"Undefined for these contexts"
sortTficf
::
Ordering
...
...
src/Gargantext/Core/Text/Terms.hs
View file @
9a2f05e0
...
...
@@ -46,7 +46,6 @@ import Data.Text qualified as Text
import
Data.Traversable
import
GHC.Base
(
String
)
import
Gargantext.Core
import
Gargantext.Core.Errors.Types
(
panicTrace
)
import
Gargantext.Core.Text
(
sentences
,
HasText
(
..
))
import
Gargantext.Core.Text.Terms.Eleve
(
mainEleveWith
,
Tries
,
Token
,
buildTries
,
toToken
)
import
Gargantext.Core.Text.Terms.Mono
(
monoTerms
)
...
...
src/Gargantext/Core/Text/Terms/Mono/Stem.hs
View file @
9a2f05e0
...
...
@@ -52,7 +52,7 @@ stem lang = DT.pack . N.stem lang' . DT.unpack
lang'
=
case
lang
of
EN
->
N
.
English
FR
->
N
.
French
_
->
panic
$
DT
.
pack
"not implemented yet"
_
->
panic
Trace
$
DT
.
pack
"not implemented yet"
src/Gargantext/Core/Text/Terms/Multi.hs
View file @
9a2f05e0
...
...
@@ -67,7 +67,7 @@ tokenTags (NLPServerConfig { server = Spacy, url }) l txt = do
-- if txt == ""
-- then pure [[]]
-- else tokenTagsWith FR txt SpacyNLP.nlp
tokenTags
_
l
_
=
panic
$
"[G.C.T.T.Multi] Lang NLP API not implemented yet "
<>
(
show
l
)
tokenTags
_
l
_
=
panic
Trace
$
"[G.C.T.T.Multi] Lang NLP API not implemented yet "
<>
(
show
l
)
tokenTagsWith
::
Lang
->
Text
->
NLP_API
->
IO
[[
TokenTag
]]
tokenTagsWith
lang
txt
nlp
=
map
(
groupTokens
lang
)
...
...
src/Gargantext/Core/Text/Terms/WithList.hs
View file @
9a2f05e0
...
...
@@ -30,7 +30,6 @@ import Gargantext.Core.Types (TermsCount)
import
Gargantext.Core.Utils
(
groupWithCounts
)
import
Gargantext.Prelude
hiding
(
concat
)
import
GHC.Exts
(
sortWith
)
import
Prelude
(
error
)
------------------------------------------------------------------------
...
...
@@ -77,8 +76,8 @@ buildPatterns = sortWith (Down . _pat_length) . concatMap buildPattern
where
buildPattern
(
label
,
alts
)
=
map
f
$
map
(
\
alt
->
filter
(
/=
""
)
alt
)
(
label
:
alts
)
where
f
alt
|
""
`
elem
`
alt
=
error
(
"buildPatterns: ERR1"
<>
show
(
label
))
|
null
alt
=
error
"buildPatterns: ERR2"
f
alt
|
""
`
elem
`
alt
=
error
Trace
(
"buildPatterns: ERR1"
<>
show
(
label
))
|
null
alt
=
error
Trace
"buildPatterns: ERR2"
|
otherwise
=
Pattern
(
KMP
.
build
alt
)
(
length
alt
)
label
--(Terms label $ Set.empty) -- TODO check stems
...
...
src/Gargantext/Core/Types/Main.hs
View file @
9a2f05e0
...
...
@@ -72,7 +72,7 @@ instance FromHttpApiData ListType where
parseUrlPiece
s
=
Right
s'
where
s'
=
case
(
readMaybe
$
unpack
s
)
of
Nothing
->
panic
$
"Cannot read url piece: "
<>
s
Nothing
->
panic
Trace
$
"Cannot read url piece: "
<>
s
Just
s''
->
s''
instance
ToHttpApiData
ListType
where
toUrlPiece
=
pack
.
show
...
...
src/Gargantext/Core/Types/Phylo.hs
View file @
9a2f05e0
...
...
@@ -242,7 +242,7 @@ mkObject gvid commonData objectTypeData =
in
case
(
commonDataJSON
,
objectTypeDataJSON
,
header
)
of
(
Object
hdr
,
Object
cdJSON
,
Object
etDataJSON
)
->
Object
$
hdr
<>
cdJSON
<>
etDataJSON
_
->
panic
"[Gargantext.Core.Types.Phylo.mkObject] impossible: commonData, header or objectTypeDataJSON didn't convert back to JSON Object."
_
->
panic
Trace
"[Gargantext.Core.Types.Phylo.mkObject] impossible: commonData, header or objectTypeDataJSON didn't convert back to JSON Object."
data
GroupToNodeData
=
GroupToNodeData
...
...
@@ -491,7 +491,7 @@ mkGraphData GraphData{..} =
datJSON
=
toJSON
_gd_data
in
case
(
hdrJSON
,
datJSON
)
of
(
Object
a
,
Object
b
)
->
Object
$
a
<>
b
_
->
panic
"[Gargantext.Core.Types.Phylo.mkGraphData] impossible: header or data didn't convert back to JSON Object."
_
->
panic
Trace
"[Gargantext.Core.Types.Phylo.mkGraphData] impossible: header or data didn't convert back to JSON Object."
instance
FromJSON
GraphData
where
parseJSON
=
withObject
"GraphData"
$
\
o
->
do
...
...
@@ -529,7 +529,7 @@ mkEdge edgeType gvid commonData edgeTypeData =
in
case
(
commonDataJSON
,
edgeTypeDataJSON
,
header
)
of
(
Object
hdr
,
Object
cdJSON
,
Object
etDataJSON
)
->
Object
$
hdr
<>
cdJSON
<>
etDataJSON
_
->
panic
"[Gargantext.Core.Types.Phylo.mkEdge] impossible: commonData, header or edgeTypeDataJSON didn't convert back to JSON Object."
_
->
panic
Trace
"[Gargantext.Core.Types.Phylo.mkEdge] impossible: commonData, header or edgeTypeDataJSON didn't convert back to JSON Object."
instance
FromJSON
EdgeData
where
...
...
src/Gargantext/Core/Utils.hs
View file @
9a2f05e0
...
...
@@ -27,7 +27,6 @@ import Data.List qualified as List
import
Data.Maybe
import
Data.Monoid
import
Data.Text
qualified
as
T
import
Gargantext.Core.Errors.Types
import
Gargantext.Core.Utils.Prefix
import
Gargantext.Prelude
import
Prelude
((
!!
))
...
...
src/Gargantext/Core/Viz/Graph.hs
View file @
9a2f05e0
...
...
@@ -19,7 +19,6 @@ import Data.ByteString.Lazy as DBL (readFile, writeFile)
import
Data.HashMap.Strict
(
HashMap
,
lookup
)
import
Data.Text
qualified
as
Text
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
(
..
),
NgramsRepoElement
(
..
),
mSetToList
)
import
Gargantext.Core.Errors.Types
(
panicTrace
)
import
Gargantext.Core.Viz.Graph.Types
import
Gargantext.Database.Admin.Types.Hyperdata.Prelude
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
...
...
src/Gargantext/Core/Viz/Phylo/API.hs
View file @
9a2f05e0
...
...
@@ -143,7 +143,7 @@ getPhyloDataJson phyloId = do
let
phyloData
=
fromMaybe
phyloCleopatre
maybePhyloData
phyloJson
<-
liftBase
$
phylo2dot2json
phyloData
case
parseEither
parseJSON
phyloJson
of
Left
err
->
panic
$
T
.
pack
$
"[Gargantext.Core.Viz.Phylo.API] getPhyloDataJson: "
<>
err
Left
err
->
panic
Trace
$
T
.
pack
$
"[Gargantext.Core.Viz.Phylo.API] getPhyloDataJson: "
<>
err
Right
gd
->
pure
gd
...
...
@@ -173,7 +173,7 @@ postPhylo phyloId _lId = do
-- _sft = Just (Software "Gargantext" "4")
-- _prm = initPhyloParam vrs sft (Just q)
corpusId
<-
getClosestParentIdByType
phyloId
NodeCorpus
phy
<-
flowPhyloAPI
defaultConfig
(
fromMaybe
(
panic
"[G.C.V.P.API] no corpus ID found"
)
corpusId
)
-- params
phy
<-
flowPhyloAPI
defaultConfig
(
fromMaybe
(
panic
Trace
"[G.C.V.P.API] no corpus ID found"
)
corpusId
)
-- params
-- phyloId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just corpusId) userId]
_
<-
updateHyperdata
phyloId
(
HyperdataPhylo
Nothing
(
Just
phy
))
pure
phyloId
...
...
src/Gargantext/Database/Action/Delete.hs
View file @
9a2f05e0
...
...
@@ -46,7 +46,7 @@ deleteNode :: (CmdCommon env, HasNodeError err)
deleteNode
u
nodeId
=
do
node'
<-
N
.
getNode
nodeId
case
(
view
node_typename
node'
)
of
nt
|
nt
==
toDBid
NodeUser
->
panic
"[G.D.A.D.deleteNode] Not allowed to delete NodeUser (yet)"
nt
|
nt
==
toDBid
NodeUser
->
panic
Trace
"[G.D.A.D.deleteNode] Not allowed to delete NodeUser (yet)"
nt
|
nt
==
toDBid
NodeTeam
->
do
uId
<-
getUserId
u
if
_node_user_id
node'
==
uId
...
...
src/Gargantext/Database/Action/Flow.hs
View file @
9a2f05e0
...
...
@@ -264,7 +264,7 @@ flowCorpusFile u n _l la ft ff fp mfslw jobHandle = do
flowCorpus
u
n
la
mfslw
(
fromIntegral
$
length
parsed
,
yieldMany
parsed
.|
mapC
toHyperdataDocument
)
jobHandle
--let docs = splitEvery 500 $ take l parsed
--flowCorpus u n la mfslw (yieldMany $ map (map toHyperdataDocument) docs) logStatus
Left
e
->
panic
$
"Error: "
<>
e
Left
e
->
panic
Trace
$
"Error: "
<>
e
------------------------------------------------------------------------
-- | TODO improve the needed type to create/update a corpus
...
...
@@ -510,7 +510,7 @@ viewUniqId' :: UniqId a
->
(
Hash
,
a
)
viewUniqId'
d
=
maybe
err
(
\
h
->
(
h
,
d
))
(
view
uniqId
d
)
where
err
=
panic
"[ERROR] Database.Flow.toInsert"
err
=
panic
Trace
"[ERROR] Database.Flow.toInsert"
toInserted
::
[
ReturnId
]
...
...
src/Gargantext/Database/Prelude.hs
View file @
9a2f05e0
...
...
@@ -189,7 +189,7 @@ databaseParameters fp = do
let
val'
key
=
unpack
$
val
ini
"database"
key
let
dbPortRaw
=
val'
"DB_PORT"
let
dbPort
=
case
(
readMaybe
dbPortRaw
::
Maybe
Word16
)
of
Nothing
->
panic
$
"DB_PORT incorrect: "
<>
(
pack
dbPortRaw
)
Nothing
->
panic
Trace
$
"DB_PORT incorrect: "
<>
(
pack
dbPortRaw
)
Just
d
->
d
pure
$
PGS
.
ConnectInfo
{
PGS
.
connectHost
=
val'
"DB_HOST"
...
...
src/Gargantext/Database/Query/Table/Node.hs
View file @
9a2f05e0
...
...
@@ -350,7 +350,7 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parent_id (pgNodeId <$> p
node2table
::
HasDBid
NodeType
=>
UserId
->
Maybe
ParentId
->
Node'
->
NodeWrite
node2table
uid
pid
(
Node'
nt
txt
v
[]
)
=
Node
Nothing
Nothing
(
sqlInt4
$
toDBid
nt
)
(
sqlInt4
$
_UserId
uid
)
(
fmap
pgNodeId
pid
)
(
sqlStrictText
txt
)
Nothing
(
sqlStrictJSONB
$
cs
$
encode
v
)
node2table
_
_
(
Node'
_
_
_
_
)
=
panic
"node2table: should not happen, Tree insert not implemented yet"
node2table
_
_
(
Node'
_
_
_
_
)
=
panic
Trace
"node2table: should not happen, Tree insert not implemented yet"
data
Node'
=
Node'
{
_n_type
::
NodeType
...
...
@@ -371,7 +371,7 @@ childWith :: HasDBid NodeType
=>
UserId
->
ParentId
->
Node'
->
NodeWrite
childWith
uId
pId
(
Node'
NodeDocument
txt
v
[]
)
=
node2table
uId
(
Just
pId
)
(
Node'
NodeDocument
txt
v
[]
)
childWith
uId
pId
(
Node'
NodeContact
txt
v
[]
)
=
node2table
uId
(
Just
pId
)
(
Node'
NodeContact
txt
v
[]
)
childWith
_
_
(
Node'
_
_
_
_
)
=
panic
"This NodeType can not be a child"
childWith
_
_
(
Node'
_
_
_
_
)
=
panic
Trace
"This NodeType can not be a child"
-- =================================================================== --
...
...
src/Gargantext/Database/Query/Table/Node/User.hs
View file @
9a2f05e0
...
...
@@ -25,7 +25,7 @@ import Opaleye (limit)
getNodeUser
::
NodeId
->
DBCmd
err
(
Node
HyperdataUser
)
getNodeUser
nId
=
do
fromMaybe
(
panic
$
"Node does not exist: "
<>
(
show
nId
))
.
headMay
fromMaybe
(
panic
Trace
$
"Node does not exist: "
<>
(
show
nId
))
.
headMay
<$>
runOpaQuery
(
limit
1
$
selectNode
(
pgNodeId
nId
))
nodeUserW
::
HasDBid
NodeType
=>
Maybe
Name
->
Maybe
HyperdataUser
->
UserId
->
NodeWrite
...
...
src/Gargantext/Database/Schema/Ngrams.hs
View file @
9a2f05e0
...
...
@@ -221,7 +221,7 @@ instance Functor NgramsT where
-----------------------------------------------------------------------
withMap
::
HashMap
Text
NgramsId
->
Text
->
NgramsId
withMap
m
n
=
maybe
(
panic
$
"[G.D.S.Ngrams.withMap] Should not happen"
<>
(
show
n
))
withMap
m
n
=
maybe
(
panic
Trace
$
"[G.D.S.Ngrams.withMap] Should not happen"
<>
(
show
n
))
identity
(
HashMap
.
lookup
n
m
)
indexNgramsT
::
HashMap
Text
NgramsId
->
NgramsT
Ngrams
->
NgramsT
(
Indexed
Int
Ngrams
)
...
...
src/Gargantext/Utils/JohnSnowNLP.hs
View file @
9a2f05e0
...
...
@@ -21,7 +21,6 @@ import Data.List.Safe qualified as LS
import
Data.Map.Strict
qualified
as
Map
import
Data.Text
hiding
(
map
,
group
,
filter
,
concat
,
zip
)
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core.Errors.Types
import
Gargantext.Core.Text.Terms.Multi.PosTagging.Types
import
Gargantext.Core.Types
(
POS
(
..
))
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
...
...
stack.yaml
View file @
9a2f05e0
...
...
@@ -22,7 +22,7 @@ allow-newer: true
extra-deps
:
-
git
:
https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude
commit
:
fec7427ba8d1047fd68207afb79139f9dea339e0
commit
:
5a8dc3a0a1a4774ec2eb9df5f0f0b0a7dd172f09
-
git
:
https://gitlab.iscpif.fr/gargantext/iso639.git
commit
:
eab929d106833ded8011a0d6705135e3fc506a9c
-
git
:
https://gitlab.iscpif.fr/gargantext/gargantext-graph.git
...
...
test/Test/API/UpdateList.hs
View file @
9a2f05e0
...
...
@@ -31,7 +31,6 @@ import Gargantext.Database.Schema.Ngrams
import
Gargantext.Prelude
hiding
(
get
)
import
Network.Wai.Handler.Warp
qualified
as
Wai
import
Paths_gargantext
(
getDataFileName
)
import
Prelude
(
error
)
import
Test.API.Private
(
withValidLogin
,
protectedJSON
,
postJSONUrlEncoded
,
getJSON
)
import
Test.API.Setup
(
withTestDBAndPort
,
setupEnvironment
,
mkUrl
,
createAliceAndBob
)
import
Test.Database.Types
...
...
@@ -84,7 +83,7 @@ pollUntilFinished :: HasCallStack
pollUntilFinished
tkn
port
mkUrlPiece
=
go
60
where
go
::
Int
->
JobPollHandle
->
WaiSession
()
JobPollHandle
go
0
h
=
error
$
T
.
unpack
$
"pollUntilFinished exhausted attempts. Last found JobPollHandle: "
<>
T
.
decodeUtf8
(
BL
.
toStrict
$
JSON
.
encode
h
)
go
0
h
=
panicTrace
$
"pollUntilFinished exhausted attempts. Last found JobPollHandle: "
<>
T
.
decodeUtf8
(
BL
.
toStrict
$
JSON
.
encode
h
)
go
n
h
=
case
_jph_status
h
==
"IsPending"
||
_jph_status
h
==
"IsRunning"
of
True
->
do
liftIO
$
threadDelay
1
_000_000
...
...
@@ -92,7 +91,7 @@ pollUntilFinished tkn port mkUrlPiece = go 60
go
(
n
-
1
)
h'
False
|
_jph_status
h
==
"IsFailure"
->
error
$
T
.
unpack
$
"JobPollHandle contains a failure: "
<>
T
.
decodeUtf8
(
BL
.
toStrict
$
JSON
.
encode
h
)
->
panicTrace
$
"JobPollHandle contains a failure: "
<>
T
.
decodeUtf8
(
BL
.
toStrict
$
JSON
.
encode
h
)
|
otherwise
->
pure
h
...
...
test/Test/Offline/Errors.hs
View file @
9a2f05e0
...
...
@@ -3,8 +3,8 @@
module
Test.Offline.Errors
(
tests
)
where
import
Control.Exception
import
Gargantext.Prelude.Error
import
Gargantext.Core
(
fromDBid
)
import
Gargantext.Core.Errors.Types
import
Gargantext.Database.Admin.Config
()
import
Gargantext.Database.Admin.Types.Node
import
Prelude
...
...
test/Test/Utils/Jobs.hs
View file @
9a2f05e0
...
...
@@ -228,6 +228,7 @@ instance MonadJobStatus MyDummyMonad where
type
JobOutputType
MyDummyMonad
=
JobLog
type
JobEventType
MyDummyMonad
=
JobLog
noJobHandle
_
=
noJobHandle
(
Proxy
::
Proxy
(
GargM
Env
BackendInternalError
))
getLatestJobStatus
jId
=
MyDummyMonad
(
getLatestJobStatus
jId
)
withTracer
_
jh
n
=
n
jh
markStarted
n
jh
=
MyDummyMonad
(
markStarted
n
jh
)
...
...
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