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