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
153
Issues
153
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
10c569cf
Commit
10c569cf
authored
Dec 07, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] removing no warnings for shadowing
parent
dacf2fa9
Pipeline
#1280
failed with stage
Changes
17
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
17 changed files
with
57 additions
and
57 deletions
+57
-57
Settings.hs
src/Gargantext/API/Admin/Settings.hs
+10
-10
Count.hs
src/Gargantext/API/Count.hs
+1
-1
Routes.hs
src/Gargantext/API/Routes.hs
+12
-12
Search.hs
src/Gargantext/API/Search.hs
+3
-3
Individu.hs
src/Gargantext/Core/Types/Individu.hs
+1
-1
Main.hs
src/Gargantext/Core/Types/Main.hs
+1
-1
Lists.hs
src/Gargantext/Database/Action/Metrics/Lists.hs
+1
-1
Node.hs
src/Gargantext/Database/Action/Node.hs
+1
-1
Facet.hs
src/Gargantext/Database/Query/Facet.hs
+6
-6
Filter.hs
src/Gargantext/Database/Query/Filter.hs
+1
-1
Join.hs
src/Gargantext/Database/Query/Join.hs
+1
-1
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+8
-8
Children.hs
src/Gargantext/Database/Query/Table/Node/Children.hs
+1
-1
User.hs
src/Gargantext/Database/Query/Table/User.hs
+7
-7
Node.hs
src/Gargantext/Database/Schema/Node.hs
+1
-1
User.hs
src/Gargantext/Database/Schema/User.hs
+1
-1
Prelude.hs
src/Gargantext/Prelude.hs
+1
-1
No files found.
src/Gargantext/API/Admin/Settings.hs
View file @
10c569cf
...
...
@@ -10,7 +10,7 @@ Portability : POSIX
TODO-SECURITY: Critical
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
...
...
@@ -111,9 +111,9 @@ repoSaverAction repoDir a = do
-- If repoSaverAction start taking more time than the debounceFreq then it should
-- be increased.
mkRepoSaver
::
RepoDirFilePath
->
MVar
NgramsRepo
->
IO
(
IO
()
)
mkRepoSaver
repoDir
repo_var
=
mkDebounce
settings
mkRepoSaver
repoDir
repo_var
=
mkDebounce
settings
'
where
settings
=
defaultDebounceSettings
settings
'
=
defaultDebounceSettings
{
debounceFreq
=
let
n
=
6
::
Int
in
10
^
n
-- 1 second
,
debounceAction
=
withMVar
repo_var
(
repoSaverAction
repoDir
)
-- Here this not only `readMVar` but `takeMVar`.
...
...
@@ -162,27 +162,27 @@ devJwkFile = "dev.jwk"
newEnv
::
PortNumber
->
FilePath
->
IO
Env
newEnv
port
file
=
do
manager
<-
newTlsManager
settings
<-
devSettings
devJwkFile
<&>
appPort
.~
port
-- TODO read from 'file'
when
(
port
/=
settings
^.
appPort
)
$
settings
'
<-
devSettings
devJwkFile
<&>
appPort
.~
port
-- TODO read from 'file'
when
(
port
/=
settings
'
^.
appPort
)
$
panic
"TODO: conflicting settings of port"
config
<-
readConfig
file
config
'
<-
readConfig
file
self_url
<-
parseBaseUrl
$
"http://0.0.0.0:"
<>
show
port
dbParam
<-
databaseParameters
file
pool
<-
newPool
dbParam
repo
<-
readRepoEnv
(
_gc_repofilepath
config
)
repo
<-
readRepoEnv
(
_gc_repofilepath
config
'
)
scrapers_env
<-
newJobEnv
defaultSettings
manager
logger
<-
newStderrLoggerSet
defaultBufSize
pure
$
Env
{
_env_settings
=
settings
{
_env_settings
=
settings
'
,
_env_logger
=
logger
,
_env_pool
=
pool
,
_env_repo
=
repo
,
_env_manager
=
manager
,
_env_scrapers
=
scrapers_env
,
_env_self_url
=
self_url
,
_env_config
=
config
,
_env_config
=
config
'
}
newPool
::
ConnectInfo
->
IO
(
Pool
Connection
)
...
...
@@ -194,4 +194,4 @@ cleanEnv env = do
repoSaverAction
(
env
^.
config
.
gc_repofilepath
)
r
unlockFile
(
env
^.
repoEnv
.
renv_lock
)
type
IniPath
=
FilePath
\ No newline at end of file
type
IniPath
=
FilePath
src/Gargantext/API/Count.hs
View file @
10c569cf
...
...
@@ -10,7 +10,7 @@ Portability : POSIX
Count API part of Gargantext.
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
...
...
src/Gargantext/API/Routes.hs
View file @
10c569cf
...
...
@@ -9,7 +9,7 @@ Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeOperators #-}
...
...
@@ -250,9 +250,9 @@ waitAPI n = do
addCorpusWithQuery
::
User
->
GargServer
New
.
AddWithQuery
addCorpusWithQuery
user
cid
=
serveJobsAPI
$
JobFunction
(
\
q
log
->
do
JobFunction
(
\
q
log
'
->
do
limit
<-
view
$
config
.
gc_max_docs_scrapers
New
.
addToCorpusWithQuery
user
cid
q
(
Just
limit
)
(
liftBase
.
log
)
New
.
addToCorpusWithQuery
user
cid
q
(
Just
limit
)
(
liftBase
.
log
'
)
{- let log' x = do
printDebug "addToCorpusWithQuery" x
liftBase $ log x
...
...
@@ -269,25 +269,25 @@ addWithFile cid i f =
addCorpusWithForm
::
User
->
GargServer
New
.
AddWithForm
addCorpusWithForm
user
cid
=
serveJobsAPI
$
JobFunction
(
\
i
log
->
JobFunction
(
\
i
log
'
->
let
log'
x
=
do
log'
'
x
=
do
printDebug
"addToCorpusWithForm"
x
liftBase
$
log
x
in
New
.
addToCorpusWithForm
user
cid
i
log'
)
liftBase
$
log
'
x
in
New
.
addToCorpusWithForm
user
cid
i
log'
'
)
addCorpusWithFile
::
User
->
GargServer
New
.
AddWithFile
addCorpusWithFile
user
cid
=
serveJobsAPI
$
JobFunction
(
\
i
log
->
JobFunction
(
\
i
log
'
->
let
log'
x
=
do
log'
'
x
=
do
printDebug
"addToCorpusWithFile"
x
liftBase
$
log
x
in
New
.
addToCorpusWithFile
user
cid
i
log'
)
liftBase
$
log
'
x
in
New
.
addToCorpusWithFile
user
cid
i
log'
'
)
addAnnuaireWithForm
::
GargServer
Annuaire
.
AddWithForm
addAnnuaireWithForm
cid
=
serveJobsAPI
$
JobFunction
(
\
i
log
->
Annuaire
.
addToAnnuaireWithForm
cid
i
(
liftBase
.
log
))
JobFunction
(
\
i
log
'
->
Annuaire
.
addToAnnuaireWithForm
cid
i
(
liftBase
.
log'
))
src/Gargantext/API/Search.hs
View file @
10c569cf
...
...
@@ -10,7 +10,7 @@ Portability : POSIX
Count API part of Gargantext.
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
...
...
@@ -258,7 +258,7 @@ class ToHyperdataRow a where
toHyperdataRow
::
a
->
HyperdataRow
instance
ToHyperdataRow
HyperdataDocument
where
toHyperdataRow
(
HyperdataDocument
b
d
u
ui
ub
p
t
a
i
s
abs
pd
py
pm
pda
ph
pmin
psec
l
)
=
toHyperdataRow
(
HyperdataDocument
b
d
u
ui
ub
p
t
a
i
s
abs
'
pd
py
pm
pda
ph
pmin
psec
l
)
=
HyperdataRowDocument
(
fromMaybe
""
b
)
(
fromMaybe
""
d
)
...
...
@@ -270,7 +270,7 @@ instance ToHyperdataRow HyperdataDocument where
(
fromMaybe
""
a
)
(
fromMaybe
""
i
)
(
fromMaybe
""
s
)
(
fromMaybe
""
abs
)
(
fromMaybe
""
abs
'
)
(
fromMaybe
""
pd
)
(
fromMaybe
2020
py
)
(
fromMaybe
1
pm
)
...
...
src/Gargantext/Core/Types/Individu.hs
View file @
10c569cf
...
...
@@ -10,7 +10,7 @@ Portability : POSIX
Individu defintions
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
module
Gargantext.Core.Types.Individu
where
...
...
src/Gargantext/Core/Types/Main.hs
View file @
10c569cf
...
...
@@ -9,7 +9,7 @@ Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE TemplateHaskell #-}
...
...
src/Gargantext/Database/Action/Metrics/Lists.hs
View file @
10c569cf
...
...
@@ -8,7 +8,7 @@ Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
...
...
src/Gargantext/Database/Action/Node.hs
View file @
10c569cf
...
...
@@ -8,7 +8,7 @@ Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
...
...
src/Gargantext/Database/Query/Facet.hs
View file @
10c569cf
...
...
@@ -9,7 +9,7 @@ Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
...
...
@@ -236,14 +236,14 @@ runViewAuthorsDoc cId t o l order = runOpaQuery $ filterWith o l order $ viewAut
-- TODO add delete ?
viewAuthorsDoc
::
ContactId
->
IsTrash
->
NodeType
->
Query
FacetDocRead
viewAuthorsDoc
cId
_
nt
=
proc
()
->
do
(
doc
,(
_
,(
_
,(
_
,
contact
))))
<-
queryAuthorsDoc
-<
()
(
doc
,(
_
,(
_
,(
_
,
contact
'
))))
<-
queryAuthorsDoc
-<
()
{-nn <- queryNodeNodeTable -< ()
restrict -< nn_node1_id nn .== _node_id doc
-- restrict -< nn_delete nn .== (pgBool t)
-}
restrict
-<
_node_id
contact
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
_node_id
contact
'
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
_node_typename
doc
.==
(
pgInt4
$
nodeTypeId
nt
)
returnA
-<
FacetDoc
(
_node_id
doc
)
...
...
@@ -261,14 +261,14 @@ queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNodeNgramsTable queryNgramsT
.==
_nnng_node1_id
nodeNgram
cond23
::
(
NgramsRead
,
(
NodeNodeNgramsRead
,
NodeReadNull
))
->
Column
PGBool
cond23
(
ngrams
,
(
nodeNgram
,
_
))
=
ngrams
^.
ngrams_id
cond23
(
ngrams
'
,
(
nodeNgram
,
_
))
=
ngrams'
^.
ngrams_id
.==
_nnng_ngrams_id
nodeNgram
cond34
::
(
NodeNodeNgramsRead
,
(
NgramsRead
,
(
NodeNodeNgramsReadNull
,
NodeReadNull
)))
->
Column
PGBool
cond34
(
nodeNgram2
,
(
ngrams
,
(
_
,
_
)))
=
ngrams
^.
ngrams_id
.==
_nnng_ngrams_id
nodeNgram2
cond34
(
nodeNgram2
,
(
ngrams
'
,
(
_
,
_
)))
=
ngrams'
^.
ngrams_id
.==
_nnng_ngrams_id
nodeNgram2
cond45
::
(
NodeRead
,
(
NodeNodeNgramsRead
,
(
NgramsReadNull
,
(
NodeNodeNgramsReadNull
,
NodeReadNull
))))
->
Column
PGBool
cond45
(
contact
,
(
nodeNgram2
,
(
_
,
(
_
,
_
))))
=
_node_id
contact
.==
_nnng_node1_id
nodeNgram2
cond45
(
contact
'
,
(
nodeNgram2'
,
(
_
,
(
_
,
_
))))
=
_node_id
contact'
.==
_nnng_node1_id
nodeNgram2'
--}
------------------------------------------------------------------------
...
...
src/Gargantext/Database/Query/Filter.hs
View file @
10c569cf
...
...
@@ -8,7 +8,7 @@ Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
...
...
src/Gargantext/Database/Query/Join.hs
View file @
10c569cf
...
...
@@ -12,7 +12,7 @@ Multiple Join functions with Opaleye.
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
...
...
src/Gargantext/Database/Query/Table/Node.hs
View file @
10c569cf
...
...
@@ -9,7 +9,7 @@ Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
...
...
@@ -47,9 +47,9 @@ queryNodeSearchTable :: Query NodeSearchRead
queryNodeSearchTable
=
queryTable
nodeTableSearch
selectNode
::
Column
PGInt4
->
Query
NodeRead
selectNode
id
=
proc
()
->
do
selectNode
id
'
=
proc
()
->
do
row
<-
queryNodeTable
-<
()
restrict
-<
_node_id
row
.==
id
restrict
-<
_node_id
row
.==
id
'
returnA
-<
row
runGetNodes
::
Query
NodeRead
->
Cmd
err
[
Node
HyperdataAny
]
...
...
@@ -69,7 +69,7 @@ selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
selectNodesWith'
::
ParentId
->
Maybe
NodeType
->
Query
NodeRead
selectNodesWith'
parentId
maybeNodeType
=
proc
()
->
do
node
<-
(
proc
()
->
do
node
'
<-
(
proc
()
->
do
row
@
(
Node
_
_
typeId
_
parentId'
_
_
_
)
<-
queryNodeTable
-<
()
restrict
-<
parentId'
.==
(
pgNodeId
parentId
)
...
...
@@ -79,7 +79,7 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
then
typeId
.==
(
pgInt4
(
typeId'
::
Int
))
else
(
pgBool
True
)
returnA
-<
row
)
-<
()
returnA
-<
node
returnA
-<
node
'
deleteNode
::
NodeId
->
Cmd
err
Int
deleteNode
n
=
mkCmd
$
\
conn
->
...
...
@@ -162,9 +162,9 @@ getNodesWithType :: (HasNodeError err, JSONB a) => NodeType -> proxy a -> Cmd er
getNodesWithType
nt
_
=
runOpaQuery
$
selectNodesWithType
nt
where
selectNodesWithType
::
NodeType
->
Query
NodeRead
selectNodesWithType
nt
=
proc
()
->
do
selectNodesWithType
nt
'
=
proc
()
->
do
row
@
(
Node
_
_
tn
_
_
_
_
_
)
<-
queryNodeTable
-<
()
restrict
-<
tn
.==
(
pgInt4
$
nodeTypeId
nt
)
restrict
-<
tn
.==
(
pgInt4
$
nodeTypeId
nt
'
)
returnA
-<
row
getNodesIdWithType
::
HasNodeError
err
=>
NodeType
->
Cmd
err
[
NodeId
]
...
...
@@ -319,7 +319,7 @@ getOrMkList :: HasNodeError err
getOrMkList
pId
uId
=
maybe
(
mkList'
pId
uId
)
(
pure
.
view
node_id
)
.
headMay
=<<
getListsWithParentId
pId
where
mkList'
pId
uId
=
maybe
(
nodeError
MkNode
)
pure
.
headMay
=<<
insertDefaultNode
NodeList
pId
uId
mkList'
pId
'
uId'
=
maybe
(
nodeError
MkNode
)
pure
.
headMay
=<<
insertDefaultNode
NodeList
pId'
uId'
-- | TODO remove defaultList
defaultList
::
HasNodeError
err
=>
CorpusId
->
Cmd
err
ListId
...
...
src/Gargantext/Database/Query/Table/Node/Children.hs
View file @
10c569cf
...
...
@@ -8,7 +8,7 @@ Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
...
...
src/Gargantext/Database/Query/Table/User.hs
View file @
10c569cf
...
...
@@ -10,7 +10,7 @@ Portability : POSIX
Functions to deal with users, database side.
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE TemplateHaskell #-}
...
...
@@ -62,7 +62,7 @@ updateUserDB :: UserWrite -> Cmd err Int64
updateUserDB
us
=
mkCmd
$
\
c
->
runUpdate_
c
(
updateUserQuery
us
)
where
updateUserQuery
::
UserWrite
->
Update
Int64
updateUserQuery
us
=
Update
updateUserQuery
us
'
=
Update
{
uTable
=
userTable
,
uUpdateWith
=
updateEasy
(
\
(
UserDB
_id
_p
ll
su
un
fn
ln
_em
is
ia
dj
)
->
UserDB
_id
p'
ll
su
un
fn
ln
em'
is
ia
dj
...
...
@@ -71,7 +71,7 @@ updateUserDB us = mkCmd $ \c -> runUpdate_ c (updateUserQuery us)
,
uReturning
=
rCount
}
where
UserDB
_
p'
_
_
un'
_
_
em'
_
_
_
=
us
UserDB
_
p'
_
_
un'
_
_
em'
_
_
_
=
us
'
-----------------------------------------------------------------------
toUserWrite
::
NewUser
HashPassword
->
UserWrite
...
...
@@ -100,9 +100,9 @@ getUsersWithId :: Int -> Cmd err [UserLight]
getUsersWithId
i
=
map
toUserLight
<$>
runOpaQuery
(
selectUsersLightWithId
i
)
where
selectUsersLightWithId
::
Int
->
Query
UserRead
selectUsersLightWithId
i
=
proc
()
->
do
selectUsersLightWithId
i
'
=
proc
()
->
do
row
<-
queryUserTable
-<
()
restrict
-<
user_id
row
.==
pgInt4
i
restrict
-<
user_id
row
.==
pgInt4
i
'
returnA
-<
row
...
...
@@ -143,8 +143,8 @@ getUser u = userLightWithUsername u <$> usersLight
----------------------------------------------------------------------
insertNewUsers
::
[
NewUser
GargPassword
]
->
Cmd
err
Int64
insertNewUsers
newUsers
=
do
users
<-
liftBase
$
mapM
toUserHash
newUsers
insertUsers
$
map
toUserWrite
users
users
'
<-
liftBase
$
mapM
toUserHash
newUsers
insertUsers
$
map
toUserWrite
users
'
----------------------------------------------------------------------
instance
QueryRunnerColumnDefault
PGTimestamptz
(
Maybe
UTCTime
)
where
...
...
src/Gargantext/Database/Schema/Node.hs
View file @
10c569cf
...
...
@@ -8,7 +8,7 @@ Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
...
...
src/Gargantext/Database/Schema/User.hs
View file @
10c569cf
...
...
@@ -10,7 +10,7 @@ Portability : POSIX
Functions to deal with users, database side.
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FunctionalDependencies #-}
...
...
src/Gargantext/Prelude.hs
View file @
10c569cf
...
...
@@ -9,7 +9,7 @@ Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
...
...
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