2062ea5 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

A bit of reorganization

commit2062ea5fee6eb7dc5b3088223ba2c4764c6018da authorLeon P Smith <leon@melding-monads.com> dateSat 2 Jun 2012, 04:41 (14 years ago) parentfcc8720

3 files changed+32−44

compare with master

unifiedsplit

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

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

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

6161import Database.PostgreSQL.Simple.BuiltinTypes

6262import Database.PostgreSQL.Simple.Ok

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

64+import Database.PostgreSQL.Simple.Time

6465import qualified Database.PostgreSQL.LibPQ as PQ

6566import System.IO.Unsafe (unsafePerformIO)

6667import System.Locale (defaultTimeLocale)

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

240241 Just t -> return (pure t)

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

242243

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+

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

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

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

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

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

77-- Stability: experimental

88--

99-- 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

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

1212--

1313------------------------------------------------------------------------------

1414

15−{-# LANGUAGE DeriveDataTypeable #-}

16−{-# LANGUAGE ScopedTypeVariables #-}

17−

1815module Database.PostgreSQL.Simple.Time

1916 ( Unbounded(..)

2017 , UTCTimestamp

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

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

88--

99------------------------------------------------------------------------------

1010

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

11+{-# LANGUAGE DeriveDataTypeable #-}

1212

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

1414

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

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

1818import Control.Arrow((***))

1919import Control.Applicative

20−import Control.Exception

2120import Control.Monad(when)

2221import Data.Bits((.&.))

2322import qualified Data.ByteString as B

24−import qualified Data.ByteString.Char8 as B8

2523import Data.ByteString.Internal (c2w)

26−import Data.Char

2724import Data.Time hiding (getTimeZone, getZonedTime)

2825import Data.Typeable

2926import Data.Word(Word8)

3027import 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

3528

3629data Unbounded a

3730 = NegInfinity

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

5750type ZonedTimestamp = Unbounded ZonedTime

5851type Date = Unbounded Day

5952

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−

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

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

9155

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

10670

10771getDay :: A.Parser Day

10872getDay = do

109− yearStr <- A.takeWhile isDigit

73+ yearStr <- A.takeWhile A.isDigit

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

11175

11276 let !year = toNum yearStr

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

13397 minute <- digits "minutes"

13498 _ <- A.char ':'

13599 second <- digits "seconds"

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

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

137101

138102 let !picos' = second + subsec

139103

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

186150digits msg = do

187151 x <- A.anyChar

188152 y <- A.anyChar

189− if isDigit x && isDigit y

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

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

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

192156{-# INLINE digits #-}