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
141
Issues
141
List
Board
Labels
Milestones
Merge Requests
5
Merge Requests
5
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