5f230ed · typeable/aeson

Data/Aeson/Encoding/Builder.hs+7−6

compare with master

unifiedsplit

@@ -193,12 +193,13 @@ day dd = encodeYear yr <>

193 !(T dh dl) = twoDigits d

194 encodeYear y

195 | y >= 1000 = B.integerDec y

196− | y > 0 =

196+ | y >= 0 = BP.primBounded (ascii4 (padYear y)) ()

197+ | y >= -999 = BP.primBounded (ascii5 ('-',padYear (- y))) ()

198+ | otherwise = B.integerDec y

199+ padYear y =

197− let (ab,c) = fromIntegral y `quotRem` 10

200+ let (ab,c) = fromIntegral y `quotRem` 10

198− (a,b) = ab `quotRem` 10

201+ (a,b) = ab `quotRem` 10

199− in BP.primBounded (ascii4 ('0',(digit a,(digit b,digit c)))) ()

202+ in ('0',(digit a,(digit b,digit c)))

200− | otherwise =

201− error "Data.Aeson.Encode.Builder.day: years BCE not supported"

202{-# INLINE day #-}

203{-# INLINE day #-}

203

204

204timeOfDay :: TimeOfDay -> Builder

205timeOfDay :: TimeOfDay -> Builder

Data/Aeson/Parser/Time.hs+4−2

@@ -25,6 +25,7 @@ module Data.Aeson.Parser.Time

25import Prelude ()

26import Prelude.Compat

27

28+import Control.Applicative ((<|>))

28import Control.Monad (void, when)

29import Control.Monad (void, when)

29import Data.Aeson.Internal.Time (toPico)

30import Data.Aeson.Internal.Time (toPico)

30import Data.Attoparsec.Text as A

31import Data.Attoparsec.Text as A

@@ -46,13 +47,14 @@ run p t = case A.parseOnly (p <* endOfInput) t of

46 Left err -> fail $ "could not parse date: " ++ err

47 Left err -> fail $ "could not parse date: " ++ err

47 Right r -> return r

48 Right r -> return r

48

49

49−-- | Parse a date of the form @YYYY-MM-DD@.

50+-- | Parse a date of the form @[+,-]YYYY-MM-DD@.

50day :: Parser Day

51day :: Parser Day

51day = do

52day = do

53+ absOrNeg <- negate <$ char '-' <|> id <$ char '+' <|> pure id

52 y <- decimal <* char '-'

54 y <- decimal <* char '-'

53 m <- twoDigits <* char '-'

55 m <- twoDigits <* char '-'

54 d <- twoDigits

56 d <- twoDigits

55− maybe (fail "invalid date") return (fromGregorianValid y m d)

57+ maybe (fail "invalid date") return (fromGregorianValid (absOrNeg y) m d)

56

58

57-- | Parse a two-digit integer (e.g. day of month, hour).

59-- | Parse a two-digit integer (e.g. day of month, hour).

58twoDigits :: Parser Int

60twoDigits :: Parser Int

changelog.md+1

@@ -27,6 +27,7 @@ categorised as follows:

27 states that control characters must be escaped. (This may change at

28 some point, but doesn't seem important.)

29

30+- Days BCE are properly encoded.

30

31

31#### 1.0.2.1

32#### 1.0.2.1

32

33

tests/Properties.hs+1

@@ -203,6 +203,7 @@ tests = testGroup "properties" [

203 , testProperty "Lazy Text" $ roundTripEq LT.empty

204 , testProperty "Foo" $ roundTripEq (undefined :: Foo)

205 , testProperty "Day" $ roundTripEq (undefined :: Day)

206+ , testProperty "BCE Day" $ roundTripEq (undefined :: BCEDay)

206 , testProperty "DotNetTime" $ roundTripEq (undefined :: Approx DotNetTime)

207 , testProperty "DotNetTime" $ roundTripEq (undefined :: Approx DotNetTime)

207 , testProperty "LocalTime" $ roundTripEq (undefined :: LocalTime)

208 , testProperty "LocalTime" $ roundTripEq (undefined :: LocalTime)

208 , testProperty "TimeOfDay" $ roundTripEq (undefined :: TimeOfDay)

209 , testProperty "TimeOfDay" $ roundTripEq (undefined :: TimeOfDay)

tests/Types.hs+19−1

@@ -15,9 +15,11 @@ import Data.Data

15import Data.Functor.Compose (Compose (..))

16import Data.Functor.Identity (Identity (..))

17import Data.Text

18+import Data.Time (Day (..), fromGregorian)

18import GHC.Generics

19import GHC.Generics

19−import Test.QuickCheck (Property, counterexample)

20+import Test.QuickCheck (Arbitrary (..), Property, counterexample)

20import qualified Data.Map as Map

21import qualified Data.Map as Map

22+import Data.Aeson

21

23

22type I = Identity

24type I = Identity

23type Compose3 f g h = Compose (Compose f g) h

25type Compose3 f g h = Compose (Compose f g) h

@@ -115,3 +117,19 @@ deriving instance Generic EitherTextInt

115failure :: Show a => String -> String -> a -> Property

117failure :: Show a => String -> String -> a -> Property

116failure func msg v = counterexample

118failure func msg v = counterexample

117 (func ++ " failed: " ++ msg ++ ", " ++ show v) False

119 (func ++ " failed: " ++ msg ++ ", " ++ show v) False

120+

121+newtype BCEDay = BCEDay Day

122+ deriving (Eq, Show)

123+

124+zeroDay :: Day

125+zeroDay = fromGregorian 0 0 0

126+

127+instance Arbitrary BCEDay where

128+ arbitrary = fmap (BCEDay . ModifiedJulianDay . (+ toModifiedJulianDay zeroDay)) arbitrary

129+

130+instance ToJSON BCEDay where

131+ toJSON (BCEDay d) = toJSON d

132+ toEncoding (BCEDay d) = toEncoding d

133+

134+instance FromJSON BCEDay where

135+ parseJSON = fmap BCEDay . parseJSON

tests/UnitTests.hs+9−1

@@ -43,7 +43,7 @@ import Data.Scientific (Scientific)

43import Data.Sequence (Seq)

44import Data.Tagged (Tagged(..))

45import Data.Text (Text)

46−import Data.Time (UTCTime)

46+import Data.Time (UTCTime, fromGregorian)

47import Data.Time.Format (parseTime)

48import Data.Time.Locale.Compat (defaultTimeLocale)

49import Data.Word (Word8)

@@ -331,6 +331,8 @@ jsonDecodingExamples = [

331 , MaybeExample "Word8 3.14" "3.14" (Nothing :: Maybe Word8)

332 , MaybeExample "Word8 -1" "-1" (Nothing :: Maybe Word8)

333 , MaybeExample "Word8 300" "300" (Nothing :: Maybe Word8)

334+ -- Negative zero year, encoding never produces such:

335+ , MaybeExample "Day -0000-02-03" "\"-0000-02-03\"" (Just (fromGregorian 0 2 3))

334 ]

336 ]

335

337

336jsonExamples :: [Example]

338jsonExamples :: [Example]

@@ -396,6 +398,12 @@ jsonExamples =

396 , Example "Maybe String" "\"foo\"" (pure "foo" :: Maybe String)

398 , Example "Maybe String" "\"foo\"" (pure "foo" :: Maybe String)

397 , Example "Maybe [Identity Char]" "\"xy\"" (pure [pure 'x', pure 'y'] :: Maybe [Identity Char])

399 , Example "Maybe [Identity Char]" "\"xy\"" (pure [pure 'x', pure 'y'] :: Maybe [Identity Char])

398

400

401+ , Example "Day; year >= 1000" "\"1999-10-12\"" (fromGregorian 1999 10 12)

402+ , Example "Day; year > 0 && < 1000" "\"0500-03-04\"" (fromGregorian 500 3 4)

403+ , Example "Day; year == 0" "\"0000-02-20\"" (fromGregorian 0 2 20)

404+ , Example "Day; year < 0" "\"-0234-01-01\"" (fromGregorian (-234) 1 1)

405+ , Example "Day; year < -1000" "\"-1234-01-01\"" (fromGregorian (-1234) 1 1)

406+

399 , Example "Product I Maybe Int" "[1,2]" (Pair (pure 1) (pure 2) :: Product I Maybe Int)

407 , Example "Product I Maybe Int" "[1,2]" (Pair (pure 1) (pure 2) :: Product I Maybe Int)

400 , Example "Product I Maybe Int" "[1,null]" (Pair (pure 1) Nothing :: Product I Maybe Int)

408 , Example "Product I Maybe Int" "[1,null]" (Pair (pure 1) Nothing :: Product I Maybe Int)

401 , Example "Product I [] Char" "[\"a\",\"foo\"]" (Pair (pure 'a') "foo" :: Product I [] Char)

409 , Example "Product I [] Char" "[\"a\",\"foo\"]" (Pair (pure 'a') "foo" :: Product I [] Char)