Instances for more types from base

Changelog.md

@@ -1,5 +1,14 @@
 # Changelog for the `parameterized-utils` package
 
+## next
+
+  * New instances for types from `base`:
+
+    - `{Functor,Foldable,Traversable}F` instances for `Product`, `Proxy`, `Sum`
+    - `{Functor,Foldable,Traversable}FC` instances for `Alt`, `Ap`
+
+  * `{Functor,Foldable,Traversable}FC` instances for `TypeAp`
+
 ## 2.1.9.0 -- *2024 Sep 19*
 
   * Add support for GHC 9.10.

parameterized-utils.cabal

@@ -50,7 +50,7 @@ common bldflags
 
 library
   import: bldflags
-  build-depends: base >= 4.10 && < 5
+  build-depends: base >= 4.12 && < 5
                , base-orphans   >=0.8.2 && <0.10
                , th-abstraction >=0.4.2 && <0.8
                , constraints    >=0.10 && <0.15

src/Data/Parameterized/TraversableF.hs

@@ -35,8 +35,11 @@ import Control.Applicative
 import Control.Monad.Identity
 import Data.Coerce
 import Data.Functor.Compose (Compose(..))
+import Data.Functor.Product (Product(Pair))
+import Data.Functor.Sum (Sum(InL, InR))
 import Data.Kind
-import Data.Monoid
+import Data.Monoid hiding (Product, Sum)
+import Data.Proxy (Proxy(Proxy))
 import GHC.Exts (build)
 
 import Data.Parameterized.TraversableFC
@@ -48,6 +51,17 @@ class FunctorF m where
 instance FunctorF (Const x) where
   fmapF _ = coerce
 
+instance (FunctorF f, FunctorF g) => FunctorF (Product f g) where
+  fmapF f (Pair x y) = Pair (fmapF f x) (fmapF f y)
+
+instance FunctorF Proxy where
+  fmapF _ = coerce
+  {-# INLINE fmapF #-}
+
+instance (FunctorF f, FunctorF g) => FunctorF (Sum f g) where
+  fmapF f (InL x) = InL (fmapF f x)
+  fmapF f (InR x) = InR (fmapF f x)
+
 ------------------------------------------------------------------------
 -- FoldableF
 
@@ -125,6 +139,17 @@ lengthF = foldrF (const (+1)) 0
 instance FoldableF (Const x) where
   foldMapF _ _ = mempty
 
+instance (FoldableF f, FoldableF g) => FoldableF (Product f g) where
+  foldMapF f (Pair x y) = foldMapF f x <> foldMapF f y
+
+instance FoldableF Proxy where
+  foldMapF _ _ = mempty
+  {-# INLINE foldMapF #-}
+
+instance (FoldableF f, FoldableF g) => FoldableF (Sum f g) where
+  foldMapF f (InL x) = foldMapF f x
+  foldMapF f (InR y) = foldMapF f y
+
 ------------------------------------------------------------------------
 -- TraversableF
 
@@ -137,6 +162,17 @@ class (FunctorF t, FoldableF t) => TraversableF t where
 instance TraversableF (Const x) where
   traverseF _ (Const x) = pure (Const x)
 
+instance (TraversableF f, TraversableF g) => TraversableF (Product f g) where
+  traverseF f (Pair x y) = Pair <$> traverseF f x <*> traverseF f y
+
+instance TraversableF Proxy where
+  traverseF _ _ = pure Proxy
+  {-# INLINE traverseF #-}
+
+instance (TraversableF f, TraversableF g) => TraversableF (Sum f g) where
+  traverseF f (InL x) = InL <$> traverseF f x
+  traverseF f (InR y) = InR <$> traverseF f y
+
 -- | Flipped 'traverseF'
 forF :: (TraversableF t, Applicative m) => t e -> (forall s . e s -> m (f s)) -> m (t f)
 forF f x = traverseF x f

src/Data/Parameterized/TraversableFC.hs

@@ -55,6 +55,15 @@ class FunctorFC (t :: (k -> Type) -> l -> Type) where
   fmapFC :: forall f g. (forall x. f x -> g x) ->
                         (forall x. t f x -> t g x)
 
+instance FunctorFC Alt where
+  fmapFC f (Alt a) = Alt (f a)
+
+instance FunctorFC Ap where
+  fmapFC f (Ap a) = Ap (f a)
+
+instance FunctorFC TypeAp where
+  fmapFC f (TypeAp a) = TypeAp (f a)
+
 -- | A parameterized class for types which can be shown, when given
 --   functions to show parameterized subterms.
 class ShowFC (t :: (k -> Type) -> l -> Type) where
@@ -161,6 +170,15 @@ anyFC p = getAny #. foldMapFC (Any #. p)
 lengthFC :: FoldableFC t => t f x -> Int
 lengthFC = foldrFC (const (+1)) 0
 
+instance FoldableFC Alt where
+  foldMapFC toMonoid (Alt x) = toMonoid x
+
+instance FoldableFC Ap where
+  foldMapFC toMonoid (Ap x) = toMonoid x
+
+instance FoldableFC TypeAp where
+  foldMapFC toMonoid (TypeAp x) = toMonoid x
+
 ------------------------------------------------------------------------
 -- TraversableF
 
@@ -206,3 +224,12 @@ forFC ::
   t f x -> (forall y. f y -> m (g y)) -> m (t g x)
 forFC v f = traverseFC f v
 {-# INLINE forFC #-}
+
+instance TraversableFC Alt where
+  traverseFC f (Alt x) = Alt <$> f x
+
+instance TraversableFC Ap where
+  traverseFC f (Ap x) = Ap <$> f x
+
+instance TraversableFC TypeAp where
+  traverseFC f (TypeAp x) = TypeAp <$> f x