diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,8 @@ +## 5.2.3 [2024-06-12] + +* Support GHC-9.10. +* Drop support for GHC-7.10 and earlier. + ## 5.2.2.5 [2023-10-14] * Support GHC-9.6 and GHC-9.8 diff --git a/include/recursion-schemes-common.h b/include/recursion-schemes-common.h deleted file mode 100644 --- a/include/recursion-schemes-common.h +++ /dev/null @@ -1,28 +0,0 @@ -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif - -#ifndef MIN_VERSION_transformers -#define MIN_VERSION_transformers(x,y,z) 1 -#endif - -#ifndef MIN_VERSION_transformers_compat -#define MIN_VERSION_transformers_compat(x,y,z) 0 -#endif - - -#if MIN_VERSION_base(4,9,0) -#define LIFTED_FUNCTOR_CLASSES 1 - -#elif MIN_VERSION_transformers(0,5,0) -#define LIFTED_FUNCTOR_CLASSES 1 - -#elif MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0) -#define LIFTED_FUNCTOR_CLASSES 1 -#endif - - -#define HAS_GENERIC (__GLASGOW_HASKELL__ >= 702) -#define HAS_GENERIC1 (__GLASGOW_HASKELL__ >= 706) - -#define HAS_POLY_TYPEABLE MIN_VERSION_base(4,7,0) diff --git a/recursion-schemes.cabal b/recursion-schemes.cabal --- a/recursion-schemes.cabal +++ b/recursion-schemes.cabal @@ -1,6 +1,6 @@ name: recursion-schemes category: Control, Recursion -version: 5.2.2.5 +version: 5.2.3 license: BSD2 cabal-version: 1.18 license-file: LICENSE @@ -15,11 +15,11 @@ synopsis: Representing common recursion patterns as higher-order functions description: Many recursive functions share the same structure, e.g. pattern-match on the input and, depending on the data constructor, either recur on a smaller input or terminate the recursion with the base case. Another one: start with a seed value, use it to produce the first element of an infinite list, and recur on a modified seed in order to produce the rest of the list. Such a structure is called a recursion scheme. Using higher-order functions to implement those recursion schemes makes your code clearer, faster, and safer. See README for details. -tested-with: GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.4, GHC==8.10.7, GHC==9.0.1, GHC==9.2.1, GHC==9.4.1, GHC==9.6.2, GHC==9.8.1 +tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.4, GHC==8.10.7, GHC==9.0.2, GHC==9.2.8, GHC==9.4.8, GHC==9.6.5, GHC==9.8.2, GHC==9.10.1 build-type: Simple extra-doc-files: docs/github-compression.png docs/flowchart.svg -extra-source-files: CHANGELOG.markdown .gitignore README.markdown include/recursion-schemes-common.h +extra-source-files: CHANGELOG.markdown .gitignore README.markdown source-repository head type: git @@ -42,40 +42,18 @@ UndecidableInstances hs-source-dirs: src - include-dirs: include - -- includes: recursion-schemes-common.h build-depends: - base >= 4.5 && < 5, - containers >= 0.4.2.1 && < 0.7, + base >= 4.9 && < 5, + containers >= 0.4.2.1 && < 0.8, comonad >= 4 && < 6, data-fix >= 0.3.0 && < 0.4, free >= 4 && < 6, - transformers >= 0.3.0.0 && < 1 + transformers >= 0.4.2.0 && < 1 if !impl(ghc >= 8.2) build-depends: bifunctors >= 4 && < 6 - if !impl(ghc >= 8.0) - build-depends: semigroups >= 0.10 && < 1 - - if impl(ghc < 7.5) - build-depends: ghc-prim - - -- Following two conditionals aren't inverses (there are other compilers than GHC) - -- - -- We enforce the fact that with GHC-7.10 - -- we have at least transformers-0.4.2.0 (the bundled one) - -- which has 'Data.Functor.Classes' module. (transformers-0.3 doesn't have) - if impl(ghc >= 7.10) - build-depends: - transformers >= 0.4.2.0 - - if !impl(ghc >= 7.10) - build-depends: - nats, - transformers-compat >= 0.3 && < 1 - -- Foldable module is first, so cabal repl loads it! exposed-modules: Data.Functor.Foldable @@ -83,8 +61,8 @@ if flag(template-haskell) build-depends: - template-haskell >= 2.5.0.0 && < 2.22, - th-abstraction >= 0.4 && < 0.7 + template-haskell >= 2.11.0.0 && < 2.23, + th-abstraction >= 0.4 && < 0.8 exposed-modules: Data.Functor.Foldable.TH @@ -108,5 +86,3 @@ recursion-schemes, template-haskell, transformers >= 0.2 && < 1 - if impl(ghc < 7.5) - build-depends: ghc-prim diff --git a/src/Data/Functor/Base.hs b/src/Data/Functor/Base.hs --- a/src/Data/Functor/Base.hs +++ b/src/Data/Functor/Base.hs @@ -1,12 +1,5 @@ -{-# LANGUAGE CPP #-} -#include "recursion-schemes-common.h" - -#ifdef __GLASGOW_HASKELL__ -{-# LANGUAGE DeriveDataTypeable #-} -#if HAS_GENERIC {-# LANGUAGE DeriveGeneric #-} -#endif -#endif +{-# LANGUAGE DeriveTraversable #-} -- | Base Functors for standard types not already expressed as a fixed point. module Data.Functor.Base @@ -15,24 +8,14 @@ , TreeF (..), ForestF, ) where -#ifdef __GLASGOW_HASKELL__ -import Data.Data (Typeable) -#if HAS_GENERIC -import GHC.Generics (Generic) -#endif -#if HAS_GENERIC1 -import GHC.Generics (Generic1) -#endif -#endif +import GHC.Generics (Generic, Generic1) import Control.Applicative import Data.Monoid import Data.Functor.Classes ( Eq1(..), Ord1(..), Show1(..), Read1(..) -#ifdef LIFTED_FUNCTOR_CLASSES , Eq2(..), Ord2(..), Show2(..), Read2(..) -#endif ) import qualified Data.Foldable as F @@ -50,16 +33,8 @@ -- | Base functor of @[]@. data ListF a b = Nil | Cons a b - deriving (Eq,Ord,Show,Read,Typeable -#if HAS_GENERIC - , Generic -#endif -#if HAS_GENERIC1 - , Generic1 -#endif - ) + deriving (Eq,Ord,Show,Read,Generic,Generic1,Functor,F.Foldable,T.Traversable) -#ifdef LIFTED_FUNCTOR_CLASSES instance Eq2 ListF where liftEq2 _ _ Nil Nil = True liftEq2 f g (Cons a b) (Cons a' b') = f a a' && g b b' @@ -103,26 +78,6 @@ instance Read a => Read1 (ListF a) where liftReadsPrec = liftReadsPrec2 readsPrec readList -#else -instance Eq a => Eq1 (ListF a) where eq1 = (==) -instance Ord a => Ord1 (ListF a) where compare1 = compare -instance Show a => Show1 (ListF a) where showsPrec1 = showsPrec -instance Read a => Read1 (ListF a) where readsPrec1 = readsPrec -#endif - --- These instances cannot be auto-derived on with GHC <= 7.6 -instance Functor (ListF a) where - fmap _ Nil = Nil - fmap f (Cons a b) = Cons a (f b) - -instance F.Foldable (ListF a) where - foldMap _ Nil = Data.Monoid.mempty - foldMap f (Cons _ b) = f b - -instance T.Traversable (ListF a) where - traverse _ Nil = pure Nil - traverse f (Cons a b) = Cons a <$> f b - instance Bi.Bifunctor ListF where bimap _ _ Nil = Nil bimap f g (Cons a b) = Cons (f a) (g b) @@ -141,16 +96,8 @@ -- | Base Functor for 'Data.List.NonEmpty' data NonEmptyF a b = NonEmptyF { head :: a, tail :: Maybe b } - deriving (Eq,Ord,Show,Read,Typeable -#if HAS_GENERIC - , Generic -#endif -#if HAS_GENERIC1 - , Generic1 -#endif - ) + deriving (Eq,Ord,Show,Read,Generic,Generic1,Functor,F.Foldable,T.Traversable) -#ifdef LIFTED_FUNCTOR_CLASSES instance Eq2 NonEmptyF where liftEq2 f g (NonEmptyF a mb) (NonEmptyF a' mb') = f a a' && liftEq g mb mb' @@ -185,23 +132,6 @@ instance Read a => Read1 (NonEmptyF a) where liftReadsPrec = liftReadsPrec2 readsPrec readList -#else -instance Eq a => Eq1 (NonEmptyF a) where eq1 = (==) -instance Ord a => Ord1 (NonEmptyF a) where compare1 = compare -instance Show a => Show1 (NonEmptyF a) where showsPrec1 = showsPrec -instance Read a => Read1 (NonEmptyF a) where readsPrec1 = readsPrec -#endif - --- These instances cannot be auto-derived on with GHC <= 7.6 -instance Functor (NonEmptyF a) where - fmap f = NonEmptyF <$> head <*> (fmap f . tail) - -instance F.Foldable (NonEmptyF a) where - foldMap f = F.foldMap f . tail - -instance T.Traversable (NonEmptyF a) where - traverse f = fmap <$> (NonEmptyF . head) <*> (T.traverse f . tail) - instance Bi.Bifunctor NonEmptyF where bimap f g = NonEmptyF <$> (f . head) <*> (fmap g . tail) @@ -218,18 +148,10 @@ -- | Base functor for 'Data.Tree.Tree'. data TreeF a b = NodeF a (ForestF a b) - deriving (Eq,Ord,Show,Read,Typeable -#if HAS_GENERIC - , Generic -#endif -#if HAS_GENERIC1 - , Generic1 -#endif - ) + deriving (Eq,Ord,Show,Read,Generic,Generic1,Functor,F.Foldable,T.Traversable) type ForestF a b = [b] -#ifdef LIFTED_FUNCTOR_CLASSES instance Eq2 TreeF where liftEq2 f g (NodeF a mb) (NodeF a' mb') = f a a' && liftEq g mb mb' @@ -263,23 +185,6 @@ instance Read a => Read1 (TreeF a) where liftReadsPrec = liftReadsPrec2 readsPrec readList - -#else -instance Eq a => Eq1 (TreeF a) where eq1 = (==) -instance Ord a => Ord1 (TreeF a) where compare1 = compare -instance Show a => Show1 (TreeF a) where showsPrec1 = showsPrec -instance Read a => Read1 (TreeF a) where readsPrec1 = readsPrec -#endif - --- These instances cannot be auto-derived on with GHC <= 7.6 -instance Functor (TreeF a) where - fmap f (NodeF x xs) = NodeF x (fmap f xs) - -instance F.Foldable (TreeF a) where - foldMap f (NodeF _ xs) = F.foldMap f xs - -instance T.Traversable (TreeF a) where - traverse f (NodeF x xs) = NodeF x <$> T.traverse f xs instance Bi.Bifunctor TreeF where bimap f g (NodeF x xs) = NodeF (f x) (fmap g xs) diff --git a/src/Data/Functor/Foldable.hs b/src/Data/Functor/Foldable.hs --- a/src/Data/Functor/Foldable.hs +++ b/src/Data/Functor/Foldable.hs @@ -1,16 +1,8 @@ -{-# LANGUAGE CPP, TypeFamilies, Rank2Types, FlexibleContexts, FlexibleInstances, GADTs, StandaloneDeriving, UndecidableInstances #-} -#include "recursion-schemes-common.h" - -#ifdef __GLASGOW_HASKELL__ +{-# LANGUAGE TypeFamilies, Rank2Types, FlexibleContexts, FlexibleInstances, GADTs, StandaloneDeriving, UndecidableInstances #-} {-# LANGUAGE DeriveDataTypeable #-} -#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE ConstrainedClassMethods #-} -#endif -#if HAS_GENERIC {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ScopedTypeVariables, DefaultSignatures, MultiParamTypeClasses, TypeOperators #-} -#endif -#endif ----------------------------------------------------------------------------- -- | @@ -120,11 +112,7 @@ import Data.Functor.Compose (Compose(..)) import Data.List.NonEmpty(NonEmpty((:|)), nonEmpty, toList) import Data.Tree (Tree (..)) -#ifdef __GLASGOW_HASKELL__ -#if HAS_GENERIC import GHC.Generics (Generic (..), M1 (..), V1, U1, K1 (..), (:+:) (..), (:*:) (..)) -#endif -#endif import Numeric.Natural import Prelude @@ -208,10 +196,8 @@ -- >>> project [1,2,3] -- Cons 1 [2,3] project :: t -> Base t t -#ifdef HAS_GENERIC default project :: (Generic t, Generic (Base t t), GCoerce (Rep t) (Rep (Base t t))) => t -> Base t t project = to . gcoerce . from -#endif -- | An alias for 'fold'. -- @@ -336,10 +322,8 @@ -- >>> embed (Cons 1 [2,3]) -- [1,2,3] embed :: Base t t -> t -#ifdef HAS_GENERIC default embed :: (Generic t, Generic (Base t t), GCoerce (Rep (Base t t)) (Rep t)) => Base t t -> t embed = to . gcoerce . from -#endif -- | An alias for 'unfold'. ana diff --git a/src/Data/Functor/Foldable/TH.hs b/src/Data/Functor/Foldable/TH.hs --- a/src/Data/Functor/Foldable/TH.hs +++ b/src/Data/Functor/Foldable/TH.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP, PatternGuards, Rank2Types #-} +{-# LANGUAGE TemplateHaskellQuotes #-} -- This OPTIONS_GHC line is a workaround for -- https://gitlab.haskell.org/ghc/ghc/-/issues/18320, a bug which only occurs -- when running specific TemplateHaskell code while both profiling and @@ -24,16 +25,9 @@ import Language.Haskell.TH import Language.Haskell.TH.Datatype as TH.Abs import Language.Haskell.TH.Datatype.TyVarBndr -import Language.Haskell.TH.Syntax (mkNameG_tc, mkNameG_v) import Data.Char (GeneralCategory (..), generalCategory) -#ifndef CURRENT_PACKAGE_KEY -import Data.Version (showVersion) -import Paths_recursion_schemes (version) -#endif -#ifdef __HADDOCK__ import Data.Functor.Foldable -#endif #if !MIN_VERSION_template_haskell(2,21,0) && !MIN_VERSION_th_abstraction(0,6,0) type TyVarBndrVis = TyVarBndrUnit @@ -165,13 +159,8 @@ -- 'Base' type instance, 'Recursive' and 'Corecursive' instances. -- instance MakeBaseFunctor Dec where -#if MIN_VERSION_template_haskell(2,11,0) makeBaseFunctorWith rules (InstanceD overlaps ctx classHead []) = do let instanceFor = InstanceD overlaps ctx -#else - makeBaseFunctorWith rules (InstanceD ctx classHead []) = do - let instanceFor = InstanceD ctx -#endif case classHead of ConT u `AppT` t | u == recursiveTypeName || u == corecursiveTypeName -> do name <- headOfType t @@ -288,17 +277,10 @@ pure $ if e then Just StockStrategy else Nothing #endif let dataDec = case consF of -#if MIN_VERSION_template_haskell(2,11,0) [conF] | isNewtype -> NewtypeD [] tyNameF varsF Nothing conF deriveds _ -> DataD [] tyNameF varsF Nothing consF deriveds -#else - [conF] | isNewtype -> - NewtypeD [] tyNameF varsF conF deriveds - _ -> - DataD [] tyNameF varsF consF deriveds -#endif where deriveds = #if MIN_VERSION_template_haskell(2,12,0) @@ -306,12 +288,10 @@ [ ConT functorTypeName , ConT foldableTypeName , ConT traversableTypeName ]] -#elif MIN_VERSION_template_haskell(2,11,0) +#else [ ConT functorTypeName , ConT foldableTypeName , ConT traversableTypeName ] -#else - [functorTypeName, foldableTypeName, traversableTypeName] #endif -- type instance Base @@ -322,11 +302,7 @@ mkInstance = case mkInstance' of Just f -> f Nothing -> \n -> -#if MIN_VERSION_template_haskell(2,11,0) InstanceD Nothing [] (ConT n `AppT` s) -#else - InstanceD [] (ConT n `AppT` s) -#endif -- instance Recursive projDec <- FunD projectValName <$> mkMorphism id (_baseRulesCon rules) cons' @@ -348,13 +324,9 @@ mkMorphism nFrom nTo args = for args $ \ci -> do let n = constructorName ci fs <- replicateM (length (constructorFields ci)) (newName "x") -#if MIN_VERSION_template_haskell(2,18,0) - pure $ Clause [ConP (nFrom n) [] (map VarP fs)] -- patterns -#else - pure $ Clause [ConP (nFrom n) (map VarP fs)] -- patterns -#endif - (NormalB $ foldl AppE (ConE $ nTo n) (map VarE fs)) -- body - [] -- where dec + clause [conP (nFrom n) (map varP fs)] -- patterns + (normalB $ foldl appE (conE $ nTo n) (map varE fs)) -- body + [] -- where dec ------------------------------------------------------------------------------- -- Traversals @@ -432,11 +404,9 @@ go (ForallT xs ctx t) = ForallT xs ctx (go t) -- This may fail with kind error go (SigT t k) = SigT (go t) k -#if MIN_VERSION_template_haskell(2,11,0) go (InfixT l n r) = InfixT (go l) n (go r) go (UInfixT l n r) = UInfixT (go l) n (go r) go (ParensT t) = ParensT (go t) -#endif -- Rest are unchanged go x = x @@ -463,7 +433,6 @@ -> error $ "makeBaseFunctor: Encountered an InfixConstructor " ++ "without exactly two fields" where -#if MIN_VERSION_template_haskell(2,11,0) toBang (FieldStrictness upkd strct) = Bang (toSourceUnpackedness upkd) (toSourceStrictness strct) where @@ -476,16 +445,6 @@ toSourceStrictness UnspecifiedStrictness = NoSourceStrictness toSourceStrictness Lazy = SourceLazy toSourceStrictness TH.Abs.Strict = SourceStrict -#else - -- On old versions of Template Haskell, there isn't as rich of strictness - -- information available, so the conversion is somewhat lossy. We try our - -- best to recognize certain common combinations, and fall back to NotStrict - -- in the event there's an exotic combination. - toBang (FieldStrictness UnspecifiedUnpackedness Strict) = IsStrict - toBang (FieldStrictness UnspecifiedUnpackedness UnspecifiedStrictness) = NotStrict - toBang (FieldStrictness Unpack Strict) = Unpacked - toBang FieldStrictness{} = NotStrict -#endif ------------------------------------------------------------------------------- -- Compat from base-4.9 @@ -506,45 +465,31 @@ isPuncChar c = c `elem` ",;()[]{}`" ------------------------------------------------------------------------------- --- Manually quoted names +-- TH-quoted names ------------------------------------------------------------------------------- --- By manually generating these names we avoid needing to use the --- TemplateHaskell language extension when compiling this library. --- This allows the library to be used in stage1 cross-compilers. - -rsPackageKey :: String -#ifdef CURRENT_PACKAGE_KEY -rsPackageKey = CURRENT_PACKAGE_KEY -#else -rsPackageKey = "recursion-schemes-" ++ showVersion version -#endif - -mkRsName_tc :: String -> String -> Name -mkRsName_tc = mkNameG_tc rsPackageKey - -mkRsName_v :: String -> String -> Name -mkRsName_v = mkNameG_v rsPackageKey +-- Note that this module only TemplateHaskellQuotes, not TemplateHaskell, +-- which makes lens able to be used in stage1 cross-compilers. baseTypeName :: Name -baseTypeName = mkRsName_tc "Data.Functor.Foldable" "Base" +baseTypeName = ''Base recursiveTypeName :: Name -recursiveTypeName = mkRsName_tc "Data.Functor.Foldable" "Recursive" +recursiveTypeName = ''Recursive corecursiveTypeName :: Name -corecursiveTypeName = mkRsName_tc "Data.Functor.Foldable" "Corecursive" +corecursiveTypeName = ''Corecursive projectValName :: Name -projectValName = mkRsName_v "Data.Functor.Foldable" "project" +projectValName = 'project embedValName :: Name -embedValName = mkRsName_v "Data.Functor.Foldable" "embed" +embedValName = 'embed functorTypeName :: Name -functorTypeName = mkNameG_tc "base" "GHC.Base" "Functor" +functorTypeName = ''Functor foldableTypeName :: Name -foldableTypeName = mkNameG_tc "base" "Data.Foldable" "Foldable" +foldableTypeName = ''Foldable traversableTypeName :: Name -traversableTypeName = mkNameG_tc "base" "Data.Traversable" "Traversable" +traversableTypeName = ''Traversable