Commit 10c569cf authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] removing no warnings for shadowing

parent dacf2fa9
Pipeline #1280 failed with stage
......@@ -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
......@@ -10,7 +10,7 @@ Portability : POSIX
Count API part of Gargantext.
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
......
......@@ -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'))
......@@ -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)
......
......@@ -10,7 +10,7 @@ Portability : POSIX
Individu defintions
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
module Gargantext.Core.Types.Individu
where
......
......@@ -9,7 +9,7 @@ Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE TemplateHaskell #-}
......
......@@ -8,7 +8,7 @@ Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
......
......@@ -8,7 +8,7 @@ Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
......
......@@ -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'
--}
------------------------------------------------------------------------
......
......@@ -8,7 +8,7 @@ Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
......
......@@ -12,7 +12,7 @@ Multiple Join functions with Opaleye.
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
......
......@@ -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
......
......@@ -8,7 +8,7 @@ Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
......
......@@ -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
......
......@@ -8,7 +8,7 @@ Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
......
......@@ -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 #-}
......
......@@ -9,7 +9,7 @@ Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment