@@ -1,7 +1,7 @@
11{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}
22{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
33{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}
4−{-# LANGUAGE RecordWildCards #-}
4+{-# LANGUAGE RecordWildCards, TemplateHaskell #-}
55
66{- |
77Module: Database.PostgreSQL.Simple.FromField
@@ -93,24 +93,22 @@ import Control.Applicative
9393 ( Applicative, (<|>), (<$>), pure )
9494import Control.Exception (Exception)
9595import Data.Attoparsec.Char8 hiding (Result)
96−import Data.Bits ((.&.), (.|.), shiftL)
9796import Data.ByteString (ByteString)
9897import qualified Data.ByteString.Char8 as B
9998import Data.Int (Int16, Int32, Int64)
100−import Data.List (foldl')
10199import Data.Ratio (Ratio)
102100import Data.Time ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay )
103101import Data.Typeable (Typeable, typeOf)
104102import Data.Vector (Vector)
105103import qualified Data.Vector as V
106−import Data.Word (Word64)
107104import Database.PostgreSQL.Simple.Internal
108−import Database.PostgreSQL.Simple.BuiltinTypes
105+-- import Database.PostgreSQL.Simple.BuiltinTypes
109106import Database.PostgreSQL.Simple.Compat
110107import Database.PostgreSQL.Simple.Ok
111108import Database.PostgreSQL.Simple.Types (Binary(..), Null(..))
112−import Database.PostgreSQL.Simple.TypeInfo as TypeInfo
113−import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TypeInfo
109+import Database.PostgreSQL.Simple.TypeInfo as TI
110+import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI
111+import Database.PostgreSQL.Simple.TypeInfo.Macro as TI
114112import Database.PostgreSQL.Simple.Time
115113import Database.PostgreSQL.Simple.Arrays as Arrays
116114import qualified Database.PostgreSQL.LibPQ as PQ
@@ -243,7 +241,7 @@ instance FromField Null where
243241-- | bool
244242instance FromField Bool where
245243 fromField f bs
246− | typeOid f /= typoid (TypeInfo.bool) = returnError Incompatible f ""
244+ | typeOid f /= typoid (TI.bool) = returnError Incompatible f ""
247245 | bs == Nothing = returnError UnexpectedNull f ""
248246 | bs == Just "t" = pure True
249247 | bs == Just "f" = pure False
@@ -252,7 +250,7 @@ instance FromField Bool where
252250-- | \"char\"
253251instance FromField Char where
254252 fromField f bs =
255− if typeOid f /= typoid (TypeInfo.char)
253+ if typeOid f /= typoid (TI.char)
256254 then returnError Incompatible f ""
257255 else case bs of
258256 Nothing -> returnError UnexpectedNull f ""
@@ -289,30 +287,30 @@ instance FromField Integer where
289287-- | int2, float4
290288instance FromField Float where
291289 fromField = atto ok (realToFrac <$> double)
292− where ok = mkCompats [Float4,Int2]
290+ where ok = $(mkCompats [TI.float4,TI.int2])
293291
294292-- | int2, int4, float4, float8
295293instance FromField Double where
296294 fromField = atto ok double
297− where ok = mkCompats [Float4,Float8,Int2,Int4]
295+ where ok = $(mkCompats [TI.float4,TI.float8,TI.int2,TI.int4])
298296
299297-- | int2, int4, float4, float8, numeric
300298instance FromField (Ratio Integer) where
301299 fromField = atto ok rational
302− where ok = mkCompats [Float4,Float8,Int2,Int4,Numeric]
300+ where ok = $(mkCompats [TI.float4,TI.float8,TI.int2,TI.int4,TI.numeric])
303301
304302unBinary :: Binary t -> t
305303unBinary (Binary x) = x
306304
307305-- | bytea, name, text, \"char\", bpchar, varchar, unknown
308306instance FromField SB.ByteString where
309− fromField f dat = if typeOid f == typoid TypeInfo.bytea
307+ fromField f dat = if typeOid f == typoid TI.bytea
310308 then unBinary <$> fromField f dat
311309 else doFromField f okText' (pure . B.copy) dat
312310
313311-- | oid
314312instance FromField PQ.Oid where
315− fromField f dat = PQ.Oid <$> atto (mkCompat Oid) decimal f dat
313+ fromField f dat = PQ.Oid <$> atto $(mkCompat TI.oid) decimal f dat
316314
317315-- | bytea, name, text, \"char\", bpchar, varchar, unknown
318316instance FromField LB.ByteString where
@@ -349,39 +347,39 @@ instance FromField [Char] where
349347
350348-- | timestamptz
351349instance FromField UTCTime where
352− fromField = ff TypeInfo.timestamptz "UTCTime" parseUTCTime
350+ fromField = ff TI.timestamptz "UTCTime" parseUTCTime
353351
354352-- | timestamptz
355353instance FromField ZonedTime where
356− fromField = ff TypeInfo.timestamptz "ZonedTime" parseZonedTime
354+ fromField = ff TI.timestamptz "ZonedTime" parseZonedTime
357355
358356-- | timestamp
359357instance FromField LocalTime where
360− fromField = ff TypeInfo.timestamp "LocalTime" parseLocalTime
358+ fromField = ff TI.timestamp "LocalTime" parseLocalTime
361359
362360-- | date
363361instance FromField Day where
364− fromField = ff TypeInfo.date "Day" parseDay
362+ fromField = ff TI.date "Day" parseDay
365363
366364-- | time
367365instance FromField TimeOfDay where
368− fromField = ff TypeInfo.time "TimeOfDay" parseTimeOfDay
366+ fromField = ff TI.time "TimeOfDay" parseTimeOfDay
369367
370368-- | timestamptz
371369instance FromField UTCTimestamp where
372− fromField = ff TypeInfo.timestamptz "UTCTimestamp" parseUTCTimestamp
370+ fromField = ff TI.timestamptz "UTCTimestamp" parseUTCTimestamp
373371
374372-- | timestamptz
375373instance FromField ZonedTimestamp where
376− fromField = ff TypeInfo.timestamptz "ZonedTimestamp" parseZonedTimestamp
374+ fromField = ff TI.timestamptz "ZonedTimestamp" parseZonedTimestamp
377375
378376-- | timestamp
379377instance FromField LocalTimestamp where
380− fromField = ff TypeInfo.timestamp "LocalTimestamp" parseLocalTimestamp
378+ fromField = ff TI.timestamp "LocalTimestamp" parseLocalTimestamp
381379
382380-- | date
383381instance FromField Date where
384− fromField = ff TypeInfo.date "Date" parseDate
382+ fromField = ff TI.date "Date" parseDate
385383
386384ff :: TypeInfo -> String -> (B8.ByteString -> Either String a)
387385 -> Field -> Maybe B8.ByteString -> Conversion a
@@ -415,7 +413,7 @@ instance (FromField a, Typeable a) => FromField (Vector a) where
415413 fromField f mdat = do
416414 info <- typeInfo f
417415 case info of
418− TypeInfo.Array{} ->
416+ TI.Array{} ->
419417 case mdat of
420418 Nothing -> returnError UnexpectedNull f ""
421419 Just dat -> do
@@ -434,8 +432,9 @@ fromArray typeInfo f = sequence . (parseIt <$>) <$> array delim
434432 where f' | Arrays.Array _ <- item = f
435433 | otherwise = fElem
436434
437−newtype Compat = Compat Word64
435+type Compat = PQ.Oid -> Bool
438436
437+{-
439438mkCompats :: [BuiltinType] -> Compat
440439mkCompats = foldl' f (Compat 0) . map mkCompat
441440 where f (Compat a) (Compat b) = Compat (a .|. b)
@@ -445,14 +444,17 @@ mkCompat = Compat . shiftL 1 . fromEnum
445444
446445compat :: Compat -> Compat -> Bool
447446compat (Compat a) (Compat b) = a .&. b /= 0
447+-}
448448
449449okText, okText', okBinary, ok16, ok32, ok64, okInt :: Compat
450−okText = mkCompats [Name,Text,Char,BpChar,VarChar]
451−okText' = mkCompats [Name,Text,Char,BpChar,VarChar,Unknown]
452−okBinary = mkCompats [ByteA]
453−ok16 = mkCompats [Int2]
454−ok32 = mkCompats [Int2,Int4]
455−ok64 = mkCompats [Int2,Int4,Int8]
450+okText = $( mkCompats [ TI.name, TI.text, TI.char,
451+ TI.bpchar, TI.varchar ] )
452+okText' = $( mkCompats [ TI.name, TI.text, TI.char,
453+ TI.bpchar, TI.varchar, TI.unknown ] )
454+okBinary = $( mkCompat TI.bytea )
455+ok16 = $( mkCompat TI.int2 )
456+ok32 = $( mkCompats [TI.int2,TI.int4] )
457+ok64 = $( mkCompats [TI.int2,TI.int4,TI.int8] )
456458#if WORD_SIZE_IN_BITS < 64
457459okInt = ok32
458460#else
@@ -462,9 +464,8 @@ okInt = ok64
462464doFromField :: forall a . (Typeable a)
463465 => Field -> Compat -> (ByteString -> Conversion a)
464466 -> Maybe ByteString -> Conversion a
465−doFromField f types cvt (Just bs)
466− | Just typ <- oid2builtin (typeOid f)
467− , mkCompat typ `compat` types = cvt bs
467+doFromField f isCompat cvt (Just bs)
468+ | isCompat (typeOid f) = cvt bs
468469 | otherwise = returnError Incompatible f "types incompatible"
469470doFromField f _ _ _ = returnError UnexpectedNull f ""
470471