2062ea5 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

A bit of reorganization

2062ea5Leon P Smith14 years ago

src/Database/PostgreSQL/Simple/FromField.hs+27

compare with master

unifiedsplit

@@ -61,6 +61,7 @@ import Database.PostgreSQL.Simple.Internal

61import Database.PostgreSQL.Simple.BuiltinTypes

62import Database.PostgreSQL.Simple.Ok

63import Database.PostgreSQL.Simple.Types (Binary(..), Null(..))

64+import Database.PostgreSQL.Simple.Time

64import qualified Database.PostgreSQL.LibPQ as PQ

65import qualified Database.PostgreSQL.LibPQ as PQ

65import System.IO.Unsafe (unsafePerformIO)

66import System.IO.Unsafe (unsafePerformIO)

66import System.Locale (defaultTimeLocale)

67import System.Locale (defaultTimeLocale)

@@ -240,6 +241,32 @@ instance FromField TimeOfDay where

240 Just t -> return (pure t)

241 Just t -> return (pure t)

241 _ -> return (returnError ConversionFailed f "could not parse")

242 _ -> return (returnError ConversionFailed f "could not parse")

242

243

244+

245+instance FromField UTCTimestamp where

246+ fromField = ff TimestampWithTimeZone "UTCTimestamp" parseUTCTimestamp

247+

248+instance FromField ZonedTimestamp where

249+ fromField = ff TimestampWithTimeZone "ZonedTimestamp" parseZonedTimestamp

250+

251+instance FromField LocalTimestamp where

252+ fromField = ff Timestamp "LocalTimestamp" parseLocalTimestamp

253+

254+instance FromField Date where

255+ fromField = ff Date "Date" parseDate

256+

257+ff :: BuiltinType -> String -> (B8.ByteString -> Either String a)

258+ -> Field -> Maybe B8.ByteString -> Ok a

259+ff pgType hsType parse f mstr

260+ | typeOid f /= builtin2oid pgType

261+ = left (Incompatible (B8.unpack (typename f)) hsType "")

262+ | Nothing <- mstr

263+ = left (UnexpectedNull (B8.unpack (typename f)) hsType "")

264+ | Just str <- mstr

265+ = case parse str of

266+ Left msg -> left (ConversionFailed (B8.unpack (typename f)) hsType msg)

267+ Right val -> return val

268+{-# INLINE ff #-}

269+

243instance (FromField a, FromField b) => FromField (Either a b) where

270instance (FromField a, FromField b) => FromField (Either a b) where

244 fromField f dat = (Right <$> fromField f dat)

271 fromField f dat = (Right <$> fromField f dat)

245 <|> (Left <$> fromField f dat)

272 <|> (Left <$> fromField f dat)

src/Database/PostgreSQL/Simple/Time.hs+1−4

@@ -7,14 +7,11 @@

7-- Stability: experimental

8--

9-- Time types that supports infinities. Also includes new time parsers

10−-- with improved performance over GHC's time package. See

10+-- with improved performance over GHC's time package. See

11-- 'Database.PostgreSQL.Simple.Time.Internal'.

12--

13------------------------------------------------------------------------------

15−{-# LANGUAGE DeriveDataTypeable #-}

16−{-# LANGUAGE ScopedTypeVariables #-}

17−

18module Database.PostgreSQL.Simple.Time

15module Database.PostgreSQL.Simple.Time

19 ( Unbounded(..)

16 ( Unbounded(..)

20 , UTCTimestamp

17 , UTCTimestamp

src/Database/PostgreSQL/Simple/Time/Implementation.hs+4−40

@@ -8,7 +8,7 @@

8--

9------------------------------------------------------------------------------

11−{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, PatternGuards #-}

11+{-# LANGUAGE DeriveDataTypeable #-}

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

@@ -17,21 +17,14 @@ import Prelude hiding (take)

17--import Blaze.ByteString.Builder.Char8(fromString, fromChar)

18import Control.Arrow((***))

19import Control.Applicative

20−import Control.Exception

21import Control.Monad(when)

20import Control.Monad(when)

22import Data.Bits((.&.))

21import Data.Bits((.&.))

23import qualified Data.ByteString as B

22import qualified Data.ByteString as B

24−import qualified Data.ByteString.Char8 as B8

25import Data.ByteString.Internal (c2w)

23import Data.ByteString.Internal (c2w)

26−import Data.Char

27import Data.Time hiding (getTimeZone, getZonedTime)

24import Data.Time hiding (getTimeZone, getZonedTime)

28import Data.Typeable

25import Data.Typeable

29import Data.Word(Word8)

26import Data.Word(Word8)

30import qualified Data.Attoparsec.Char8 as A

27import qualified Data.Attoparsec.Char8 as A

31−import qualified Database.PostgreSQL.Simple.BuiltinTypes as PG

32−import Database.PostgreSQL.Simple.FromField

33−--import Database.PostgreSQL.Simple.ToField

34−import Database.PostgreSQL.Simple.Ok

36data Unbounded a

29data Unbounded a

37 = NegInfinity

30 = NegInfinity

@@ -57,35 +50,6 @@ type UTCTimestamp = Unbounded UTCTime

57type ZonedTimestamp = Unbounded ZonedTime

50type ZonedTimestamp = Unbounded ZonedTime

58type Date = Unbounded Day

51type Date = Unbounded Day

60−instance FromField UTCTimestamp where

61− fromField = ff PG.TimestampWithTimeZone "UTCTimestamp" parseUTCTimestamp

62−

63−instance FromField ZonedTimestamp where

64− fromField = ff PG.TimestampWithTimeZone "ZonedTimestamp" parseZonedTimestamp

65−

66−instance FromField LocalTimestamp where

67− fromField = ff PG.Timestamp "LocalTimestamp" parseLocalTimestamp

68−

69−instance FromField Date where

70− fromField = ff PG.Date "Date" parseDate

71−

72−ff :: PG.BuiltinType -> String -> (B.ByteString -> Either String a)

73− -> Field -> Maybe B.ByteString -> Ok a

74−ff pgType hsType parse f mstr

75− | typeOid f /= PG.builtin2oid pgType

76− = left (Incompatible (B8.unpack (typename f)) hsType "")

77− | Nothing <- mstr

78− = left (UnexpectedNull (B8.unpack (typename f)) hsType "")

79− | Just str <- mstr

80− = case parse str of

81− Left msg -> left (ConversionFailed (B8.unpack (typename f)) hsType msg)

82− Right val -> pure val

83−{-# INLINE ff #-}

84−

85−left :: Exception err => err -> Ok a

86−left err = Errors [SomeException err]

87−{-# INLINE left #-}

88−

89parseUTCTimestamp :: B.ByteString -> Either String UTCTimestamp

53parseUTCTimestamp :: B.ByteString -> Either String UTCTimestamp

90parseUTCTimestamp = A.parseOnly (getUTCTimestamp <* A.endOfInput)

54parseUTCTimestamp = A.parseOnly (getUTCTimestamp <* A.endOfInput)

@@ -106,7 +70,7 @@ getUnbounded getFinite

106

107getDay :: A.Parser Day

71getDay :: A.Parser Day

108getDay = do

72getDay = do

109− yearStr <- A.takeWhile isDigit

73+ yearStr <- A.takeWhile A.isDigit

110 when (B.length yearStr < 4) (fail "year must consist of at least 4 digits")

74 when (B.length yearStr < 4) (fail "year must consist of at least 4 digits")

111

112 let !year = toNum yearStr

76 let !year = toNum yearStr

@@ -133,7 +97,7 @@ getTimeOfDay = do

133 minute <- digits "minutes"

97 minute <- digits "minutes"

134 _ <- A.char ':'

98 _ <- A.char ':'

135 second <- digits "seconds"

99 second <- digits "seconds"

136− subsec <- (A.char '.' *> (decimal <$> A.takeWhile1 isDigit)) <|> return 0

100+ subsec <- (A.char '.' *> (decimal <$> A.takeWhile1 A.isDigit)) <|> return 0

137

101

138 let !picos' = second + subsec

102 let !picos' = second + subsec

139

103

@@ -186,7 +150,7 @@ digits :: Num n => String -> A.Parser n

186digits msg = do

150digits msg = do

187 x <- A.anyChar

151 x <- A.anyChar

188 y <- A.anyChar

152 y <- A.anyChar

189− if isDigit x && isDigit y

153+ if A.isDigit x && A.isDigit y

190 then return $! (10 * digit (c2w x) + digit (c2w y))

154 then return $! (10 * digit (c2w x) + digit (c2w y))

191 else fail (msg ++ " is not 2 digits")

155 else fail (msg ++ " is not 2 digits")

192{-# INLINE digits #-}

156{-# INLINE digits #-}