Skip to content
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.

Commit 6dca6d5

Browse files
author
Poscat
committedFeb 18, 2021
Make indicies start from 0
1 parent 8f92dbf commit 6dca6d5

File tree

4 files changed

+10
-10
lines changed

4 files changed

+10
-10
lines changed
 

‎src/Data/Aeson/TH.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -443,7 +443,7 @@ argsToValue target jc tvMap opts multiCons
443443
let len = length argTys'
444444
args <- newNameList "arg" len
445445
let os = zipWith (\arg argTy -> dispatchToJSON target jc conName tvMap argTy `appE` varE arg) args argTys'
446-
pairs = zip (fmap (show :: Int -> String) [1..]) os
446+
pairs = zip (fmap (show :: Int -> String) [0..]) os
447447
obj = objectE (tag : pairs)
448448
match (conP conName $ map varP args)
449449
(normalB obj)
@@ -526,7 +526,7 @@ argsToValue target jc tvMap opts multiCons
526526
ar <- newName "argR"
527527
let tag = (tagFieldName, conStr target opts conName)
528528
os = zipWith (\arg argTy -> dispatchToJSON target jc conName tvMap argTy `appE` varE arg) [al, ar] [alTy, arTy]
529-
pairs = zip (fmap (show :: Int -> String) [1..]) os
529+
pairs = zip (fmap (show :: Int -> String) [0..]) os
530530
obj = objectE (tag : pairs)
531531
match (infixP (varP al) conName (varP ar))
532532
(normalB obj)

‎src/Data/Aeson/Types/FromJSON.hs

+5-5
Original file line numberDiff line numberDiff line change
@@ -1123,14 +1123,14 @@ parseNonAllNullarySum p@(tname :* opts :* _) =
11231123
", but found tag " ++ show tag
11241124
cnames_ = unTagged2 (constructorTags (constructorTagModifier opts) :: Tagged2 f [String])
11251125

1126-
TaggedFlatObject{..} ->
1126+
TaggedFlatObject{..} ->
11271127
withObject tname $ \obj -> do
11281128
let tagKey = pack tagFieldName
11291129
badTag tag = failWith_ $ \cnames ->
11301130
"expected tag field to be one of " ++ show cnames ++
11311131
", but found tag " ++ show tag
11321132
cnames_ = unTagged2 (constructorTags (constructorTagModifier opts) :: Tagged2 f [String])
1133-
tag <- contextType tname . contextTag tagKey cnames_ $ obj .: tagKey
1133+
tag <- contextType tname . contextTag tagKey cnames_ $ obj .: tagKey
11341134
fromMaybe (badTag tag <?> Key tagKey) $
11351135
parseTaggedFlatObject (tag :* p) obj
11361136

@@ -1454,9 +1454,9 @@ instance (RecordFromJSON arity f, FieldNames f) => FromTaggedFlatObject' arity f
14541454
instance FromTaggedFlatObject' arity U1 False where
14551455
parseTaggedFlatObject' _ _ = Tagged (pure U1)
14561456

1457-
instance OVERLAPPABLE_ PositionFromObject 1 arity f => FromTaggedFlatObject' arity f False where
1458-
parseTaggedFlatObject' (_ :* p) obj = Tagged (positionFromObject (Proxy :: Proxy 1) p obj)
1459-
1457+
instance OVERLAPPABLE_ PositionFromObject 0 arity f => FromTaggedFlatObject' arity f False where
1458+
parseTaggedFlatObject' (_ :* p) obj = Tagged (positionFromObject (Proxy :: Proxy 0) p obj)
1459+
14601460
class KnownNat n => PositionFromObject n arity f where
14611461
positionFromObject :: Proxy n
14621462
-> TypeName :* Options :* FromArgs arity a

‎src/Data/Aeson/Types/Internal.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -711,7 +711,7 @@ data SumEncoding =
711711
-- in that data type with an additional field '$tagFieldName'.
712712
-- For example, given @A@ defined as
713713
-- @data A = A Int Int | B@,
714-
-- this option will encode @A 1 2@ as @{"1": 1, "2": 2, "$tagFieldName": \"A"}@
714+
-- this option will encode @A 1 2@ as @{"0": 1, "1": 2, "$tagFieldName": \"A"}@
715715
-- 5. The behavior is undefined when the '$tagFieldName' collides with another field name and should
716716
-- not be relied upon. It may or may not overwite the field.
717717
-- It may or may not throw an runtime exception. It may or may not raise an compile time error.

‎src/Data/Aeson/Types/ToJSON.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -954,8 +954,8 @@ instance RecordToPairs pairs enc arity f => TaggedFlatObject' pairs enc arity f
954954
instance Monoid pairs => TaggedFlatObject' enc pairs arity U1 False where
955955
taggedFlatObject' _ _ _ = Tagged mempty
956956

957-
instance OVERLAPPABLE_ PositionToPairs 1 pairs enc arity f => TaggedFlatObject' enc pairs arity f False where
958-
taggedFlatObject' opts targs a = Tagged $ positionToPairs (Proxy :: Proxy 1) opts targs a
957+
instance OVERLAPPABLE_ PositionToPairs 0 pairs enc arity f => TaggedFlatObject' enc pairs arity f False where
958+
taggedFlatObject' opts targs a = Tagged $ positionToPairs (Proxy :: Proxy 0) opts targs a
959959

960960
class KnownNat n => PositionToPairs n pairs enc arity f where
961961
positionToPairs :: Proxy n -> Options -> ToArgs enc arity a -> f a -> pairs

0 commit comments

Comments
 (0)
Please sign in to comment.