@@ -1,5 +1,5 @@
1{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, FlexibleInstances #-}
1{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, FlexibleInstances #-}
2−{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}
2+{-# LANGUAGE PatternGuards, ScopedTypeVariables, OverloadedStrings #-}
3------------------------------------------------------------------------------
3------------------------------------------------------------------------------
5-- Module: Database.PostgreSQL.Simple.QueryResults
5-- Module: Database.PostgreSQL.Simple.QueryResults
@@ -96,13 +96,15 @@ class Result a where
96instance (Result a) => Result (Maybe a) where
96instance (Result a) => Result (Maybe a) where
97 convert _ Nothing = pure Nothing
97 convert _ Nothing = pure Nothing
98 convert f bs = Just <$> convert f bs
98 convert f bs = Just <$> convert f bs
100instance Result Bool where
100instance Result Bool where
101− convert = atto ok8 ((/=(0::Int)) <$> decimal)
101+ convert f bs
102+ | typeOid f /= builtin2oid Bool = returnError Incompatible f ""
103+ | bs == Nothing = returnError UnexpectedNull f ""
104+ | bs == Just "t" = pure True
105+ | bs == Just "f" = pure False
106+ | otherwise = returnError ConversionFailed f ""
103−instance Result Int8 where
104− convert = atto ok8 $ signed decimal
106instance Result Int16 where
108instance Result Int16 where
107 convert = atto ok16 $ signed decimal
109 convert = atto ok16 $ signed decimal
@@ -117,22 +119,7 @@ instance Result Int64 where
118instance Result Integer where
120instance Result Integer where
119 convert = atto ok64 $ signed decimal
121 convert = atto ok64 $ signed decimal
121−instance Result Word8 where
122− convert = atto ok8 decimal
124−instance Result Word16 where
125− convert = atto ok16 decimal
127−instance Result Word32 where
128− convert = atto ok32 decimal
130−instance Result Word where
131− convert = atto okWord decimal
133−instance Result Word64 where
134− convert = atto ok64 decimal
137instance Result Float where
124instance Result Float where
138 convert = atto ok (realToFrac <$> double)
125 convert = atto ok (realToFrac <$> double)
@@ -176,7 +163,7 @@ instance Result UTCTime where
176 convert f = doConvert f ok $ \bs ->
163 convert f = doConvert f ok $ \bs ->
177 case parseTime defaultTimeLocale "%F %T%Q%z" (B8.unpack bs ++ "00") of
164 case parseTime defaultTimeLocale "%F %T%Q%z" (B8.unpack bs ++ "00") of
178 Just t -> Right t
165 Just t -> Right t
179− Nothing -> conversionFailed f "UTCTime" "could not parse"
166+ Nothing -> returnError ConversionFailed f "could not parse"
180 where ok = mkCompats [TimestampWithTimeZone]
167 where ok = mkCompats [TimestampWithTimeZone]
182instance Result Day where
169instance Result Day where
@@ -234,24 +221,26 @@ doConvert :: forall a . (Typeable a)
234doConvert f types cvt (Just bs)
221doConvert f types cvt (Just bs)
235 | Just typ <- oid2builtin (typeOid f)
222 | Just typ <- oid2builtin (typeOid f)
236 , mkCompat typ `compat` types = cvt bs
223 , mkCompat typ `compat` types = cvt bs
237− | otherwise = incompatible f (typeOf (undefined::a)) "types incompatible"
224+ | otherwise = returnError Incompatible f "types incompatible"
238−doConvert f _ cvt _ = left $ UnexpectedNull (B.unpack (typename f))
225+doConvert f _ _ _ = returnError UnexpectedNull f ""
239− (show (typeOf (undefined::a))) ""
241−incompatible :: Field -> TypeRep -> String -> Either SomeException a
242−incompatible f r = left . Incompatible (B.unpack (typename f)) (show r)
228+returnError :: forall a err . (Typeable a, Exception err)
229+ => (String -> String -> String -> err)
244−conversionFailed :: Field -> String -> String -> Either SomeException a
230+ -> Field -> String -> Either SomeException a
245−conversionFailed f s = left . ConversionFailed (B.unpack (typename f)) s
231+returnError mkErr f = left . mkErr (B.unpack (typename f))
232+ (show (typeOf (undefined :: a)))
234+atto :: forall a. (Typeable a)
247−atto :: (Typeable a) => Compat -> Parser a -> Field -> Maybe ByteString -> Either SomeException a
235+ => Compat -> Parser a -> Field -> Maybe ByteString
236+ -> Either SomeException a
248−atto types p0 f dat = doConvert f types (go undefined p0) dat
237+atto types p0 f dat = doConvert f types (go p0) dat
250− go :: (Typeable a) => a -> Parser a -> ByteString -> Either SomeException a
239+ go :: Parser a -> ByteString -> Either SomeException a
251− go dummy p s =
240+ go p s =
252 case parseOnly p s of
241 case parseOnly p s of
253− Left err -> conversionFailed f (show (typeOf dummy)) err
242+ Left err -> returnError ConversionFailed f err
254− Right v -> Right v
243+ Right v -> Right v
256instance Result RawResult where
245instance Result RawResult where
257 convert field rawData = Right (RawResult field rawData)
246 convert field rawData = Right (RawResult field rawData)