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
199
Issues
199
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
26ba82d8
Unverified
Commit
26ba82d8
authored
Mar 26, 2019
by
Nicolas Pouillard
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Fix runPGSQuery exception handling
parent
72ba377f
Pipeline
#306
failed with stage
Changes
6
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
7 additions
and
18 deletions
+7
-18
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+1
-2
Node.hs
src/Gargantext/API/Node.hs
+0
-1
Settings.hs
src/Gargantext/API/Settings.hs
+2
-7
Flow.hs
src/Gargantext/Database/Flow.hs
+0
-1
Metrics.hs
src/Gargantext/Database/Metrics.hs
+0
-1
Utils.hs
src/Gargantext/Database/Utils.hs
+4
-6
No files found.
src/Gargantext/API/Ngrams.hs
View file @
26ba82d8
...
@@ -35,7 +35,6 @@ module Gargantext.API.Ngrams
...
@@ -35,7 +35,6 @@ module Gargantext.API.Ngrams
where
where
-- import Debug.Trace (trace)
-- import Debug.Trace (trace)
import
Control.Exception
(
Exception
)
import
Prelude
(
Enum
,
Bounded
,
Semigroup
(
..
),
minBound
,
maxBound
{-, round-}
,
error
)
import
Prelude
(
Enum
,
Bounded
,
Semigroup
(
..
),
minBound
,
maxBound
{-, round-}
,
error
)
-- import Gargantext.Database.Schema.User (UserId)
-- import Gargantext.Database.Schema.User (UserId)
import
Data.Functor
((
$>
))
import
Data.Functor
((
$>
))
...
@@ -894,7 +893,7 @@ type MaxSize = Int
...
@@ -894,7 +893,7 @@ type MaxSize = Int
-- TODO: polymorphic for Annuaire or Corpus or ...
-- TODO: polymorphic for Annuaire or Corpus or ...
-- | Table of Ngrams is a ListNgrams formatted (sorted and/or cut).
-- | Table of Ngrams is a ListNgrams formatted (sorted and/or cut).
-- TODO: should take only one ListId
-- TODO: should take only one ListId
getTableNgrams
::
(
RepoCmdM
env
err
m
,
HasNodeError
err
,
HasConnection
env
,
Exception
err
)
getTableNgrams
::
(
RepoCmdM
env
err
m
,
HasNodeError
err
,
HasConnection
env
)
=>
CorpusId
->
TabType
=>
CorpusId
->
TabType
->
ListId
->
Limit
->
Maybe
Offset
->
ListId
->
Limit
->
Maybe
Offset
->
Maybe
ListType
->
Maybe
ListType
...
...
src/Gargantext/API/Node.hs
View file @
26ba82d8
...
@@ -15,7 +15,6 @@ Node API
...
@@ -15,7 +15,6 @@ Node API
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RankNTypes #-}
...
...
src/Gargantext/API/Settings.hs
View file @
26ba82d8
...
@@ -8,14 +8,12 @@ Stability : experimental
...
@@ -8,14 +8,12 @@ Stability : experimental
Portability : POSIX
Portability : POSIX
-}
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RankNTypes #-}
...
@@ -25,7 +23,6 @@ Portability : POSIX
...
@@ -25,7 +23,6 @@ Portability : POSIX
module
Gargantext.API.Settings
module
Gargantext.API.Settings
where
where
import
Control.Exception
(
Exception
)
import
System.Directory
import
System.Directory
import
System.Log.FastLogger
import
System.Log.FastLogger
import
GHC.Enum
import
GHC.Enum
...
@@ -276,7 +273,7 @@ withDevEnv k = do
...
@@ -276,7 +273,7 @@ withDevEnv k = do
k
env
`
finally
`
unlockFile
(
env
^.
repoEnv
.
renv_lock
)
k
env
`
finally
`
unlockFile
(
env
^.
repoEnv
.
renv_lock
)
-- | Run Cmd Sugar for the Repl (GHCI)
-- | Run Cmd Sugar for the Repl (GHCI)
runCmdRepl
::
(
Show
err
,
Exception
err
)
=>
Cmd'
DevEnv
err
a
->
IO
a
runCmdRepl
::
Show
err
=>
Cmd'
DevEnv
err
a
->
IO
a
runCmdRepl
f
=
withDevEnv
$
\
env
->
runCmdDev
env
f
runCmdRepl
f
=
withDevEnv
$
\
env
->
runCmdDev
env
f
runCmdReplServantErr
::
Cmd'
DevEnv
ServantErr
a
->
IO
a
runCmdReplServantErr
::
Cmd'
DevEnv
ServantErr
a
->
IO
a
...
@@ -290,14 +287,12 @@ newDevEnv = newDevEnvWith "gargantext.ini"
...
@@ -290,14 +287,12 @@ newDevEnv = newDevEnvWith "gargantext.ini"
-- the command.
-- the command.
-- This function is constrained to the DevEnv rather than
-- This function is constrained to the DevEnv rather than
-- using HasConnection and HasRepoVar.
-- using HasConnection and HasRepoVar.
runCmdDev
::
(
Show
err
,
Exception
err
)
=>
DevEnv
->
Cmd'
DevEnv
err
a
->
IO
a
runCmdDev
::
Show
err
=>
DevEnv
->
Cmd'
DevEnv
err
a
->
IO
a
runCmdDev
env
f
=
runCmdDev
env
f
=
(
either
(
fail
.
show
)
pure
=<<
runCmd
env
f
)
(
either
(
fail
.
show
)
pure
=<<
runCmd
env
f
)
`
finally
`
`
finally
`
runReaderT
saveRepo
env
runReaderT
saveRepo
env
instance
Exception
()
-- Use only for dev
-- Use only for dev
runCmdDevNoErr
::
DevEnv
->
Cmd'
DevEnv
()
a
->
IO
a
runCmdDevNoErr
::
DevEnv
->
Cmd'
DevEnv
()
a
->
IO
a
runCmdDevNoErr
=
runCmdDev
runCmdDevNoErr
=
runCmdDev
...
...
src/Gargantext/Database/Flow.hs
View file @
26ba82d8
...
@@ -20,7 +20,6 @@ Portability : POSIX
...
@@ -20,7 +20,6 @@ Portability : POSIX
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}
module
Gargantext.Database.Flow
-- (flowDatabase, ngrams2list)
module
Gargantext.Database.Flow
-- (flowDatabase, ngrams2list)
where
where
...
...
src/Gargantext/Database/Metrics.hs
View file @
26ba82d8
...
@@ -13,7 +13,6 @@ Node API
...
@@ -13,7 +13,6 @@ Node API
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}
module
Gargantext.Database.Metrics
module
Gargantext.Database.Metrics
where
where
...
...
src/Gargantext/Database/Utils.hs
View file @
26ba82d8
...
@@ -56,13 +56,11 @@ type CmdM' env err m =
...
@@ -56,13 +56,11 @@ type CmdM' env err m =
(
MonadReader
env
m
(
MonadReader
env
m
,
MonadError
err
m
,
MonadError
err
m
,
MonadIO
m
,
MonadIO
m
,
Exception
err
)
)
type
CmdM
env
err
m
=
type
CmdM
env
err
m
=
(
CmdM'
env
err
m
(
CmdM'
env
err
m
,
HasConnection
env
,
HasConnection
env
,
Exception
err
)
)
type
Cmd'
env
err
a
=
forall
m
.
CmdM'
env
err
m
=>
m
a
type
Cmd'
env
err
a
=
forall
m
.
CmdM'
env
err
m
=>
m
a
...
@@ -75,7 +73,7 @@ mkCmd k = do
...
@@ -75,7 +73,7 @@ mkCmd k = do
conn
<-
view
connection
conn
<-
view
connection
liftIO
$
k
conn
liftIO
$
k
conn
runCmd
::
(
HasConnection
env
,
Exception
err
)
=>
env
runCmd
::
(
HasConnection
env
)
=>
env
->
Cmd'
env
err
a
->
Cmd'
env
err
a
->
IO
(
Either
err
a
)
->
IO
(
Either
err
a
)
runCmd
env
m
=
runExceptT
$
runReaderT
m
env
runCmd
env
m
=
runExceptT
$
runReaderT
m
env
...
@@ -91,14 +89,14 @@ runPGSQuery' :: (PGS.ToRow a, PGS.FromRow b) => PGS.Query -> a -> Cmd err [b]
...
@@ -91,14 +89,14 @@ runPGSQuery' :: (PGS.ToRow a, PGS.FromRow b) => PGS.Query -> a -> Cmd err [b]
runPGSQuery'
q
a
=
mkCmd
$
\
conn
->
PGS
.
query
conn
q
a
runPGSQuery'
q
a
=
mkCmd
$
\
conn
->
PGS
.
query
conn
q
a
runPGSQuery
::
(
MonadError
err
m
,
MonadReader
env
m
,
runPGSQuery
::
(
MonadError
err
m
,
MonadReader
env
m
,
PGS
.
FromRow
r
,
PGS
.
ToRow
q
,
MonadIO
m
,
HasConnection
env
,
Exception
err
)
PGS
.
FromRow
r
,
PGS
.
ToRow
q
,
MonadIO
m
,
HasConnection
env
)
=>
PGS
.
Query
->
q
->
m
[
r
]
=>
PGS
.
Query
->
q
->
m
[
r
]
runPGSQuery
q
a
=
mkCmd
$
\
conn
->
catch
(
PGS
.
query
conn
q
a
)
(
printError
conn
)
runPGSQuery
q
a
=
mkCmd
$
\
conn
->
catch
(
PGS
.
query
conn
q
a
)
(
printError
conn
)
where
where
printError
c
(
SomeException
e
)
=
do
printError
c
(
SomeException
e
)
=
do
q'
<-
(
PGS
.
formatQuery
c
q
a
::
IO
DB
.
ByteString
)
q'
<-
PGS
.
formatQuery
c
q
a
hPutStrLn
stderr
q'
hPutStrLn
stderr
q'
throw
e
throw
(
SomeException
e
)
execPGSQuery
::
PGS
.
ToRow
a
=>
PGS
.
Query
->
a
->
Cmd
err
Int64
execPGSQuery
::
PGS
.
ToRow
a
=>
PGS
.
Query
->
a
->
Cmd
err
Int64
...
...
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