cd784ea · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

Move to bytestring-builder

cd784eaLeon P Smith12 years ago

postgresql-simple.cabal+1−2

compare with master

unifiedsplit

@@ -54,9 +54,8 @@ Library

54 aeson >= 0.6,

55 attoparsec >= 0.10.3,

56 base < 5,

57− blaze-builder,

58− blaze-textual,

59 bytestring >= 0.9,

57 bytestring >= 0.9,

58+ bytestring-builder,

60 case-insensitive,

59 case-insensitive,

61 containers,

60 containers,

62 hashable,

61 hashable,

src/Database/PostgreSQL/Simple.hs+11−13

@@ -110,10 +110,8 @@ module Database.PostgreSQL.Simple

110 , formatQuery

111 ) where

112

113−import Blaze.ByteString.Builder

113+import Data.ByteString.Builder

114− ( Builder, fromByteString, toByteString )

114+ ( Builder, byteString, char8, intDec )

115−import Blaze.ByteString.Builder.Char8 (fromChar)

116−import Blaze.Text ( integral )

117import Control.Applicative ((<$>))

115import Control.Applicative ((<$>))

118import Control.Exception as E

116import Control.Exception as E

119import Control.Monad (foldM)

117import Control.Monad (foldM)

@@ -121,7 +119,7 @@ import Data.ByteString (ByteString)

121import Data.Int (Int64)

119import Data.Int (Int64)

122import Data.List (intersperse)

120import Data.List (intersperse)

123import Data.Monoid (mconcat)

121import Data.Monoid (mconcat)

124−import Database.PostgreSQL.Simple.Compat ( (<>) )

122+import Database.PostgreSQL.Simple.Compat ( (<>), toByteString )

125import Database.PostgreSQL.Simple.FromField (ResultError(..))

123import Database.PostgreSQL.Simple.FromField (ResultError(..))

126import Database.PostgreSQL.Simple.FromRow (FromRow(..))

124import Database.PostgreSQL.Simple.FromRow (FromRow(..))

127import Database.PostgreSQL.Simple.Ok

125import Database.PostgreSQL.Simple.Ok

@@ -173,9 +171,9 @@ formatMany conn q@(Query template) qs = do

173 case parseTemplate template of

171 case parseTemplate template of

174 Just (before, qbits, after) -> do

172 Just (before, qbits, after) -> do

175 bs <- mapM (buildQuery conn q qbits . toRow) qs

173 bs <- mapM (buildQuery conn q qbits . toRow) qs

176− return . toByteString . mconcat $ fromByteString before :

174+ return . toByteString . mconcat $ byteString before :

177− intersperse (fromChar ',') bs ++

175+ intersperse (char8 ',') bs ++

178− [fromByteString after]

176+ [byteString after]

179 Nothing -> fmtError "syntax error in multi-row template" q []

177 Nothing -> fmtError "syntax error in multi-row template" q []

180

178

181-- Split the input string into three pieces, @before@, @qbits@, and @after@,

179-- Split the input string into three pieces, @before@, @qbits@, and @after@,

@@ -280,7 +278,7 @@ buildQuery conn q template xs =

280 zipParams (split template) <$> mapM (buildAction conn q xs) xs

278 zipParams (split template) <$> mapM (buildAction conn q xs) xs

281 where split s =

279 where split s =

282 let (h,t) = B.break (=='?') s

280 let (h,t) = B.break (=='?') s

283− in fromByteString h

281+ in byteString h

284 : if B.null t

282 : if B.null t

285 then []

283 then []

286 else split (B.tail t)

284 else split (B.tail t)

@@ -519,10 +517,10 @@ doFold FoldOptions{..} conn _template q a0 f = do

519 [ "DECLARE ", name, " NO SCROLL CURSOR FOR ", q ]

517 [ "DECLARE ", name, " NO SCROLL CURSOR FOR ", q ]

520 return name

518 return name

521 fetch (Query name) = query_ conn $

519 fetch (Query name) = query_ conn $

522− Query (toByteString (fromByteString "FETCH FORWARD "

520+ Query (toByteString (byteString "FETCH FORWARD "

523− <> integral chunkSize

521+ <> intDec chunkSize

524− <> fromByteString " FROM "

522+ <> byteString " FROM "

525− <> fromByteString name

523+ <> byteString name

526 ))

524 ))

527 close name =

525 close name =

528 (execute_ conn ("CLOSE " <> name) >> return ()) `E.catch` \ex ->

526 (execute_ conn ("CLOSE " <> name) >> return ()) `E.catch` \ex ->

src/Database/PostgreSQL/Simple/Compat.hs+8

@@ -5,10 +5,15 @@ module Database.PostgreSQL.Simple.Compat

5 ( mask

6 , (<>)

7 , unsafeDupablePerformIO

8+ , toByteString

8 ) where

9 ) where

10import qualified Control.Exception as E

11import qualified Control.Exception as E

11import Data.Monoid

12import Data.Monoid

13+import Data.ByteString (ByteString)

14+import Data.ByteString.Lazy (toStrict)

15+import Data.ByteString.Builder (Builder, toLazyByteString)

16+

13#if __GLASGOW_HASKELL__ >= 702

18#if __GLASGOW_HASKELL__ >= 702

14import System.IO.Unsafe (unsafeDupablePerformIO)

19import System.IO.Unsafe (unsafeDupablePerformIO)

@@ -43,3 +48,6 @@ infixr 6 <>

43(<>) = mappend

48(<>) = mappend

44{-# INLINE (<>) #-}

49{-# INLINE (<>) #-}

45#endif

50#endif

51+

52+toByteString :: Builder -> ByteString

53+toByteString x = toStrict (toLazyByteString x)

src/Database/PostgreSQL/Simple/HStore/Implementation.hs+10−11

@@ -15,12 +15,11 @@

15module Database.PostgreSQL.Simple.HStore.Implementation where

17import Control.Applicative

18−import Blaze.ByteString.Builder as Blaze

19− ( Builder, toLazyByteString, copyByteString )

20−import Blaze.ByteString.Builder.Char8 (fromChar)

21import qualified Data.Attoparsec.ByteString as P

18import qualified Data.Attoparsec.ByteString as P

22import qualified Data.Attoparsec.ByteString.Char8 as P (isSpace_w8)

19import qualified Data.Attoparsec.ByteString.Char8 as P (isSpace_w8)

23import qualified Data.ByteString as BS

20import qualified Data.ByteString as BS

21+import Data.ByteString.Builder (Builder, byteString, char8)

22+import qualified Data.ByteString.Builder as BU

24import Data.ByteString.Internal (c2w, w2c)

23import Data.ByteString.Internal (c2w, w2c)

25import qualified Data.ByteString.Lazy as BL

24import qualified Data.ByteString.Lazy as BL

26#if !MIN_VERSION_bytestring(0,10,0)

25#if !MIN_VERSION_bytestring(0,10,0)

@@ -58,7 +57,7 @@ toBuilder x = case x of

58toLazyByteString :: HStoreBuilder -> BL.ByteString

57toLazyByteString :: HStoreBuilder -> BL.ByteString

59toLazyByteString x = case x of

58toLazyByteString x = case x of

60 Empty -> BL.empty

59 Empty -> BL.empty

61− Comma x -> Blaze.toLazyByteString x

60+ Comma x -> BU.toLazyByteString x

63instance Monoid HStoreBuilder where

62instance Monoid HStoreBuilder where

64 mempty = Empty

63 mempty = Empty

@@ -66,7 +65,7 @@ instance Monoid HStoreBuilder where

66 mappend (Comma a) x

65 mappend (Comma a) x

67 = Comma (a `mappend` case x of

66 = Comma (a `mappend` case x of

68 Empty -> mempty

67 Empty -> mempty

69− Comma b -> fromChar ',' `mappend` b)

68+ Comma b -> char8 ',' `mappend` b)

71class ToHStoreText a where

70class ToHStoreText a where

72 toHStoreText :: a -> HStoreText

71 toHStoreText :: a -> HStoreText

@@ -95,24 +94,24 @@ escapeAppend :: BS.ByteString -> Builder -> Builder

95escapeAppend = loop

94escapeAppend = loop

96 where

95 where

97 loop (BS.break quoteNeeded -> (a,b)) rest

96 loop (BS.break quoteNeeded -> (a,b)) rest

98− = copyByteString a `mappend`

97+ = byteString a `mappend`

99 case BS.uncons b of

98 case BS.uncons b of

100 Nothing -> rest

99 Nothing -> rest

101 Just (c,d) -> quoteChar c `mappend` loop d rest

100 Just (c,d) -> quoteChar c `mappend` loop d rest

102

101

103 quoteNeeded c = c == c2w '\"' || c == c2w '\\'

102 quoteNeeded c = c == c2w '\"' || c == c2w '\\'

104 quoteChar c

103 quoteChar c

105− | c == c2w '\"' = copyByteString "\\\""

104+ | c == c2w '\"' = byteString "\\\""

106− | otherwise = copyByteString "\\\\"

105+ | otherwise = byteString "\\\\"

107

106

108hstore :: (ToHStoreText a, ToHStoreText b) => a -> b -> HStoreBuilder

107hstore :: (ToHStoreText a, ToHStoreText b) => a -> b -> HStoreBuilder

109hstore (toHStoreText -> (HStoreText key)) (toHStoreText -> (HStoreText val)) =

108hstore (toHStoreText -> (HStoreText key)) (toHStoreText -> (HStoreText val)) =

110− Comma (fromChar '"' `mappend` key `mappend` copyByteString "\"=>\""

109+ Comma (char8 '"' `mappend` key `mappend` byteString "\"=>\""

111− `mappend` val `mappend` fromChar '"')

110+ `mappend` val `mappend` char8 '"')

112

111

113instance ToField HStoreBuilder where

112instance ToField HStoreBuilder where

114 toField Empty = toField (BS.empty)

113 toField Empty = toField (BS.empty)

115− toField (Comma x) = toField (Blaze.toLazyByteString x)

114+ toField (Comma x) = toField (BU.toLazyByteString x)

116

115

117newtype HStoreList = HStoreList {fromHStoreList :: [(Text,Text)]} deriving (Typeable, Show)

116newtype HStoreList = HStoreList {fromHStoreList :: [(Text,Text)]} deriving (Typeable, Show)

118

117

src/Database/PostgreSQL/Simple/Internal.hs+4−4

@@ -20,8 +20,6 @@

21module Database.PostgreSQL.Simple.Internal where

23−import Blaze.ByteString.Builder

24− ( Builder, fromByteString, toByteString )

25import Control.Applicative

23import Control.Applicative

26import Control.Exception

24import Control.Exception

27import Control.Concurrent.MVar

25import Control.Concurrent.MVar

@@ -29,6 +27,7 @@ import Control.Monad(MonadPlus(..))

29import Data.ByteString(ByteString)

27import Data.ByteString(ByteString)

30import qualified Data.ByteString as B

28import qualified Data.ByteString as B

31import qualified Data.ByteString.Char8 as B8

29import qualified Data.ByteString.Char8 as B8

30+import Data.ByteString.Builder ( Builder, byteString )

32import Data.Char (ord)

31import Data.Char (ord)

33import Data.Int (Int64)

32import Data.Int (Int64)

34import qualified Data.IntMap as IntMap

33import qualified Data.IntMap as IntMap

@@ -43,6 +42,7 @@ import Data.Word

43import Database.PostgreSQL.LibPQ(Oid(..))

42import Database.PostgreSQL.LibPQ(Oid(..))

44import qualified Database.PostgreSQL.LibPQ as PQ

43import qualified Database.PostgreSQL.LibPQ as PQ

45import Database.PostgreSQL.LibPQ(ExecStatus(..))

44import Database.PostgreSQL.LibPQ(ExecStatus(..))

45+import Database.PostgreSQL.Simple.Compat ( toByteString )

46import Database.PostgreSQL.Simple.Ok

47import Database.PostgreSQL.Simple.ToField (Action(..), inQuotes)

48import Database.PostgreSQL.Simple.Types (Query(..))

@@ -538,7 +538,7 @@ fmtErrorBs q xs msg = fmtError (T.unpack $ TE.decodeUtf8 msg) q xs

538

539-- | Quote bytestring or throw 'FormatError'

540quote :: Query -> [Action] -> Either ByteString ByteString -> Builder

541−quote q xs = either (fmtErrorBs q xs) (inQuotes . fromByteString)

541+quote q xs = either (fmtErrorBs q xs) (inQuotes . byteString)

542

543buildAction :: Connection -- ^ Connection for string escaping

544 -> Query -- ^ Query for message error

@@ -549,7 +549,7 @@ buildAction _ _ _ (Plain b) = pure b

549buildAction conn q xs (Escape s) = quote q xs <$> escapeStringConn conn s

550buildAction conn q xs (EscapeByteA s) = quote q xs <$> escapeByteaConn conn s

551buildAction conn q xs (EscapeIdentifier s) =

552− either (fmtErrorBs q xs) fromByteString <$> escapeIdentifier conn s

552+ either (fmtErrorBs q xs) byteString <$> escapeIdentifier conn s

553buildAction conn q xs (Many ys) =

554 mconcat <$> mapM (buildAction conn q xs) ys

555

src/Database/PostgreSQL/Simple/Time/Implementation.hs+19−21

@@ -13,9 +13,7 @@

13module Database.PostgreSQL.Simple.Time.Implementation where

15import Prelude hiding (take, (++))

16−import Blaze.ByteString.Builder(Builder, fromByteString)

16+import Data.ByteString.Builder(Builder, byteString, char8, integerDec)

17−import Blaze.ByteString.Builder.Char8(fromChar)

18−import Blaze.Text.Int(integral)

19import Control.Arrow((***))

17import Control.Arrow((***))

20import Control.Applicative

18import Control.Applicative

21import Control.Monad(when)

19import Control.Monad(when)

@@ -212,25 +210,25 @@ digits msg = do

212

210

213dayToBuilder :: Day -> Builder

211dayToBuilder :: Day -> Builder

214dayToBuilder (toGregorian -> (y,m,d)) = do

212dayToBuilder (toGregorian -> (y,m,d)) = do

215− pad4 y ++ fromChar '-' ++ pad2 m ++ fromChar '-' ++ pad2 d

213+ pad4 y ++ char8 '-' ++ pad2 m ++ char8 '-' ++ pad2 d

216

214

217timeOfDayToBuilder :: TimeOfDay -> Builder

215timeOfDayToBuilder :: TimeOfDay -> Builder

218timeOfDayToBuilder (TimeOfDay h m s) = do

216timeOfDayToBuilder (TimeOfDay h m s) = do

219− pad2 h ++ fromChar ':' ++ pad2 m ++ fromChar ':' ++ showSeconds s

217+ pad2 h ++ char8 ':' ++ pad2 m ++ char8 ':' ++ showSeconds s

220

218

221timeZoneToBuilder :: TimeZone -> Builder

219timeZoneToBuilder :: TimeZone -> Builder

222timeZoneToBuilder tz

220timeZoneToBuilder tz

223 | m == 0 = sign h ++ pad2 (abs h)

221 | m == 0 = sign h ++ pad2 (abs h)

224− | otherwise = sign h ++ pad2 (abs h) ++ fromChar ':' ++ pad2 (abs m)

222+ | otherwise = sign h ++ pad2 (abs h) ++ char8 ':' ++ pad2 (abs m)

225 where

223 where

226 (h,m) = timeZoneMinutes tz `quotRem` 60

224 (h,m) = timeZoneMinutes tz `quotRem` 60

227− sign h | h >= 0 = fromChar '+'

225+ sign h | h >= 0 = char8 '+'

228− | otherwise = fromChar '-'

226+ | otherwise = char8 '-'

229

227

230utcTimeToBuilder :: UTCTime -> Builder

228utcTimeToBuilder :: UTCTime -> Builder

231utcTimeToBuilder (UTCTime day time) =

229utcTimeToBuilder (UTCTime day time) =

232− dayToBuilder day ++ fromChar ' '

230+ dayToBuilder day ++ char8 ' '

233− ++ timeOfDayToBuilder (timeToTimeOfDay time) ++ fromByteString "+00"

231+ ++ timeOfDayToBuilder (timeToTimeOfDay time) ++ byteString "+00"

234

232

235zonedTimeToBuilder :: ZonedTime -> Builder

233zonedTimeToBuilder :: ZonedTime -> Builder

236zonedTimeToBuilder (ZonedTime localTime tz) =

234zonedTimeToBuilder (ZonedTime localTime tz) =

@@ -238,14 +236,14 @@ zonedTimeToBuilder (ZonedTime localTime tz) =

238

236

239localTimeToBuilder :: LocalTime -> Builder

237localTimeToBuilder :: LocalTime -> Builder

240localTimeToBuilder (LocalTime day tod) =

238localTimeToBuilder (LocalTime day tod) =

241− dayToBuilder day ++ fromChar ' ' ++ timeOfDayToBuilder tod

239+ dayToBuilder day ++ char8 ' ' ++ timeOfDayToBuilder tod

242

240

243unboundedToBuilder :: (a -> Builder) -> (Unbounded a -> Builder)

241unboundedToBuilder :: (a -> Builder) -> (Unbounded a -> Builder)

244unboundedToBuilder finiteToBuilder unbounded

242unboundedToBuilder finiteToBuilder unbounded

245 = case unbounded of

243 = case unbounded of

246− NegInfinity -> fromByteString "-infinity"

244+ NegInfinity -> byteString "-infinity"

247 Finite a -> finiteToBuilder a

245 Finite a -> finiteToBuilder a

248− PosInfinity -> fromByteString "infinity"

246+ PosInfinity -> byteString "infinity"

249

247

250utcTimestampToBuilder :: UTCTimestamp -> Builder

248utcTimestampToBuilder :: UTCTimestamp -> Builder

251utcTimestampToBuilder = unboundedToBuilder utcTimeToBuilder

249utcTimestampToBuilder = unboundedToBuilder utcTimeToBuilder

@@ -261,20 +259,20 @@ dateToBuilder = unboundedToBuilder dayToBuilder

261

259

262nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

260nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

263nominalDiffTimeToBuilder xyz

261nominalDiffTimeToBuilder xyz

264− | yz < 500000 = sign ++ integral x

262+ | yz < 500000 = sign ++ integerDec x

265− | otherwise = sign ++ integral x ++ fromChar '.' ++ showD6 y

263+ | otherwise = sign ++ integerDec x ++ char8 '.' ++ showD6 y

266 where

264 where

267 -- A kludge to work around the fact that Data.Fixed isn't very fast and

265 -- A kludge to work around the fact that Data.Fixed isn't very fast and

268 -- doesn't give me access to the MkFixed constructor.

266 -- doesn't give me access to the MkFixed constructor.

269− sign = if xyz >= 0 then mempty else fromChar '-'

267+ sign = if xyz >= 0 then mempty else char8 '-'

270 (x,yz) = ((unsafeCoerce (abs xyz) :: Integer) + 500000) `quotRem` 1000000000000

268 (x,yz) = ((unsafeCoerce (abs xyz) :: Integer) + 500000) `quotRem` 1000000000000

271 (fromIntegral -> y, _z) = yz `quotRem` 1000000

269 (fromIntegral -> y, _z) = yz `quotRem` 1000000

272

270

273showSeconds :: Pico -> Builder

271showSeconds :: Pico -> Builder

274showSeconds xyz

272showSeconds xyz

275 | yz == 0 = pad2 x

273 | yz == 0 = pad2 x

276− | z == 0 = pad2 x ++ fromChar '.' ++ showD6 y

274+ | z == 0 = pad2 x ++ char8 '.' ++ showD6 y

277− | otherwise = pad2 x ++ fromChar '.' ++ pad6 y ++ showD6 z

275+ | otherwise = pad2 x ++ char8 '.' ++ pad6 y ++ showD6 z

278 where

276 where

279 -- A kludge to work around the fact that Data.Fixed isn't very fast and

277 -- A kludge to work around the fact that Data.Fixed isn't very fast and

280 -- doesn't give me access to the MkFixed constructor.

278 -- doesn't give me access to the MkFixed constructor.

@@ -305,7 +303,7 @@ showD3 abc = case abc `quotRem` 100 of

305

303

306-- | p assumes its input is in the range [0..9]

304-- | p assumes its input is in the range [0..9]

307p :: Integral n => n -> Builder

305p :: Integral n => n -> Builder

308−p n = fromChar (w2c (fromIntegral (n + 48)))

306+p n = char8 (w2c (fromIntegral (n + 48)))

309{-# INLINE p #-}

307{-# INLINE p #-}

310

308

311-- | pad2 assumes its input is in the range [0..99]

309-- | pad2 assumes its input is in the range [0..99]

@@ -314,8 +312,8 @@ pad2 n = let (a,b) = n `quotRem` 10 in p a ++ p b

314{-# INLINE pad2 #-}

312{-# INLINE pad2 #-}

315

313

316-- | pad4 assumes its input is positive

314-- | pad4 assumes its input is positive

317−pad4 :: (Integral n, Show n) => n -> Builder

315+pad4 :: Integer -> Builder

318−pad4 abcd | abcd >= 10000 = integral abcd

316+pad4 abcd | abcd >= 10000 = integerDec abcd

319 | otherwise = p a ++ p b ++ p c ++ p d

317 | otherwise = p a ++ p b ++ p c ++ p d

320 where (ab,cd) = abcd `quotRem` 100

318 where (ab,cd) = abcd `quotRem` 100

321 (a,b) = ab `quotRem` 10

319 (a,b) = ab `quotRem` 10

src/Database/PostgreSQL/Simple/ToField.hs+43−38

@@ -22,11 +22,14 @@ module Database.PostgreSQL.Simple.ToField

22 , inQuotes

23 ) where

25−import Blaze.ByteString.Builder (Builder, fromByteString, toByteString)

26−import Blaze.ByteString.Builder.Char8 (fromChar)

27−import Blaze.Text (integral, double, float)

28import qualified Data.Aeson as JSON

25import qualified Data.Aeson as JSON

29−import Data.ByteString (ByteString)

26+import Data.ByteString (ByteString)

27+import Data.ByteString.Builder

28+ ( Builder, byteString, char8, stringUtf8

29+ , intDec, int8Dec, int16Dec, int32Dec, int64Dec, integerDec

30+ , wordDec, word8Dec, word16Dec, word32Dec, word64Dec

31+ , floatDec, doubleDec

32+ )

30import Data.Int (Int8, Int16, Int32, Int64)

33import Data.Int (Int8, Int16, Int32, Int64)

31import Data.List (intersperse)

34import Data.List (intersperse)

32import Data.Monoid (mappend)

35import Data.Monoid (mappend)

@@ -35,7 +38,8 @@ import Data.Typeable (Typeable)

35import Data.Word (Word, Word8, Word16, Word32, Word64)

38import Data.Word (Word, Word8, Word16, Word32, Word64)

36import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow

39import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow

37import Database.PostgreSQL.Simple.Types

40import Database.PostgreSQL.Simple.Types

38−import qualified Blaze.ByteString.Builder.Char.Utf8 as Utf8

41+import Database.PostgreSQL.Simple.Compat (toByteString)

42+

39import qualified Data.ByteString as SB

43import qualified Data.ByteString as SB

40import qualified Data.ByteString.Lazy as LB

44import qualified Data.ByteString.Lazy as LB

41import qualified Data.Text as ST

45import qualified Data.Text as ST

@@ -54,6 +58,7 @@ import Data.Text.Lazy.Builder.Scientific (scientificBuilder)

54#else

58#else

55import Data.Scientific (scientificBuilder)

59import Data.Scientific (scientificBuilder)

56#endif

60#endif

61+import Foreign.C.Types (CUInt(..))

58-- | How to render an element when substituting it into a query.

63-- | How to render an element when substituting it into a query.

59data Action =

64data Action =

@@ -99,84 +104,84 @@ instance (ToField a) => ToField (Maybe a) where

99 {-# INLINE toField #-}

104 {-# INLINE toField #-}

100

105

101instance (ToField a) => ToField (In [a]) where

106instance (ToField a) => ToField (In [a]) where

102− toField (In []) = Plain $ fromByteString "(null)"

107+ toField (In []) = Plain $ byteString "(null)"

103 toField (In xs) = Many $

108 toField (In xs) = Many $

104− Plain (fromChar '(') :

109+ Plain (char8 '(') :

105− (intersperse (Plain (fromChar ',')) . map toField $ xs) ++

110+ (intersperse (Plain (char8 ',')) . map toField $ xs) ++

106− [Plain (fromChar ')')]

111+ [Plain (char8 ')')]

107

112

108renderNull :: Action

113renderNull :: Action

109−renderNull = Plain (fromByteString "null")

114+renderNull = Plain (byteString "null")

110

115

111instance ToField Null where

116instance ToField Null where

112 toField _ = renderNull

117 toField _ = renderNull

113 {-# INLINE toField #-}

118 {-# INLINE toField #-}

114

119

115instance ToField Default where

120instance ToField Default where

116− toField _ = Plain (fromByteString "default")

121+ toField _ = Plain (byteString "default")

117 {-# INLINE toField #-}

122 {-# INLINE toField #-}

118

123

119instance ToField Bool where

124instance ToField Bool where

120− toField True = Plain (fromByteString "true")

125+ toField True = Plain (byteString "true")

121− toField False = Plain (fromByteString "false")

126+ toField False = Plain (byteString "false")

122 {-# INLINE toField #-}

127 {-# INLINE toField #-}

123

128

124instance ToField Int8 where

129instance ToField Int8 where

125− toField = Plain . integral

130+ toField = Plain . int8Dec

126 {-# INLINE toField #-}

131 {-# INLINE toField #-}

127

132

128instance ToField Int16 where

133instance ToField Int16 where

129− toField = Plain . integral

134+ toField = Plain . int16Dec

130 {-# INLINE toField #-}

135 {-# INLINE toField #-}

131

136

132instance ToField Int32 where

137instance ToField Int32 where

133− toField = Plain . integral

138+ toField = Plain . int32Dec

134 {-# INLINE toField #-}

139 {-# INLINE toField #-}

135

140

136instance ToField Int where

141instance ToField Int where

137− toField = Plain . integral

142+ toField = Plain . intDec

138 {-# INLINE toField #-}

143 {-# INLINE toField #-}

139

144

140instance ToField Int64 where

145instance ToField Int64 where

141− toField = Plain . integral

146+ toField = Plain . int64Dec

142 {-# INLINE toField #-}

147 {-# INLINE toField #-}

143

148

144instance ToField Integer where

149instance ToField Integer where

145− toField = Plain . integral

150+ toField = Plain . integerDec

146 {-# INLINE toField #-}

151 {-# INLINE toField #-}

147

152

148instance ToField Word8 where

153instance ToField Word8 where

149− toField = Plain . integral

154+ toField = Plain . word8Dec

150 {-# INLINE toField #-}

155 {-# INLINE toField #-}

151

156

152instance ToField Word16 where

157instance ToField Word16 where

153− toField = Plain . integral

158+ toField = Plain . word16Dec

154 {-# INLINE toField #-}

159 {-# INLINE toField #-}

155

160

156instance ToField Word32 where

161instance ToField Word32 where

157− toField = Plain . integral

162+ toField = Plain . word32Dec

158 {-# INLINE toField #-}

163 {-# INLINE toField #-}

159

164

160instance ToField Word where

165instance ToField Word where

161− toField = Plain . integral

166+ toField = Plain . wordDec

162 {-# INLINE toField #-}

167 {-# INLINE toField #-}

163

168

164instance ToField Word64 where

169instance ToField Word64 where

165− toField = Plain . integral

170+ toField = Plain . word64Dec

166 {-# INLINE toField #-}

171 {-# INLINE toField #-}

167

172

168instance ToField PQ.Oid where

173instance ToField PQ.Oid where

169− toField = Plain . integral . \(PQ.Oid x) -> x

174+ toField = Plain . \(PQ.Oid (CUInt x)) -> word32Dec x

170 {-# INLINE toField #-}

175 {-# INLINE toField #-}

171

176

172instance ToField Float where

177instance ToField Float where

173− toField v | isNaN v || isInfinite v = Plain (inQuotes (float v))

178+ toField v | isNaN v || isInfinite v = Plain (inQuotes (floatDec v))

174− | otherwise = Plain (float v)

179+ | otherwise = Plain (floatDec v)

175 {-# INLINE toField #-}

180 {-# INLINE toField #-}

176

181

177instance ToField Double where

182instance ToField Double where

178− toField v | isNaN v || isInfinite v = Plain (inQuotes (double v))

183+ toField v | isNaN v || isInfinite v = Plain (inQuotes (doubleDec v))

179− | otherwise = Plain (double v)

184+ | otherwise = Plain (doubleDec v)

180 {-# INLINE toField #-}

185 {-# INLINE toField #-}

181

186

182instance ToField Scientific where

187instance ToField Scientific where

@@ -198,7 +203,7 @@ instance ToField Identifier where

198instance ToField QualifiedIdentifier where

203instance ToField QualifiedIdentifier where

199 toField (QualifiedIdentifier (Just s) t) =

204 toField (QualifiedIdentifier (Just s) t) =

200 Many [ EscapeIdentifier (ST.encodeUtf8 s)

205 Many [ EscapeIdentifier (ST.encodeUtf8 s)

201− , Plain (fromChar '.')

206+ , Plain (char8 '.')

202 , EscapeIdentifier (ST.encodeUtf8 t)

207 , EscapeIdentifier (ST.encodeUtf8 t)

203 ]

208 ]

204 toField (QualifiedIdentifier Nothing t) =

209 toField (QualifiedIdentifier Nothing t) =

@@ -218,7 +223,7 @@ instance ToField ST.Text where

218 {-# INLINE toField #-}

223 {-# INLINE toField #-}

219

224

220instance ToField [Char] where

225instance ToField [Char] where

221− toField = Escape . toByteString . Utf8.fromString

226+ toField = Escape . toByteString . stringUtf8

222 {-# INLINE toField #-}

227 {-# INLINE toField #-}

223

228

224instance ToField LT.Text where

229instance ToField LT.Text where

@@ -268,9 +273,9 @@ instance ToField NominalDiffTime where

268

273

269instance (ToField a) => ToField (PGArray a) where

274instance (ToField a) => ToField (PGArray a) where

270 toField xs = Many $

275 toField xs = Many $

271− Plain (fromByteString "ARRAY[") :

276+ Plain (byteString "ARRAY[") :

272− (intersperse (Plain (fromChar ',')) . map toField $ fromPGArray xs) ++

277+ (intersperse (Plain (char8 ',')) . map toField $ fromPGArray xs) ++

273− [Plain (fromChar ']')]

278+ [Plain (char8 ']')]

274 -- Because the ARRAY[...] input syntax is being used, it is possible

279 -- Because the ARRAY[...] input syntax is being used, it is possible

275 -- that the use of type-specific separator characters is unnecessary.

280 -- that the use of type-specific separator characters is unnecessary.

276

281

@@ -278,7 +283,7 @@ instance (ToField a) => ToField (Vector a) where

278 toField = toField . PGArray . V.toList

283 toField = toField . PGArray . V.toList

279

284

280instance ToField UUID where

285instance ToField UUID where

281− toField = Plain . inQuotes . fromByteString . UUID.toASCIIBytes

286+ toField = Plain . inQuotes . byteString . UUID.toASCIIBytes

282

287

283instance ToField JSON.Value where

288instance ToField JSON.Value where

284 toField = toField . JSON.encode

289 toField = toField . JSON.encode

@@ -297,7 +302,7 @@ toJSONField = toField . JSON.toJSON

297-- This function /does not/ perform any other escaping.

302-- This function /does not/ perform any other escaping.

298inQuotes :: Builder -> Builder

303inQuotes :: Builder -> Builder

299inQuotes b = quote `mappend` b `mappend` quote

304inQuotes b = quote `mappend` b `mappend` quote

300− where quote = Utf8.fromChar '\''

305+ where quote = char8 '\''

301

306

302interleaveFoldr :: (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]

307interleaveFoldr :: (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]

303interleaveFoldr f b bs as = foldr (\a bs -> b : f a bs) bs as

308interleaveFoldr f b bs as = foldr (\a bs -> b : f a bs) bs as

@@ -318,8 +323,8 @@ instance ToRow a => ToField (Values a) where

318 funcname = "Database.PostgreSQL.Simple.toField :: Values a -> Action"

323 funcname = "Database.PostgreSQL.Simple.toField :: Values a -> Action"

319 norows = funcname ++ " either values or types must be non-empty"

324 norows = funcname ++ " either values or types must be non-empty"

320 emptyrow = funcname ++ " each row must contain at least one column"

325 emptyrow = funcname ++ " each row must contain at least one column"

321− lit = Plain . fromByteString

326+ lit = Plain . byteString

322− litC = Plain . fromChar

327+ litC = Plain . char8

323 values x = Many (lit "(VALUES ": x)

328 values x = Many (lit "(VALUES ": x)

324

329

325 typedField :: (Action, QualifiedIdentifier) -> [Action] -> [Action]

330 typedField :: (Action, QualifiedIdentifier) -> [Action] -> [Action]

src/Database/PostgreSQL/Simple/ToField.hs-boot+1−1

@@ -1,7 +1,7 @@

1module Database.PostgreSQL.Simple.ToField where

3import Database.PostgreSQL.Simple.Types

4−import Blaze.ByteString.Builder(Builder)

4+import Data.ByteString.Builder(Builder)

5import Data.ByteString(ByteString)

7-- | How to render an element when substituting it into a query.

src/Database/PostgreSQL/Simple/Types.hs+3−3

@@ -30,18 +30,18 @@ module Database.PostgreSQL.Simple.Types

30 , Values(..)

31 ) where

33−import Blaze.ByteString.Builder (toByteString)

34import Control.Arrow (first)

33import Control.Arrow (first)

35import Data.ByteString (ByteString)

34import Data.ByteString (ByteString)

36import Data.Hashable (Hashable(hashWithSalt))

35import Data.Hashable (Hashable(hashWithSalt))

37import Data.Monoid (Monoid(..))

36import Data.Monoid (Monoid(..))

38import Data.String (IsString(..))

37import Data.String (IsString(..))

39import Data.Typeable (Typeable)

38import Data.Typeable (Typeable)

40−import qualified Blaze.ByteString.Builder.Char.Utf8 as Utf8

39+import Data.ByteString.Builder ( stringUtf8 )

41import qualified Data.ByteString as B

40import qualified Data.ByteString as B

42import Data.Text (Text)

41import Data.Text (Text)

43import qualified Data.Text as T

42import qualified Data.Text as T

44import Database.PostgreSQL.LibPQ (Oid(..))

43import Database.PostgreSQL.LibPQ (Oid(..))

44+import Database.PostgreSQL.Simple.Compat (toByteString)

46-- | A placeholder for the SQL @NULL@ value.

47data Null = Null

@@ -85,7 +85,7 @@ instance Read Query where

85 readsPrec i = fmap (first Query) . readsPrec i

87instance IsString Query where

88− fromString = Query . toByteString . Utf8.fromString

88+ fromString = Query . toByteString . stringUtf8

90instance Monoid Query where

91 mempty = Query B.empty