Accumulate DList errors

haskell · Dec 25, 2017 · 584135e · 584135e
1 parent 7bcf368
commit 584135e
Show file tree

Hide file tree

Showing 3 changed files with 12 additions and 1 deletion.
diff --git a/Data/Aeson/AccParser.hs b/Data/Aeson/AccParser.hs
@@ -8,6 +8,9 @@ module Data.Aeson.AccParser
   , (<*>+)
   ) where
 
+import Prelude ()
+import Prelude.Compat
+
 import Data.Aeson.Types.Internal (Parser (..), runParser)
 import Data.List.NonEmpty (NonEmpty ((:|)))
 import qualified Data.List.NonEmpty as NonEmpty

diff --git a/Data/Aeson/Types/FromJSON.hs b/Data/Aeson/Types/FromJSON.hs
@@ -1439,7 +1439,7 @@ instance FromJSON Scientific where
 instance FromJSON1 DList.DList where
     liftParseJSON p _ = withArray "DList a" $
       fmap DList.fromList .
-      Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList
+      accSequence . zipWith (parseIndexedJSON p) [0..] . V.toList
     {-# INLINE liftParseJSON #-}
 
 instance (FromJSON a) => FromJSON (DList.DList a) where

diff --git a/tests/UnitTests/AccErrors.hs b/tests/UnitTests/AccErrors.hs
@@ -6,6 +6,7 @@ import Prelude ()
 import Prelude.Compat hiding (seq)
 
 import Data.Aeson
+import Data.DList (DList)
 import Data.Aeson.Parser.Internal
 import Data.Aeson.Types ()
 import Data.Aeson.Internal
@@ -24,6 +25,7 @@ tests = testGroup "Error accumulation" [
       testCase "Seq" seq
     , testCase "Vector" vector
     , testCase "NonEmpty" nonEmpty
+    , testCase "DList" dlist
     ]
 
 decoder :: FromJSON a
@@ -48,3 +50,9 @@ nonEmpty = do
     let res = decoder "[true, null]" :: Either (NonEmpty (JSONPath, String)) (NL.NonEmpty Int)
     let message i s = ([Index i], "expected Int, encountered " <> s)
     res @=? Left (NL.fromList [message 0 "Boolean", message 1 "Null"])
+
+dlist :: Assertion
+dlist = do
+    let res = decoder "[true, null]" :: Either (NonEmpty (JSONPath, String)) (DList Int)
+    let message i s = ([Index i], "expected Int, encountered " <> s)
+    res @=? Left (NL.fromList [message 0 "Boolean", message 1 "Null"])