1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
| module Repos.Utils
( CanDB(..)
, DbR
) where
import Control.Monad.IO.Class (liftIO, MonadIO)
import Types
import Database.SQLite.Simple hiding (query, execute)
import qualified Database.SQLite.Simple as SQL
import Control.Exception (try)
import Control.Exception.Base (throw)
class (HasEnv m, MonadIO m) => CanDB m where
query :: (ToRow q, FromRow r) => Query -> q -> m [r]
query q params = do
conn <- fmap (.db) getEnv
liftIO $ SQL.query conn q params
execute :: (ToRow q) => Query -> q -> m DbR
execute q params = do
conn <- fmap (.db) getEnv
result <- liftIO $ try $ SQL.execute conn q params
case result of
Right _ -> return Nothing
Left e -> return $ Just $ handleSQLError e
handleSQLError :: SQLError -> ConstraintNotSatisfied
handleSQLError SQLError{ sqlError = ErrorConstraint } = ConstraintNotSatisfied "dd"
handleSQLError e = throw e
newtype ConstraintNotSatisfied = ConstraintNotSatisfied String
deriving (Show, Eq)
type DbR = Maybe ConstraintNotSatisfied
instance CanDB App
instance CanDB Handler
instance CanDB HandlerAuth
|