Resolve haskell#351

sjakobi · Feb 3, 2016 · 0718860 · 0718860
1 parent fdb8672
commit 0718860
Show file tree

Hide file tree

Showing 3 changed files with 27 additions and 2 deletions.
diff --git a/Data/Aeson/Types/Instances.hs b/Data/Aeson/Types/Instances.hs
@@ -4,6 +4,7 @@
     ViewPatterns #-}
 {-# LANGUAGE DefaultSignatures #-}
 
+#define NEEDS_INCOHERENT
 #include "overlapping-compat.h"
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -221,14 +222,14 @@ instance FromJSON () where
                     else fail "Expected an empty array"
     {-# INLINE parseJSON #-}
 
-instance ToJSON [Char] where
+instance INCOHERENT_ ToJSON [Char] where
     toJSON = String . T.pack
     {-# INLINE toJSON #-}
 
     toEncoding = Encoding . E.string
     {-# INLINE toEncoding #-}
 
-instance FromJSON [Char] where
+instance INCOHERENT_ FromJSON [Char] where
     parseJSON = withText "String" $ pure . T.unpack
     {-# INLINE parseJSON #-}
 

diff --git a/include/overlapping-compat.h b/include/overlapping-compat.h
@@ -1,8 +1,15 @@
 #if __GLASGOW_HASKELL__ >= 710
 #define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
 #define OVERLAPPING_  {-# OVERLAPPING #-}
+#ifdef NEEDS_INCOHERENT
+#define INCOHERENT_ {-# INCOHERENT #-}
+#endif
 #else
 {-# LANGUAGE OverlappingInstances #-}
 #define OVERLAPPABLE_
 #define OVERLAPPING_
+#ifdef NEEDS_INCOHERENT
+{-# LANGUAGE IncoherentInstances #-}
+#define INCOHERENT_
+#endif
 #endif
diff --git a/tests/UnitTests.hs b/tests/UnitTests.hs
@@ -10,6 +10,7 @@ import Data.Aeson.Encode (encodeToTextBuilder)
 import Data.Aeson.TH (deriveJSON)
 import Data.Aeson.Types (ToJSON(..), Value, camelTo, camelTo2, defaultOptions, omitNothingFields)
 import Data.Char (toUpper)
+import Data.Maybe (fromMaybe)
 import Data.Time (UTCTime)
 import Data.Time.Format (parseTime)
 import GHC.Generics (Generic)
@@ -52,6 +53,7 @@ tests = testGroup "unit" [
   , testGroup ".:, .:?, .:!" $ fmap (testCase "-") dotColonMark
   , testGroup "To JSON representation" $ fmap (testCase "-") jsonEncoding
   , testGroup "From JSON representation" $ fmap (testCase "-") jsonDecoding
+  , testGroup "Issue #351" $ fmap (testCase "-") issue351
   ]
 
 roundTripCamel :: String -> Assertion
@@ -218,6 +220,21 @@ jsonDecoding = [
   , assertEqual "Just Nothing" (Just Nothing :: Maybe (Maybe Int)) (decode "null")
   ]
 
+------------------------------------------------------------------------------
+-- Regressions
+------------------------------------------------------------------------------
+
+-- A regression test for: https://github.com/bos/aeson/issues/351
+overlappingRegression :: FromJSON a => L.ByteString -> [a]
+overlappingRegression bs = fromMaybe [] $ decode bs
+
+issue351 :: [Assertion]
+issue351 = [
+    assertEqual "Int"  ([1, 2, 3] :: [Int])  $ overlappingRegression "[1, 2, 3]"
+  , assertEqual "Char" (""        :: String) $ overlappingRegression "\"abc\""
+  , assertEqual "Char" ("abc"     :: String) $ overlappingRegression "[\"a\", \"b\", \"c\"]"
+  ]
+
 ------------------------------------------------------------------------------
 -- Comparison between bytestring and text encoders
 ------------------------------------------------------------------------------