diff --git a/postgrest.cabal b/postgrest.cabal index a78458fe9..920fce92b 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -26,7 +26,7 @@ executable postgrest , scientific, time , aeson, network >= 2.6 , bytestring, text, split, string-conversions - , stringsearch + , stringsearch, parsec , containers, unordered-containers , optparse-applicative >= 0.9.1 && < 0.10 , regex-base, regex-tdfa @@ -44,6 +44,7 @@ executable postgrest , Config , PgStructure , PgQuery + , PgError , RangeQuery , Middleware hs-source-dirs: src @@ -69,7 +70,7 @@ Test-Suite spec , http-types, scientific, time , bytestring, aeson, network >= 2.6 , text, optparse-applicative - , stringsearch + , stringsearch, parsec , unordered-containers , regex-base , string-conversions diff --git a/src/PgError.hs b/src/PgError.hs new file mode 100644 index 000000000..25d94c16a --- /dev/null +++ b/src/PgError.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE OverloadedStrings #-} + +module PgError (Message(..), parseMessage) where + +import Text.Parsec +import Text.Parsec.Text +import qualified Data.Map as M +import Data.Text + +import Data.String.Conversions (cs) +import Data.CaseInsensitive (CI, mk) + +data Message = Message { + msgStatus :: Maybe Text + , msgCode :: Maybe Text + , msgText :: Maybe Text + , msgHint :: Maybe Text +} deriving (Show) + +parseMessage :: Parser Message +parseMessage = do + ps <- sepBy valPair (char ';' >> optional (char ' ')) + let m = M.fromList ps + return $ Message + (M.lookup "status" m) + (M.lookup "code" m) + (M.lookup "message" m) + (M.lookup "hint" m) + +valPair :: Parser (CI Text, Text) +valPair = do + name <- many1 letter + _ <- char ':' + optional $ char ' ' + _ <- char '"' + val <- many1 (noneOf "\"") + _ <- char '"' + return (mk (cs name), cs val)