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.4.1.0 +Version: 0.4.2.0 Synopsis: Mid-Level PostgreSQL client library Description: Mid-Level PostgreSQL client library, forked from mysql-simple. 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 @@ -127,6 +127,7 @@ import qualified Data.Text.Lazy as LT import Data.UUID (UUID) import qualified Data.UUID as UUID +import Data.Scientific (Scientific) -- | Exception thrown if conversion from a SQL value to a Haskell -- value fails. @@ -313,6 +314,11 @@ -- | int2, int4, float4, float8, numeric instance FromField (Ratio Integer) where fromField = atto ok rational + where ok = $(mkCompats [TI.float4,TI.float8,TI.int2,TI.int4,TI.numeric]) + +-- | int2, int4, float4, float8, numeric +instance FromField Scientific where + fromField = atto ok rational where ok = $(mkCompats [TI.float4,TI.float8,TI.int2,TI.int4,TI.numeric]) unBinary :: Binary t -> t diff --git a/src/Database/PostgreSQL/Simple/ToField.hs b/src/Database/PostgreSQL/Simple/ToField.hs --- a/src/Database/PostgreSQL/Simple/ToField.hs +++ b/src/Database/PostgreSQL/Simple/ToField.hs @@ -41,12 +41,14 @@ import qualified Data.Text as ST import qualified Data.Text.Encoding as ST import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.Builder as LT import Data.UUID (UUID) import qualified Data.UUID as UUID import Data.Vector (Vector) import qualified Data.Vector as V import qualified Database.PostgreSQL.LibPQ as PQ import Database.PostgreSQL.Simple.Time +import Data.Scientific (Scientific, scientificBuilder) -- | How to render an element when substituting it into a query. data Action = @@ -172,6 +174,10 @@ | otherwise = Plain (double v) {-# INLINE toField #-} +instance ToField Scientific where + toField x = toField (LT.toLazyText (scientificBuilder x)) + {-# INLINE toField #-} + instance ToField (Binary SB.ByteString) where toField (Binary bs) = EscapeByteA bs {-# INLINE toField #-} @@ -181,15 +187,17 @@ {-# INLINE toField #-} instance ToField Identifier where - toField (Identifier bs) = EscapeIdentifier bs + toField (Identifier bs) = EscapeIdentifier (ST.encodeUtf8 bs) {-# INLINE toField #-} instance ToField QualifiedIdentifier where - toField (QualifiedIdentifier (Just s) t) = Many [ EscapeIdentifier s - , Plain (fromChar '.') - , EscapeIdentifier t - ] - toField (QualifiedIdentifier Nothing t) = EscapeIdentifier t + toField (QualifiedIdentifier (Just s) t) = + Many [ EscapeIdentifier (ST.encodeUtf8 s) + , Plain (fromChar '.') + , EscapeIdentifier (ST.encodeUtf8 t) + ] + toField (QualifiedIdentifier Nothing t) = + EscapeIdentifier (ST.encodeUtf8 t) {-# INLINE toField #-} instance ToField SB.ByteString where @@ -289,7 +297,7 @@ toField (Values types rows) = case rows of [] -> case types of - [] -> error err + [] -> error norows (_:_) -> values $ typedRow (repeat (lit "null")) types [lit " LIMIT 0)"] @@ -297,7 +305,9 @@ [] -> values $ untypedRows rows [litC ')'] (_:_) -> values $ typedRows rows types [litC ')'] where - err = "Database.PostgreSQL.Simple.toField :: Values -> Action either values or types must be non-empty" + funcname = "Database.PostgreSQL.Simple.toField :: Values a -> Action" + norows = funcname ++ " either values or types must be non-empty" + emptyrow = funcname ++ " each row must contain at least one column" lit = Plain . fromByteString litC = Plain . fromChar values x = Many (lit "(VALUES ": x) @@ -313,6 +323,7 @@ (litC ',') (litC ')' : rest) (zip vals typs) ) + typedRow _ _ _ = error emptyrow untypedRow :: [Action] -> [Action] -> [Action] untypedRow (val:vals) rest = @@ -322,8 +333,10 @@ (litC ',') (litC ')' : rest) vals + untypedRow _ _ = error emptyrow typedRows :: ToRow a => [a] -> [QualifiedIdentifier] -> [Action] -> [Action] + typedRows [] _ _ = error funcname typedRows (val:vals) types rest = typedRow (toRow val) types (litC ',' : untypedRows vals rest) diff --git a/src/Database/PostgreSQL/Simple/Types.hs b/src/Database/PostgreSQL/Simple/Types.hs --- a/src/Database/PostgreSQL/Simple/Types.hs +++ b/src/Database/PostgreSQL/Simple/Types.hs @@ -30,16 +30,18 @@ , Values(..) ) where -import Blaze.ByteString.Builder (toByteString) -import Control.Arrow (first) -import Data.ByteString (ByteString) -import Data.Hashable (Hashable(hashWithSalt)) -import Data.Monoid (Monoid(..)) -import Data.String (IsString(..)) -import Data.Typeable (Typeable) +import Blaze.ByteString.Builder (toByteString) +import Control.Arrow (first) +import Data.ByteString (ByteString) +import Data.Hashable (Hashable(hashWithSalt)) +import Data.Monoid (Monoid(..)) +import Data.String (IsString(..)) +import Data.Typeable (Typeable) import qualified Blaze.ByteString.Builder.Char.Utf8 as Utf8 import qualified Data.ByteString as B -import Database.PostgreSQL.LibPQ (Oid(..)) +import Data.Text (Text) +import qualified Data.Text as T +import Database.PostgreSQL.LibPQ (Oid(..)) -- | A placeholder for the SQL @NULL@ value. data Null = Null @@ -123,30 +125,25 @@ deriving (Eq, Ord, Read, Show, Typeable, Functor) -- | Wrap text for use as sql identifier, i.e. a table or column name. -newtype Identifier = Identifier {fromIdentifier :: ByteString} - deriving (Eq, Ord, Read, Show, Typeable) - -instance IsString Identifier where - fromString = Identifier . toByteString . Utf8.fromString +newtype Identifier = Identifier {fromIdentifier :: Text} + deriving (Eq, Ord, Read, Show, Typeable, IsString) instance Hashable Identifier where hashWithSalt i (Identifier t) = hashWithSalt i t -- | Wrap text for use as (maybe) qualified identifier, i.e. a table -- with schema, or column with table. -data QualifiedIdentifier = QualifiedIdentifier (Maybe ByteString) ByteString +data QualifiedIdentifier = QualifiedIdentifier (Maybe Text) Text deriving (Eq, Ord, Read, Show, Typeable) instance Hashable QualifiedIdentifier where hashWithSalt i (QualifiedIdentifier q t) = hashWithSalt i (q, t) instance IsString QualifiedIdentifier where - fromString str = let (x,y) = B.break (== 46) - . toByteString - . Utf8.fromString $ str - in if B.null y + fromString str = let (x,y) = T.break (== '.') (fromString str) + in if T.null y then QualifiedIdentifier Nothing x - else QualifiedIdentifier (Just x) (B.tail y) + else QualifiedIdentifier (Just x) (T.tail y) -- | Wrap a list for use as a PostgreSQL array. newtype PGArray a = PGArray {fromPGArray :: [a]}