diff --git a/CONTRIBUTORS b/CONTRIBUTORS --- a/CONTRIBUTORS +++ b/CONTRIBUTORS @@ -12,3 +12,4 @@ Simon Meier Alexey Uimanov Doug Beardsley +Manuel Gómez diff --git a/postgresql-simple.cabal b/postgresql-simple.cabal --- a/postgresql-simple.cabal +++ b/postgresql-simple.cabal @@ -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 diff --git a/src/Database/PostgreSQL/Simple.hs b/src/Database/PostgreSQL/Simple.hs --- a/src/Database/PostgreSQL/Simple.hs +++ b/src/Database/PostgreSQL/Simple.hs @@ -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. diff --git a/src/Database/PostgreSQL/Simple/BuiltinTypes.hs b/src/Database/PostgreSQL/Simple/BuiltinTypes.hs --- a/src/Database/PostgreSQL/Simple/BuiltinTypes.hs +++ b/src/Database/PostgreSQL/Simple/BuiltinTypes.hs @@ -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" diff --git a/src/Database/PostgreSQL/Simple/FromField.hs b/src/Database/PostgreSQL/Simple/FromField.hs --- a/src/Database/PostgreSQL/Simple/FromField.hs +++ b/src/Database/PostgreSQL/Simple/FromField.hs @@ -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 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 "" diff --git a/src/Database/PostgreSQL/Simple/TypeInfo/Macro.hs b/src/Database/PostgreSQL/Simple/TypeInfo/Macro.hs new file mode 100644 --- /dev/null +++ b/src/Database/PostgreSQL/Simple/TypeInfo/Macro.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE TemplateHaskell #-} + +------------------------------------------------------------------------------ +-- | +-- Module: Database.PostgreSQL.Simple.TypeInfo.Macro +-- Copyright: (c) 2013 Leon P Smith +-- License: BSD3 +-- Maintainer: Leon P Smith +-- 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) diff --git a/src/Database/PostgreSQL/Simple/TypeInfo/Static.hs b/src/Database/PostgreSQL/Simple/TypeInfo/Static.hs --- a/src/Database/PostgreSQL/Simple/TypeInfo/Static.hs +++ b/src/Database/PostgreSQL/Simple/TypeInfo/Static.hs @@ -6,8 +6,9 @@ -- Maintainer: Leon P Smith -- 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" }