Drop pre-GHC-7.8 support (haskell#743)

This commit makes only non-breaking cleanups. Stricter lower-bounds for

- __GLASGOW_HASKELL__
- base
- bytestring
- template-haskell

Allows to remove some CPP

.travis.yml

@@ -65,14 +65,6 @@ matrix:
       compiler: ": #GHC 7.8.4"
       addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
 
-    - env: BUILD=cabal CABALVER=1.18 GHCVER=7.6.3
-      compiler: ": #GHC 7.6.3"
-      addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3], sources: [hvr-ghc]}}
-
-    - env: BUILD=cabal CABALVER=1.18 GHCVER=7.4.2
-      compiler: ": #GHC 7.4.2"
-      addons: {apt: {packages: [cabal-install-1.18,ghc-7.4.2], sources: [hvr-ghc]}}
-
 before_install:
  - unset CC
  - export PATH=$HOME/.local/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH

Data/Aeson/TH.hs

@@ -135,15 +135,8 @@ import Data.Map (Map)
 import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
 import qualified Data.Monoid as Monoid
 import Data.Set (Set)
-#if MIN_VERSION_template_haskell(2,8,0)
 import Language.Haskell.TH hiding (Arity)
-#else
-import Language.Haskell.TH
-#endif
 import Language.Haskell.TH.Datatype
-#if MIN_VERSION_template_haskell(2,7,0) && !(MIN_VERSION_template_haskell(2,8,0))
-import Language.Haskell.TH.Lib (starK)
-#endif
 #if MIN_VERSION_template_haskell(2,8,0) && !(MIN_VERSION_template_haskell(2,10,0))
 import Language.Haskell.TH.Syntax (mkNameG_tc)
 #endif
@@ -1590,21 +1583,13 @@ type TyVarMap = Map Name (Name, Name)
 -- | Returns True if a Type has kind *.
 hasKindStar :: Type -> Bool
 hasKindStar VarT{}         = True
-#if MIN_VERSION_template_haskell(2,8,0)
 hasKindStar (SigT _ StarT) = True
-#else
-hasKindStar (SigT _ StarK) = True
-#endif
 hasKindStar _              = False
 
 -- Returns True is a kind is equal to *, or if it is a kind variable.
 isStarOrVar :: Kind -> Bool
-#if MIN_VERSION_template_haskell(2,8,0)
 isStarOrVar StarT  = True
 isStarOrVar VarT{} = True
-#else
-isStarOrVar StarK  = True
-#endif
 isStarOrVar _      = False
 
 -- Generate a list of fresh names with a common prefix, and numbered suffixes.
@@ -1662,9 +1647,7 @@ isTyFamily (ConT n) = do
 #else
          FamilyI (FamilyD TypeFam _ _ _) _ -> True
 #endif
-#if MIN_VERSION_template_haskell(2,9,0)
          FamilyI ClosedTypeFamilyD{} _     -> True
-#endif
          _ -> False
 isTyFamily _ = return False
 
@@ -1692,9 +1675,7 @@ mentionsName = go
     go :: Type -> [Name] -> Bool
     go (AppT t1 t2) names = go t1 names || go t2 names
     go (SigT t _k)  names = go t names
-#if MIN_VERSION_template_haskell(2,8,0)
                               || go _k names
-#endif
     go (VarT n)     names = n `elem` names
     go _            _     = False
 
@@ -1750,23 +1731,14 @@ uncurryTy t = ([], t :| [])
 
 -- | Like uncurryType, except on a kind level.
 uncurryKind :: Kind -> NonEmpty Kind
-#if MIN_VERSION_template_haskell(2,8,0)
 uncurryKind = snd . uncurryTy
-#else
-uncurryKind (ArrowK k1 k2) = k1 <| uncurryKind k2
-uncurryKind k              = k :| []
-#endif
 
 createKindChain :: Int -> Kind
 createKindChain = go starK
   where
     go :: Kind -> Int -> Kind
     go k 0 = k
-#if MIN_VERSION_template_haskell(2,8,0)
     go k !n = go (AppT (AppT ArrowT StarT) k) (n - 1)
-#else
-    go k !n = go (ArrowK StarK k) (n - 1)
-#endif
 
 -- | Makes a string literal expression from a constructor's name.
 conNameExp :: Options -> ConstructorInfo -> Q Exp
@@ -1820,11 +1792,7 @@ canEtaReduce remaining dropped =
 -------------------------------------------------------------------------------
 
 applySubstitutionKind :: Map Name Kind -> Type -> Type
-#if MIN_VERSION_template_haskell(2,8,0)
 applySubstitutionKind = applySubstitution
-#else
-applySubstitutionKind _ t = t
-#endif
 
 substNameWithKind :: Name -> Kind -> Type -> Type
 substNameWithKind n k = applySubstitutionKind (M.singleton n k)
@@ -1988,9 +1956,7 @@ data StarKindStatus = NotKindStar
 canRealizeKindStar :: Type -> StarKindStatus
 canRealizeKindStar t = case t of
     _ | hasKindStar t -> KindStar
-#if MIN_VERSION_template_haskell(2,8,0)
     SigT _ (VarT k) -> IsKindVar k
-#endif
     _ -> NotKindStar
 
 -- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists.

Data/Aeson/Types/FromJSON.hs

@@ -7,16 +7,13 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
 
-#if __GLASGOW_HASKELL__ >= 706
-{-# LANGUAGE PolyKinds #-}
-#endif
-
 #include "incoherent-compat.h"
 #include "overlapping-compat.h"
 
@@ -120,9 +117,9 @@ import GHC.Generics
 import Numeric.Natural (Natural)
 import Text.ParserCombinators.ReadP (readP_to_S)
 import Unsafe.Coerce (unsafeCoerce)
-import qualified Data.Aeson.Compat as Compat
 import qualified Data.Aeson.Parser.Time as Time
 import qualified Data.Attoparsec.ByteString.Char8 as A (endOfInput, parseOnly, scientific)
+import qualified Data.ByteString.Lazy as L
 import qualified Data.DList as DList
 import qualified Data.HashMap.Strict as H
 import qualified Data.HashSet as HashSet
@@ -157,18 +154,8 @@ import qualified Data.Primitive.UnliftedArray as PM
 import qualified Data.Primitive.PrimArray as PM
 #endif
 
-#ifndef HAS_COERCIBLE
-#define HAS_COERCIBLE (__GLASGOW_HASKELL__ >= 707)
-#endif
 
-#if HAS_COERCIBLE
 import Data.Coerce (Coercible, coerce)
-coerce' :: Coercible a b => a -> b
-coerce' = coerce
-#else
-coerce' :: a -> b
-coerce' = unsafeCoerce
-#endif
 
 parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a
 parseIndexedJSON p idx value = p value <?> Index idx
@@ -440,11 +427,7 @@ class FromJSONKey a where
 -- At the moment this type is intentionally not exported. 'FromJSONKeyFunction'
 -- can be inspected, but cannot be constructed.
 data CoerceText a where
-#if HAS_COERCIBLE
     CoerceText :: Coercible Text a => CoerceText a
-#else
-    CoerceText :: CoerceText a
-#endif
 
 -- | This type is related to 'ToJSONKeyFunction'. If 'FromJSONKeyValue' is used in the
 --   'FromJSONKey' instance, then 'ToJSONKeyValue' should be used in the 'ToJSONKey'
@@ -464,7 +447,7 @@ data FromJSONKeyFunction a
 
 -- | Only law abiding up to interpretation
 instance Functor FromJSONKeyFunction where
-    fmap h (FromJSONKeyCoerce CoerceText) = FromJSONKeyText (h . coerce')
+    fmap h (FromJSONKeyCoerce CoerceText) = FromJSONKeyText (h . coerce)
     fmap h (FromJSONKeyText f)            = FromJSONKeyText (h . f)
     fmap h (FromJSONKeyTextParser f)      = FromJSONKeyTextParser (fmap h . f)
     fmap h (FromJSONKeyValue f)           = FromJSONKeyValue (fmap h . f)
@@ -478,39 +461,26 @@ instance Functor FromJSONKeyFunction where
 --
 -- On pre GHC 7.8 this is unconstrainted function.
 fromJSONKeyCoerce ::
-#if HAS_COERCIBLE
     Coercible Text a =>
-#endif
     FromJSONKeyFunction a
 fromJSONKeyCoerce = FromJSONKeyCoerce CoerceText
 
 -- | Semantically the same as @coerceFromJSONKeyFunction = fmap coerce = coerce@.
 --
 -- See note on 'fromJSONKeyCoerce'.
 coerceFromJSONKeyFunction ::
-#if HAS_COERCIBLE
     Coercible a b =>
-#endif
     FromJSONKeyFunction a -> FromJSONKeyFunction b
-#if HAS_COERCIBLE
 coerceFromJSONKeyFunction = coerce
-#else
-coerceFromJSONKeyFunction (FromJSONKeyCoerce CoerceText) = FromJSONKeyCoerce CoerceText
-coerceFromJSONKeyFunction (FromJSONKeyText f)            = FromJSONKeyText (coerce' . f)
-coerceFromJSONKeyFunction (FromJSONKeyTextParser f)      = FromJSONKeyTextParser (fmap coerce' . f)
-coerceFromJSONKeyFunction (FromJSONKeyValue f)           = FromJSONKeyValue (fmap coerce' . f)
-#endif
 
 {-# RULES
   "FromJSONKeyCoerce: fmap id"     forall (x :: FromJSONKeyFunction a).
                                    fmap id x = x
   #-}
-#if HAS_COERCIBLE
 {-# RULES
   "FromJSONKeyCoerce: fmap coerce" forall x .
                                    fmap coerce x = coerceFromJSONKeyFunction x
   #-}
-#endif
 
 -- | Same as 'fmap'. Provided for the consistency with 'ToJSONKeyFunction'.
 mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b
@@ -797,13 +767,13 @@ withBoundedScientific' f v = withBoundedScientific_ id f v
 -- | A variant of 'withBoundedScientific_' parameterized by a function to apply
 -- to the 'Parser' in case of failure.
 withBoundedScientific_ :: (Parser a -> Parser a) -> (Scientific -> Parser a) -> Value -> Parser a
-withBoundedScientific_ whenFail f v@(Number scientific) =
-    if exponent > 1024
+withBoundedScientific_ whenFail f (Number scientific) =
+    if exp10 > 1024
     then whenFail (fail msg)
     else f scientific
   where
-    exponent = base10Exponent scientific
-    msg = "found a number with exponent " ++ show exponent ++ ", but it must not be greater than 1024"
+    exp10 = base10Exponent scientific
+    msg = "found a number with exponent " ++ show exp10 ++ ", but it must not be greater than 1024"
 withBoundedScientific_ whenFail _ v =
     whenFail (typeMismatch "Number" v)
 {-# INLINE withBoundedScientific_ #-}
@@ -823,7 +793,7 @@ withBool name _ v          = prependContext name (typeMismatch "Boolean" v)
 -- | Decode a nested JSON-encoded string.
 withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a
 withEmbeddedJSON _ innerParser (String txt) =
-    either fail innerParser $ eitherDecode (Compat.fromStrict $ T.encodeUtf8 txt)
+    either fail innerParser $ eitherDecode (L.fromStrict $ T.encodeUtf8 txt)
     where
         eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON
         eitherFormatError = either (Left . uncurry formatError) Right
@@ -1991,7 +1961,6 @@ instance FromJSON DotNetTime where
 -- primitive
 -------------------------------------------------------------------------------
 
-#if MIN_VERSION_base(4,7,0)
 instance FromJSON a => FromJSON (PM.Array a) where
   -- note: we could do better than this if vector exposed the data
   -- constructor in Data.Vector.
@@ -2009,7 +1978,6 @@ instance (PM.PrimUnlifted a,FromJSON a) => FromJSON (PM.UnliftedArray a) where
   parseJSON = fmap Exts.fromList . parseJSON
 #endif
 #endif
-#endif
 
 -------------------------------------------------------------------------------
 -- time

Data/Aeson/Types/ToJSON.hs

@@ -8,15 +8,12 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-#if __GLASGOW_HASKELL__ >= 706
-{-# LANGUAGE PolyKinds #-}
-#endif
-
 #include "overlapping-compat.h"
 #include "incoherent-compat.h"
 
@@ -144,14 +141,6 @@ import qualified Data.Primitive.UnliftedArray as PM
 import qualified Data.Primitive.PrimArray as PM
 #endif
 
-#if !(MIN_VERSION_bytestring(0,10,0))
-import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Marshal.Utils (copyBytes)
-import Foreign.Ptr (plusPtr)
-import qualified Data.ByteString.Internal as S
-import qualified Data.ByteString.Lazy.Internal as L
-#endif
-
 toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
 toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)
 {-# INLINE toJSONPair #-}
@@ -515,7 +504,7 @@ toJSONKeyTextEnc e = ToJSONKeyText tot e
     -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm
     tot = T.dropAround (== '"')
         . T.decodeLatin1
-        . lazyToStrictByteString
+        . L.toStrict
         . E.encodingToLazyByteString
         . e
 
@@ -1982,7 +1971,6 @@ formatMillis = take 3 . formatTime defaultTimeLocale "%q"
 -- primitive
 -------------------------------------------------------------------------------
 
-#if MIN_VERSION_base(4,7,0)
 instance ToJSON a => ToJSON (PM.Array a) where
   -- note: we could do better than this if vector exposed the data
   -- constructor in Data.Vector.
@@ -2004,7 +1992,6 @@ instance (PM.PrimUnlifted a,ToJSON a) => ToJSON (PM.UnliftedArray a) where
   toEncoding = toEncoding . Exts.toList
 #endif
 #endif
-#endif
 
 -------------------------------------------------------------------------------
 -- time
@@ -2054,7 +2041,7 @@ stringEncoding :: Encoding' Text -> Value
 stringEncoding = String
     . T.dropAround (== '"')
     . T.decodeLatin1
-    . lazyToStrictByteString
+    . L.toStrict
     . E.encodingToLazyByteString
 {-# INLINE stringEncoding #-}
 
@@ -2861,31 +2848,6 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g,
     toEncoding = toEncoding2
     {-# INLINE toEncoding #-}
 
--------------------------------------------------------------------------------
--- pre-bytestring-0.10 compatibility
--------------------------------------------------------------------------------
-
-{-# INLINE lazyToStrictByteString #-}
-lazyToStrictByteString :: L.ByteString -> S.ByteString
-#if MIN_VERSION_bytestring(0,10,0)
-lazyToStrictByteString = L.toStrict
-#else
-lazyToStrictByteString = packChunks
-
--- packChunks is taken from the blaze-builder package.
-
--- | Pack the chunks of a lazy bytestring into a single strict bytestring.
-packChunks :: L.ByteString -> S.ByteString
-packChunks lbs =
-    S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)
-  where
-    copyChunks L.Empty                         _pf = return ()
-    copyChunks (L.Chunk (S.PS fpbuf o l) lbs') pf  = do
-        withForeignPtr fpbuf $ \pbuf ->
-            copyBytes pf (pbuf `plusPtr` o) l
-        copyChunks lbs' (pf `plusPtr` l)
-#endif
-
 --------------------------------------------------------------------------------
 
 -- | Wrap a list of pairs as an object.