postgresql-simple 0.3.5.0 → 0.3.6.0
raw patch · 7 files changed
+117/−61 lines, 7 files
Files
- CONTRIBUTORS +1/−0
- postgresql-simple.cabal +3/−2
- src/Database/PostgreSQL/Simple.hs +1/−1
- src/Database/PostgreSQL/Simple/BuiltinTypes.hs +9/−0
- src/Database/PostgreSQL/Simple/FromField.hs +46/−56
- src/Database/PostgreSQL/Simple/TypeInfo/Macro.hs +44/−0
- src/Database/PostgreSQL/Simple/TypeInfo/Static.hs +13/−2
CONTRIBUTORS view
@@ -12,3 +12,4 @@ Simon Meier <iridcode@gmail.com> Alexey Uimanov <s9gf4ult@gmail.com> Doug Beardsley <mightybyte@gmail.com>+Manuel Gómez <targen@gmail.com>
postgresql-simple.cabal view
@@ -1,5 +1,5 @@ Name: postgresql-simple-Version: 0.3.5.0+Version: 0.3.6.0 Synopsis: Mid-Level PostgreSQL client library Description: Mid-Level PostgreSQL client library, forked from mysql-simple.@@ -38,6 +38,7 @@ Database.PostgreSQL.Simple.ToRow Database.PostgreSQL.Simple.Transaction Database.PostgreSQL.Simple.TypeInfo+ Database.PostgreSQL.Simple.TypeInfo.Macro Database.PostgreSQL.Simple.TypeInfo.Static Database.PostgreSQL.Simple.Types Database.PostgreSQL.Simple.Errors@@ -76,7 +77,7 @@ source-repository this type: git location: http://github.com/lpsmith/postgresql-simple- tag: v0.3.5.0+ tag: v0.3.6.0 test-suite test type: exitcode-stdio-1.0
src/Database/PostgreSQL/Simple.hs view
@@ -626,7 +626,7 @@ -- > -- > hello = do -- > conn <- connect defaultConnectInfo--- > query conn "select 2 + 2"+-- > query_ conn "select 2 + 2" -- -- A 'Query' value does not represent the actual query that will be -- executed, but is a template for constructing the final query.
src/Database/PostgreSQL/Simple/BuiltinTypes.hs view
@@ -14,6 +14,7 @@ -- not be edited directly module Database.PostgreSQL.Simple.BuiltinTypes+ {-# DEPRECATED "Use TypeInfo instead" #-} ( BuiltinType (..) , builtin2oid , oid2builtin@@ -72,6 +73,7 @@ | Record | Void | UUID+ | JSON deriving (Eq, Ord, Enum, Bounded, Read, Show, Typeable) builtin2oid :: BuiltinType -> PQ.Oid@@ -122,6 +124,7 @@ Record -> 2249 Void -> 2278 UUID -> 2950+ JSON -> 114 oid2builtin :: PQ.Oid -> Maybe BuiltinType oid2builtin (PQ.Oid x) = case x of@@ -171,6 +174,7 @@ 2249 -> Just Record 2278 -> Just Void 2950 -> Just UUID+ 114 -> Just JSON _ -> Nothing builtin2typname :: BuiltinType -> ByteString@@ -221,6 +225,7 @@ Record -> record Void -> void UUID -> uuid+ JSON -> json oid2typname :: PQ.Oid -> Maybe ByteString oid2typname (PQ.Oid x) = case x of@@ -270,6 +275,7 @@ 2249 -> Just record 2278 -> Just void 2950 -> Just uuid+ 114 -> Just json _ -> Nothing bool :: ByteString@@ -409,3 +415,6 @@ uuid :: ByteString uuid = "uuid"++json :: ByteString+json = "json"
src/Database/PostgreSQL/Simple/FromField.hs view
@@ -1,12 +1,12 @@ {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-} {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} {-# LANGUAGE PatternGuards, ScopedTypeVariables #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecordWildCards, TemplateHaskell #-} {- | Module: Database.PostgreSQL.Simple.FromField Copyright: (c) 2011 MailRank, Inc.- (c) 2011-2012 Leon P Smith+ (c) 2011-2013 Leon P Smith License: BSD3 Maintainer: Leon P Smith <leon@melding-monads.com> Stability: experimental@@ -31,13 +31,14 @@ @ import Data.UUID ( UUID )-import Database.PostgreSQL.Simple.BuiltinTypes- ( BuiltinType(UUID), builtin2oid )+import Database.PostgreSQL.Simple.FromField+ ( typeOid, returnError, ResultError(..) )+import Database.PostgreSQL.Simple.TypeInfo.Static (typoid, uuid) import qualified Data.ByteString as B instance FromField UUID where fromField f mdata =- if typeOid f /= builtin2oid UUID+ if typeOid f /= typoid uuid then returnError Incompatible f \"\" else case B.unpack \`fmap\` mdata of Nothing -> returnError UnexpectedNull f \"\"@@ -49,8 +50,9 @@ Note that because PostgreSQL's @uuid@ type is built into postgres and is not provided by an extension, the 'typeOid' of @uuid@ does not change and-thus we can examine it directly. Here, we simply pull the type oid out-of the static table provided by postgresql-simple.+thus we can examine it directly. One could hard-code the type oid, or+obtain it by other means, but in this case we simply pull it out of the+static table provided by postgresql-simple. On the other hand if the type is provided by an extension, such as @PostGIS@ or @hstore@, then the 'typeOid' is not stable and can vary from@@ -93,24 +95,21 @@ ( Applicative, (<|>), (<$>), pure ) import Control.Exception (Exception) import Data.Attoparsec.Char8 hiding (Result)-import Data.Bits ((.&.), (.|.), shiftL) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B import Data.Int (Int16, Int32, Int64)-import Data.List (foldl') import Data.Ratio (Ratio) import Data.Time ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay ) import Data.Typeable (Typeable, typeOf) import Data.Vector (Vector) import qualified Data.Vector as V-import Data.Word (Word64) import Database.PostgreSQL.Simple.Internal-import Database.PostgreSQL.Simple.BuiltinTypes import Database.PostgreSQL.Simple.Compat import Database.PostgreSQL.Simple.Ok import Database.PostgreSQL.Simple.Types (Binary(..), Null(..))-import Database.PostgreSQL.Simple.TypeInfo as TypeInfo-import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TypeInfo+import Database.PostgreSQL.Simple.TypeInfo as TI+import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI+import Database.PostgreSQL.Simple.TypeInfo.Macro as TI import Database.PostgreSQL.Simple.Time import Database.PostgreSQL.Simple.Arrays as Arrays import qualified Database.PostgreSQL.LibPQ as PQ@@ -178,9 +177,9 @@ -- -- More concretely, it returns the @typname@ column associated with the -- type oid in the @pg_type@ table. First, postgresql-simple will check--- built-in, static table. If the type oid is not there, postgresql-simple--- will check a per-connection cache, and then finally query the database's--- meta-schema.+-- the built-in, static table. If the type oid is not there,+-- postgresql-simple will check a per-connection cache, and then+-- finally query the database's meta-schema. typename :: Field -> Conversion ByteString typename field = typname <$> typeInfo field@@ -243,7 +242,7 @@ -- | bool instance FromField Bool where fromField f bs- | typeOid f /= typoid (TypeInfo.bool) = returnError Incompatible f ""+ | typeOid f /= $(inlineTypoid TI.bool) = returnError Incompatible f "" | bs == Nothing = returnError UnexpectedNull f "" | bs == Just "t" = pure True | bs == Just "f" = pure False@@ -252,7 +251,7 @@ -- | \"char\" instance FromField Char where fromField f bs =- if typeOid f /= typoid (TypeInfo.char)+ if typeOid f /= $(inlineTypoid TI.char) then returnError Incompatible f "" else case bs of Nothing -> returnError UnexpectedNull f ""@@ -289,30 +288,30 @@ -- | int2, float4 instance FromField Float where fromField = atto ok (realToFrac <$> double)- where ok = mkCompats [Float4,Int2]+ where ok = $(mkCompats [TI.float4,TI.int2]) -- | int2, int4, float4, float8 instance FromField Double where fromField = atto ok double- where ok = mkCompats [Float4,Float8,Int2,Int4]+ where ok = $(mkCompats [TI.float4,TI.float8,TI.int2,TI.int4]) -- | int2, int4, float4, float8, numeric instance FromField (Ratio Integer) where fromField = atto ok rational- where ok = mkCompats [Float4,Float8,Int2,Int4,Numeric]+ where ok = $(mkCompats [TI.float4,TI.float8,TI.int2,TI.int4,TI.numeric]) unBinary :: Binary t -> t unBinary (Binary x) = x -- | bytea, name, text, \"char\", bpchar, varchar, unknown instance FromField SB.ByteString where- fromField f dat = if typeOid f == typoid TypeInfo.bytea+ fromField f dat = if typeOid f == $(inlineTypoid TI.bytea) then unBinary <$> fromField f dat else doFromField f okText' (pure . B.copy) dat -- | oid instance FromField PQ.Oid where- fromField f dat = PQ.Oid <$> atto (mkCompat Oid) decimal f dat+ fromField f dat = PQ.Oid <$> atto (== $(inlineTypoid TI.oid)) decimal f dat -- | bytea, name, text, \"char\", bpchar, varchar, unknown instance FromField LB.ByteString where@@ -349,44 +348,44 @@ -- | timestamptz instance FromField UTCTime where- fromField = ff TypeInfo.timestamptz "UTCTime" parseUTCTime+ fromField = ff $(inlineTypoid TI.timestamptz) "UTCTime" parseUTCTime -- | timestamptz instance FromField ZonedTime where- fromField = ff TypeInfo.timestamptz "ZonedTime" parseZonedTime+ fromField = ff $(inlineTypoid TI.timestamptz) "ZonedTime" parseZonedTime -- | timestamp instance FromField LocalTime where- fromField = ff TypeInfo.timestamp "LocalTime" parseLocalTime+ fromField = ff $(inlineTypoid TI.timestamp) "LocalTime" parseLocalTime -- | date instance FromField Day where- fromField = ff TypeInfo.date "Day" parseDay+ fromField = ff $(inlineTypoid TI.date) "Day" parseDay -- | time instance FromField TimeOfDay where- fromField = ff TypeInfo.time "TimeOfDay" parseTimeOfDay+ fromField = ff $(inlineTypoid TI.time) "TimeOfDay" parseTimeOfDay -- | timestamptz instance FromField UTCTimestamp where- fromField = ff TypeInfo.timestamptz "UTCTimestamp" parseUTCTimestamp+ fromField = ff $(inlineTypoid TI.timestamptz) "UTCTimestamp" parseUTCTimestamp -- | timestamptz instance FromField ZonedTimestamp where- fromField = ff TypeInfo.timestamptz "ZonedTimestamp" parseZonedTimestamp+ fromField = ff $(inlineTypoid TI.timestamptz) "ZonedTimestamp" parseZonedTimestamp -- | timestamp instance FromField LocalTimestamp where- fromField = ff TypeInfo.timestamp "LocalTimestamp" parseLocalTimestamp+ fromField = ff $(inlineTypoid TI.timestamp) "LocalTimestamp" parseLocalTimestamp -- | date instance FromField Date where- fromField = ff TypeInfo.date "Date" parseDate+ fromField = ff $(inlineTypoid TI.date) "Date" parseDate -ff :: TypeInfo -> String -> (B8.ByteString -> Either String a)+ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a) -> Field -> Maybe B8.ByteString -> Conversion a-ff pgType hsType parse f mstr =- if typeOid f /= typoid pgType+ff compatOid hsType parse f mstr =+ if typeOid f /= compatOid then err Incompatible "" else case mstr of Nothing -> err UnexpectedNull ""@@ -415,7 +414,7 @@ fromField f mdat = do info <- typeInfo f case info of- TypeInfo.Array{} ->+ TI.Array{} -> case mdat of Nothing -> returnError UnexpectedNull f "" Just dat -> do@@ -434,25 +433,17 @@ where f' | Arrays.Array _ <- item = f | otherwise = fElem -newtype Compat = Compat Word64--mkCompats :: [BuiltinType] -> Compat-mkCompats = foldl' f (Compat 0) . map mkCompat- where f (Compat a) (Compat b) = Compat (a .|. b)--mkCompat :: BuiltinType -> Compat-mkCompat = Compat . shiftL 1 . fromEnum--compat :: Compat -> Compat -> Bool-compat (Compat a) (Compat b) = a .&. b /= 0+type Compat = PQ.Oid -> Bool okText, okText', okBinary, ok16, ok32, ok64, okInt :: Compat-okText = mkCompats [Name,Text,Char,BpChar,VarChar]-okText' = mkCompats [Name,Text,Char,BpChar,VarChar,Unknown]-okBinary = mkCompats [ByteA]-ok16 = mkCompats [Int2]-ok32 = mkCompats [Int2,Int4]-ok64 = mkCompats [Int2,Int4,Int8]+okText = $( mkCompats [ TI.name, TI.text, TI.char,+ TI.bpchar, TI.varchar ] )+okText' = $( mkCompats [ TI.name, TI.text, TI.char,+ TI.bpchar, TI.varchar, TI.unknown ] )+okBinary = (== $( inlineTypoid TI.bytea ))+ok16 = (== $( inlineTypoid TI.int2 ))+ok32 = $( mkCompats [TI.int2,TI.int4] )+ok64 = $( mkCompats [TI.int2,TI.int4,TI.int8] ) #if WORD_SIZE_IN_BITS < 64 okInt = ok32 #else@@ -462,9 +453,8 @@ doFromField :: forall a . (Typeable a) => Field -> Compat -> (ByteString -> Conversion a) -> Maybe ByteString -> Conversion a-doFromField f types cvt (Just bs)- | Just typ <- oid2builtin (typeOid f)- , mkCompat typ `compat` types = cvt bs+doFromField f isCompat cvt (Just bs)+ | isCompat (typeOid f) = cvt bs | otherwise = returnError Incompatible f "types incompatible" doFromField f _ _ _ = returnError UnexpectedNull f ""
+ src/Database/PostgreSQL/Simple/TypeInfo/Macro.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE TemplateHaskell #-}++------------------------------------------------------------------------------+-- |+-- Module: Database.PostgreSQL.Simple.TypeInfo.Macro+-- Copyright: (c) 2013 Leon P Smith+-- License: BSD3+-- Maintainer: Leon P Smith <leon@melding-monads.com>+-- Stability: experimental+--+-- A Template Haskell macro for efficiently checking membership in+-- a set of type oids.+--+------------------------------------------------------------------------------++module Database.PostgreSQL.Simple.TypeInfo.Macro+ ( mkCompats+ , inlineTypoid+ ) where++import Database.PostgreSQL.Simple.TypeInfo.Static+import Database.PostgreSQL.Simple.Types (Oid(..))+import Language.Haskell.TH+++-- | Returns an expression that has type @'Oid' -> 'Bool'@, true if the+-- oid is equal to any one of the 'typoid's of the given 'TypeInfo's.+mkCompats :: [TypeInfo] -> ExpQ+mkCompats tys = [| \(Oid x) -> $(caseE [| x |] (map alt tys ++ [catchAll])) |]+ where+ alt :: TypeInfo -> MatchQ+ alt ty = match (litP (getTypoid ty)) (normalB [| True |]) []++ catchAll :: MatchQ+ catchAll = match wildP (normalB [| False |]) []++-- | Literally substitute the value of a TypeInfo expression. Returns+-- an expression of type 'Oid'. Useful because GHC tends not to+-- fold constants.+inlineTypoid :: TypeInfo -> ExpQ+inlineTypoid ty = [| Oid $(litE (getTypoid ty)) |]++getTypoid :: TypeInfo -> Lit+getTypoid ty = let (Oid x) = typoid ty in integerL (fromIntegral x)
src/Database/PostgreSQL/Simple/TypeInfo/Static.hs view
@@ -6,8 +6,9 @@ -- Maintainer: Leon P Smith <leon@melding-monads.com> -- Stability: experimental ----- Note that this module is semi-internal, and you probably want to use--- Database.PostgreSQL.Simple.TypeInfo instead.+-- This module contains portions of the @pg_type@ table that are relevant+-- to postgresql-simple and are believed to not change between PostgreSQL+-- versions. -- ------------------------------------------------------------------------------ @@ -63,6 +64,7 @@ , record , void , uuid+ , json ) where import Database.PostgreSQL.LibPQ (Oid(..))@@ -116,6 +118,7 @@ 2249 -> Just record 2278 -> Just void 2950 -> Just uuid+ 114 -> Just json _ -> Nothing bool :: TypeInfo@@ -484,4 +487,12 @@ typcategory = 'U', typdelim = ',', typname = "uuid"+ }++json :: TypeInfo+json = Basic {+ typoid = Oid 114,+ typcategory = 'U',+ typdelim = ',',+ typname = "json" }