@@ -1,6 +1,11 @@
1−{-# LANGUAGE OverloadedStrings #-}
21{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE OverloadedStrings #-}
33
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+----------------------------------------------------------
49module Database.PostgreSQL.Simple.Errors
510 ( ConstraintViolation(..)
611 , constraintViolation
@@ -11,28 +16,44 @@ module Database.PostgreSQL.Simple.Errors
1116
1217import Prelude hiding (catch)
1318
14−import Control.Applicative
15−import Control.Exception
16−import Control.Monad.IO.Class
19+import Control.Applicative
20+import Control.Exception
1721
18−import Data.Attoparsec.Char8
19−import Data.ByteString(ByteString)
20−import Data.Typeable
22+import Data.Attoparsec.Char8
23+import Data.ByteString (ByteString)
24+import Data.Typeable
2125
22−import Database.PostgreSQL.Simple.Internal
26+import Database.PostgreSQL.Simple.Internal
2327
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"`
2439
2540data ConstraintViolation
2641 = NotNullViolation ByteString
42+ -- ^ The field is a column name
2743 | ForeignKeyViolation ByteString ByteString
44+ -- ^ Table name and name of violated constraint
2845 | UniqueViolation ByteString
46+ -- ^ Name of violated constraint
2947 | CheckViolation ByteString ByteString
48+ -- ^ Relation name (usually table), constraint name
3049 deriving (Show, Eq, Ord, Typeable)
3150
51+-- Default instance should be enough
52+instance Exception ConstraintViolation
53+
3254
3355-- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and
34−-- succeedes only if able to parse sqlErrorMsg. May depend on postgres language
35−-- settings.
56+-- succeedes only if able to parse sqlErrorMsg.
3657--
3758-- > createUser = catchJust constraintViolation catcher $ execute conn ...
3859-- > where
@@ -41,10 +62,10 @@ data ConstraintViolation
4162constraintViolation :: SqlError -> Maybe ConstraintViolation
4263constraintViolation e =
4364 case sqlState e of
44− "23502" -> parseMaybe parseQ1 msg >>= Just . NotNullViolation
45− "23503" -> parseMaybe parseQ2 msg >>= Just . uncurry ForeignKeyViolation
46− "23505" -> parseMaybe parseQ1 msg >>= Just . UniqueViolation
47− "23514" -> parseMaybe parseQ2 msg >>= Just . uncurry CheckViolation
65+ "23502" -> NotNullViolation <$> parseMaybe parseQ1 msg
66+ "23503" -> uncurry ForeignKeyViolation <$> parseMaybe parseQ2 msg
67+ "23505" -> UniqueViolation <$> parseMaybe parseQ1 msg
68+ "23514" -> uncurry CheckViolation <$> parseMaybe parseQ2 msg
4869 _ -> Nothing
4970 where msg = sqlErrorMsg e
5071
@@ -60,7 +81,7 @@ constraintViolationE :: SqlError -> Maybe (SqlError, ConstraintViolation)
6081constraintViolationE e = fmap ((,) e) $ constraintViolation e
6182
6283-- | 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
6485--
6586-- > createUser = catchViolation catcher $ execute conn ...
6687-- > where
@@ -76,7 +97,7 @@ scanTillQuote :: Parser ByteString
7697scanTillQuote = scan False go
7798 where go True _ = Just False -- escaped character
7899 go False '"' = Nothing -- end parse
79− go False '\\' = Just True -- nest one is escaped
100+ go False '\\' = Just True -- next one is escaped
80101 go _ _ = Just False
81102
82103parseQ1 :: Parser ByteString