git.iko.soy/typeable/postgresql-simple
on master help sign in
Exception instance. Docs and code cleanup
e16ae0eLeonid Onokhov
src/Database/PostgreSQL/Simple/Errors.hs+37−16
compare with master
unifiedsplit
@@ -1,6 +1,11 @@
1−{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE DeriveDataTypeable #-}
1{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE OverloadedStrings #-}
3
3
4+-- | Module for parsing errors from posgresql error messages.
5+-- Currently in only parses integrity violation errors (class 23).
6+--
7+-- /Note: Success of parsing may depend on language settings./
8+----------------------------------------------------------
4module Database.PostgreSQL.Simple.Errors
9module Database.PostgreSQL.Simple.Errors
5 ( ConstraintViolation(..)
10 ( ConstraintViolation(..)
6 , constraintViolation
11 , constraintViolation
@@ -11,28 +16,44 @@ module Database.PostgreSQL.Simple.Errors
11
16
12import Prelude hiding (catch)
17import Prelude hiding (catch)
13
18
14−import Control.Applicative
19+import Control.Applicative
15−import Control.Exception
20+import Control.Exception
16−import Control.Monad.IO.Class
17
21
18−import Data.Attoparsec.Char8
22+import Data.Attoparsec.Char8
19−import Data.ByteString(ByteString)
23+import Data.ByteString (ByteString)
20−import Data.Typeable
24+import Data.Typeable
21
25
22−import Database.PostgreSQL.Simple.Internal
26+import Database.PostgreSQL.Simple.Internal
23
27
28+-- Examples of parsed error messages
29+--
30+-- `ERROR: new row for relation "users" violates check
31+-- constraint "user_kind_check"`
32+--
33+-- `ERROR: insert or update on table "user_group_map" violates foreign key
34+-- constraint "user_id"`
35+--
36+-- `ERROR: null value in column "login" violates not-null constraint`
37+--
38+-- `ERROR: duplicate key value violates unique constraint "users_login_key"`
24
39
25data ConstraintViolation
40data ConstraintViolation
26 = NotNullViolation ByteString
41 = NotNullViolation ByteString
42+ -- ^ The field is a column name
27 | ForeignKeyViolation ByteString ByteString
43 | ForeignKeyViolation ByteString ByteString
44+ -- ^ Table name and name of violated constraint
28 | UniqueViolation ByteString
45 | UniqueViolation ByteString
46+ -- ^ Name of violated constraint
29 | CheckViolation ByteString ByteString
47 | CheckViolation ByteString ByteString
48+ -- ^ Relation name (usually table), constraint name
30 deriving (Show, Eq, Ord, Typeable)
49 deriving (Show, Eq, Ord, Typeable)
31
50
51+-- Default instance should be enough
52+instance Exception ConstraintViolation
53+
32
54
33-- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and
55-- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and
34−-- succeedes only if able to parse sqlErrorMsg. May depend on postgres language
56+-- succeedes only if able to parse sqlErrorMsg.
35−-- settings.
36--
57--
37-- > createUser = catchJust constraintViolation catcher $ execute conn ...
58-- > createUser = catchJust constraintViolation catcher $ execute conn ...
38-- > where
59-- > where
@@ -41,10 +62,10 @@ data ConstraintViolation
41constraintViolation :: SqlError -> Maybe ConstraintViolation
62constraintViolation :: SqlError -> Maybe ConstraintViolation
42constraintViolation e =
63constraintViolation e =
43 case sqlState e of
64 case sqlState e of
44− "23502" -> parseMaybe parseQ1 msg >>= Just . NotNullViolation
65+ "23502" -> NotNullViolation <$> parseMaybe parseQ1 msg
45− "23503" -> parseMaybe parseQ2 msg >>= Just . uncurry ForeignKeyViolation
66+ "23503" -> uncurry ForeignKeyViolation <$> parseMaybe parseQ2 msg
46− "23505" -> parseMaybe parseQ1 msg >>= Just . UniqueViolation
67+ "23505" -> UniqueViolation <$> parseMaybe parseQ1 msg
47− "23514" -> parseMaybe parseQ2 msg >>= Just . uncurry CheckViolation
68+ "23514" -> uncurry CheckViolation <$> parseMaybe parseQ2 msg
48 _ -> Nothing
69 _ -> Nothing
49 where msg = sqlErrorMsg e
70 where msg = sqlErrorMsg e
50
71
@@ -60,7 +81,7 @@ constraintViolationE :: SqlError -> Maybe (SqlError, ConstraintViolation)
60constraintViolationE e = fmap ((,) e) $ constraintViolation e
81constraintViolationE e = fmap ((,) e) $ constraintViolation e
61
82
62-- | Catches SqlError, tries to convert to ConstraintViolation, re-throws
83-- | Catches SqlError, tries to convert to ConstraintViolation, re-throws
63−-- on fail. Unlike catchJust, provides alternative interface to catchJust
84+-- on fail. Provides alternative interface to catchJust
64--
85--
65-- > createUser = catchViolation catcher $ execute conn ...
86-- > createUser = catchViolation catcher $ execute conn ...
66-- > where
87-- > where
@@ -76,7 +97,7 @@ scanTillQuote :: Parser ByteString
76scanTillQuote = scan False go
97scanTillQuote = scan False go
77 where go True _ = Just False -- escaped character
98 where go True _ = Just False -- escaped character
78 go False '"' = Nothing -- end parse
99 go False '"' = Nothing -- end parse
79− go False '\\' = Just True -- nest one is escaped
100+ go False '\\' = Just True -- next one is escaped
80 go _ _ = Just False
101 go _ _ = Just False
81
102
82parseQ1 :: Parser ByteString
103parseQ1 :: Parser ByteString