generic-functor 0.0.1.1 → 0.1.0.0

raw patch · 6 files changed

+344/−53 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.md +44/−1
• generic-functor.cabal +1/−1
• src/Generic/Functor.hs +22/−0
• src/Generic/Functor/Internal.hs +241/−51
• test/test.hs +31/−0

@@ -1,3 +1,8 @@+## 0.1.0.0++- Add `gmultimap`, `multimap`, `(:+)`+- Add `DeriveBifunctor`, `gbimap`, `gfirst`, `gsecond`+ ## 0.0.1.1  * Include README

@@ -100,6 +100,24 @@ solomap :: Solomap a b x y => (a -> b) -> (x -> y) ``` +## Functors of multiple parameters++You can also map with more than one function simultaneously.+For example with `a -> b` and `c -> d` over `(Maybe a, [(c, a)])`:++```haskell+type F a c = (Maybe a, [(c, a)])++bimaps :: (a -> b) -> (c -> d) -> F a c -> F b d+bimaps f g = multimap (f :+ g :+ ())+```++`multimap` takes a list of functions separated by `(:+)` and terminated by `()`.++There is also a `gmultimap`, generalizing `gsolomap`.++`gmultimap` and `multimap` are **unsafe**, similarly to `gsolomap` and `solomap`.+ ## Deriving `Functor`  This library enables `DerivingVia` for the `Functor` class.@@ -137,6 +155,23 @@ but only for instances of `Generic1`, which applies to much more restricted shapes of `data` than `Generic`. +## Deriving `Bifunctor`++Similarly, we can use `DerivingVia` for the `Bifunctor` class+(from *base*, module `Data.Bifunctor`).++```haskell+{-# LANGUAGE DeriveGeneric, DerivingVia #-}++import GHC.Generics (Generic)+import Generic.Functor (DeriveFunctor(..), DeriveBifunctor(..))++data Tree a b = Node a (Tree a b) (Tree a b) | Leaf b+  deriving Generic+  deriving Functor via (DeriveFunctor (Tree a))+  deriving Bifunctor via (DeriveBifunctor Tree)+```+ ---  ## Internal module policy@@ -150,10 +185,18 @@  ## Related links -- [*generic-data*][generic-data]+- [*generic-data*][generic-data]: utilities for `GHC.Generics` and deriving for+  other standard classes. +- [*generic-lens*][generic-lens]: the `params` traversal uses a very similar implementation.++- [*one-liner*][one-liner]. [*product-profunctors*][pp]+ - [*Deriving Bifunctors with Generics*](https://kcsongor.github.io/generic-deriving-bifunctor/),   blogpost by Csongor Kiss,   describing the main idea for the implementation (using incoherent instances).  [generic-data]: https://hackage.haskell.org/package/generic-data+[generic-lens]: https://hackage.haskell.org/package/generic-lens+[one-liner]: https://hackage.haskell.org/package/one-liner+[pp]: https://hackage.haskell.org/package/product-profunctors

@@ -1,6 +1,6 @@ cabal-version:       >=1.10 name:                generic-functor-version:             0.0.1.1+version:             0.1.0.0 synopsis: Deriving generalized functors with GHC.Generics description:   Derive @fmap@, and other @fmap@-like functions where the

@@ -2,15 +2,37 @@  module Generic.Functor   ( -- * Derive functors++    -- ** Unary functors     gsolomap   , solomap++    -- ** N-ary functors+  , gmultimap+  , multimap+  , (:+)(..)++    -- ** Derive Functor and Bifunctor++    -- *** DerivingVia   , DeriveFunctor(..)+  , DeriveBifunctor(..)++    -- *** Generic method definitions   , gfmap+  , gbimap+  , gfirst+  , gsecond      -- * Auxiliary classes   , GFunctor()+  , GBifunctor()+  , GFirst()+  , GSecond()   , GSolomap()   , Solomap()+  , GMultimap()+  , Multimap()   ) where  import Generic.Functor.Internal

@@ -1,9 +1,12 @@ {-# LANGUAGE+  AllowAmbiguousTypes,+  ConstraintKinds,   EmptyCase,   FlexibleContexts,   FlexibleInstances,   MultiParamTypeClasses,   QuantifiedConstraints,+  RankNTypes,   ScopedTypeVariables,   TypeApplications,   TypeOperators,@@ -19,9 +22,9 @@  import Data.Bifunctor import Data.Coerce-import GHC.Generics+import GHC.Generics hiding (S) --- | Generic implementation of 'fmap'. See also 'DeriveFunctor' for deriving-via,+-- | Generic implementation of 'fmap'. See also 'DeriveFunctor' for @DerivingVia@, -- using 'gfmap' under the hood. -- -- === Example@@ -41,7 +44,7 @@ -- -- Unlike 'gsolomap', 'gfmap' is safe to use in all contexts. gfmap :: forall f a b. GFunctor f => (a -> b) -> (f a -> f b)-gfmap f = to . gmap1 f . from :: GFunctorRep a b f => f a -> f b+gfmap f = with @(GFunctorRep a b f) (to . gmap1 (f :+ ()) . from)  -- | Generalized generic functor. --@@ -49,7 +52,7 @@ -- where the type parameter to be \"mapped\" does not have to be the last one. -- -- 'gsolomap' is __unsafe__: misuse will break your programs.--- Read the Usage section below for details.+-- Read the <#gsolomapusage Usage> section below for details. -- -- === Example --@@ -74,7 +77,7 @@ -- -- === Usage #gsolomapusage# ----- (This also applies to 'solomap'.)+-- (This also applies to 'solomap', 'gmultimap', and 'multimap'.) -- -- 'gsolomap' should only be used to define __polymorphic__ "@fmap@-like functions". -- It works only in contexts where @a@ and @b@ are two distinct, non-unifiable@@ -90,7 +93,7 @@ -- definition of 'GSolomap'. Functions are safe to specialize after 'GSolomap' -- (and 'Solomap') constraints have been discharged. gsolomap :: forall a b x y. (Generic x, Generic y, GSolomap a b x y) => (a -> b) -> (x -> y)-gsolomap f = to . gmap1 f . from+gsolomap f = to . gmap1 (f :+ ()) . from  -- | Generalized implicit functor. --@@ -101,6 +104,7 @@ -- functors out of freshly declared @data@ types. -- -- 'solomap' is __unsafe__: misuse will break your programs.+-- -- See the <#gsolomapusage Usage> section of 'gsolomap' for details. -- -- === Example@@ -115,10 +119,79 @@ -- -- equivalent to:   \\f -> fmap (bimap (fmap f) id) -- @ solomap :: forall a b x y. Solomap a b x y => (a -> b) -> (x -> y)-solomap = solomap_+solomap f = multimap (f :+ ()) --- ** Constraints for @gfmap@+-- | Generic n-ary functor.+--+-- A generalization of 'gsolomap' to map over multiple parameters simultaneously.+-- 'gmultimap' takes a list of functions separated by @(':+')@ and terminated by @()@.+--+-- 'gmultimap' is __unsafe__: misuse will break your programs.+-- The type of every function in the list must be some @(a -> b)@+-- where @a@ and @b@ are distinct type variables.+--+-- See the <#gsolomapusage Usage> section of 'gsolomap' for details.+--+-- === Example+--+-- @+-- {-\# LANGUAGE DeriveGeneric \#-}+--+-- import "GHC.Generics" ('Generic')+-- import "Generic.Functor" ('gmultimap')+--+-- data Three a b c = One a | Two b | Three c+--   deriving 'Generic'+--+-- mapThree :: (a -> a') -> (b -> b') -> (c -> c') -> Three a b c -> Three a' b' c'+-- mapThree f g h = 'gmultimap' (f ':+' g ':+' h ':+' ())+-- @+gmultimap :: forall arr x y. (Generic x, Generic y, GMultimap arr x y) => arr -> (x -> y)+gmultimap f = to . gmap1 f . from +-- | Implicit n-ary functor.+--+-- A generalization of 'solomap' to map over multiple parameters simultaneously.+-- 'multimap' takes a list of functions separated by @(':+')@ and terminated by @()@.+--+-- 'multimap' is __unsafe__: misuse will break your programs.+-- The type of every function in the list must be some @(a -> b)@+-- where @a@ and @b@ are distinct type variables.+--+-- See the <#gsolomapusage Usage> section of 'gsolomap' for details.+--+-- === Example+--+-- @+-- type F a b c = Either a (b, c)+--+-- map3 :: (a -> a') -> (b -> b') -> (c -> c') -> F a b c -> F a' b' c'+-- map3 f g h = 'multimap' (f ':+' g ':+' h ':+' ())+-- -- equivalent to:  \\f g h -> bimap f (bimap g h)+-- @+multimap :: forall arr x y. Multimap arr x y => arr -> (x -> y)+multimap f = multimap_ (s2 f)++-- | Generic implementation of 'bimap'. See also 'DeriveBifunctor'.+gbimap :: forall f a b c d. GBifunctor f => (a -> b) -> (c -> d) -> f a c -> f b d+gbimap f g = with @(GBifunctorRep a b c d f) (to . gmap1 (f :+ g :+ ()) . from)++-- | Generic implementation of 'first'. See also 'DeriveBifunctor'.+gfirst :: forall f a b c. GFirst f => (a -> b) -> f a c -> f b c+gfirst f = with @(GFirstRep a b c f) (to . gmap1 (f :+ ()) . from)++-- | Generic implementation of 'second'. See also 'DeriveBifunctor'.+gsecond :: forall f a c d. GSecond f => (c -> d) -> f a c -> f a d+gsecond = gfmap++-- | Explicitly require a constraint, to force the instantiation of a quantified constraint.+with :: forall c r. (c => r) -> (c => r)+with x = x++-- ** Top-level constraints++-- *** @gfmap@+ -- | Constraint for 'gfmap'. class    (forall a. Generic (f a), forall a b. GFunctorRep a b f) => GFunctor f instance (forall a. Generic (f a), forall a b. GFunctorRep a b f) => GFunctor f@@ -128,28 +201,64 @@ -- This is an example of the \"quantified constraints trick\" to encode -- @forall a b. GMap1 a b (Rep (f a)) (Rep (f b))@ which doesn't actually -- work as-is.-class    GMap1 a b (Rep (f a)) (Rep (f b)) => GFunctorRep a b f-instance GMap1 a b (Rep (f a)) (Rep (f b)) => GFunctorRep a b f+class    GMap1 ((a -> b) :+ ()) (Rep (f a)) (Rep (f b)) => GFunctorRep a b f+instance GMap1 ((a -> b) :+ ()) (Rep (f a)) (Rep (f b)) => GFunctorRep a b f --- ** Constraint for @gsolomap@+-- *** @gbimap@ --- | Constraint for 'gsolomap'.-class    GMap1 a b (Rep x) (Rep y) => GSolomap a b x y-instance GMap1 a b (Rep x) (Rep y) => GSolomap a b x y+-- | Constraint for 'gbimap'.+class    (forall a c. Generic (f a c), forall a b c d. GBifunctorRep a b c d f) => GBifunctor f+instance (forall a c. Generic (f a c), forall a b c d. GBifunctorRep a b c d f) => GBifunctor f --- ** Constraint for @solomap@+-- | Internal component of 'GBifunctor'.+class    GMap1 ((a -> b) :+ (c -> d) :+ ()) (Rep (f a c)) (Rep (f b d)) => GBifunctorRep a b c d f+instance GMap1 ((a -> b) :+ (c -> d) :+ ()) (Rep (f a c)) (Rep (f b d)) => GBifunctorRep a b c d f +-- *** @gfirst@++-- | Constraint for 'gfirst'.+class    (forall a c. Generic (f a c), forall a b c. GFirstRep a b c f) => GFirst f+instance (forall a c. Generic (f a c), forall a b c. GFirstRep a b c f) => GFirst f++-- | Internal component of 'GFirst'.+class    GMap1 ((a -> b) :+ ()) (Rep (f a c)) (Rep (f b c)) => GFirstRep a b c f+instance GMap1 ((a -> b) :+ ()) (Rep (f a c)) (Rep (f b c)) => GFirstRep a b c f++-- *** @gsecond@++-- | Constraint for 'gsecond'.+class    (forall a c. Generic (f a c), forall a c d. GFunctorRep c d (f a)) => GSecond f+instance (forall a c. Generic (f a c), forall a c d. GFunctorRep c d (f a)) => GSecond f++-- *** Others++-- | Constraint for 'gsolomap'.+class    GMap1 ((a -> b) :+ ()) (Rep x) (Rep y) => GSolomap a b x y+instance GMap1 ((a -> b) :+ ()) (Rep x) (Rep y) => GSolomap a b x y+ -- | Constraint for 'solomap'.-class    Solomap_ a b x y => Solomap a b x y-instance Solomap_ a b x y => Solomap a b x y+class    Multimap ((a -> b) :+ ()) x y => Solomap a b x y+instance Multimap ((a -> b) :+ ()) x y => Solomap a b x y +-- | Constraint for 'gmultimap'.+class    GMap1 arr (Rep x) (Rep y) => GMultimap arr x y+instance GMap1 arr (Rep x) (Rep y) => GMultimap arr x y++-- | Constraint for 'multimap'.+class    Multimap_ (S2 arr) x y => Multimap arr x y+instance Multimap_ (S2 arr) x y => Multimap arr x y+ -- * Deriving Via +-- ** Functor+ -- | @newtype@ for @DerivingVia@ of 'Functor' instances. -- -- Note: the GHC extension @DeriveFunctor@ already works out-of-the-box in most--- cases. There are exceptions, such as the following example:+-- cases. There are exceptions, such as the following example. --+-- === Example+-- -- @ -- {-\# LANGUAGE DeriveGeneric, DerivingVia \#-} --@@ -163,68 +272,149 @@ newtype DeriveFunctor f a = DeriveFunctor (f a)  instance GFunctor f => Functor (DeriveFunctor f) where-  fmap = coerce' (gfmap @f) where-    coerce' :: Coercible s t => (r -> s) -> (r -> t)-    coerce' = coerce+  fmap = coerce1 (gfmap @f) +-- ** Bifunctor++-- | @newtype@ for @DerivingVia@ of 'Bifunctor' instances. --+-- Note: deriving 'Bifunctor' for a generic type often requires 'Functor'+-- instances for types mentioned in the fields.+--+-- === Example+--+-- @+-- {-\# LANGUAGE DeriveGeneric, DerivingVia \#-}+--+-- import "GHC.Generics" ('Generic')+-- import "Generic.Functor" ('DeriveFunctor'(..), 'DeriveBifunctor'(..))+--+-- data Tree a b = Node a (Tree a b) (Tree a b) | Leaf b+--   deriving 'Generic'+--   deriving 'Functor' via ('DeriveFunctor' (Tree a))+--   deriving 'Bifunctor' via ('DeriveBifunctor' Tree)+--+-- data CofreeF f a b = a :< f b+--   deriving 'Generic'+--   deriving 'Bifunctor' via ('DeriveBifunctor' (CofreeF f))+-- @+newtype DeriveBifunctor f a b = DeriveBifunctor (f a b) -class GMap1 a b f g where-  gmap1 :: (a -> b) -> f () -> g ()+instance (GBifunctor f, GFirst f, GSecond f) => Bifunctor (DeriveBifunctor f) where+  bimap = coerce2 (gbimap @f)+  first = coerce3 (gfirst @f)+  second = coerce3 (gsecond @f) -instance GMap1 a b f g => GMap1 a b (M1 i c f) (M1 i' c'' g) where-  gmap1 = coerce (gmap1 @a @b @f @g)+-- ** Internal coercions -instance (GMap1 a b f1 g1, GMap1 a b f2 g2) => GMap1 a b (f1 :+: f2) (g1 :+: g2) where+coerce1 :: Coercible s t => (r -> s) -> (r -> t)+coerce1 = coerce++coerce2 :: Coercible t u => (r -> s -> t) -> (r -> s -> u)+coerce2 = coerce++coerce3 :: (Coercible w v, Coercible (f b d) (g b d)) => (r -> w -> f b d) -> (r -> v -> g b d)+coerce3 = coerce++--++class GMap1 arr f g where+  gmap1 :: arr -> f () -> g ()++instance GMap1 arr f g => GMap1 arr (M1 i c f) (M1 i' c'' g) where+  gmap1 = coerce (gmap1 @arr @f @g)++instance (GMap1 arr f1 g1, GMap1 arr f2 g2) => GMap1 arr (f1 :+: f2) (g1 :+: g2) where   gmap1 f (L1 x) = L1 (gmap1 f x)   gmap1 f (R1 x) = R1 (gmap1 f x) -instance (GMap1 a b f1 g1, GMap1 a b f2 g2) => GMap1 a b (f1 :*: f2) (g1 :*: g2) where+instance (GMap1 arr f1 g1, GMap1 arr f2 g2) => GMap1 arr (f1 :*: f2) (g1 :*: g2) where   gmap1 f (x :*: y) = gmap1 f x :*: gmap1 f y -instance GMap1 a b U1 U1 where+instance GMap1 arr U1 U1 where   gmap1 _ U1 = U1 -instance GMap1 a b V1 V1 where+instance GMap1 arr V1 V1 where   gmap1 _ v = case v of {} -instance Solomap_ a b x y => GMap1 a b (K1 i x) (K1 i' y) where-  gmap1 = coerce (solomap_ @a @b @x @y)+instance Multimap arr x y => GMap1 arr (K1 i x) (K1 i' y) where+  gmap1 = coerce (multimap @arr @x @y)  -- | Internal implementation of 'Solomap'.-class Solomap_ a b x y where-  solomap_ :: (a -> b) -> x -> y+class Multimap_ arr x y where+  multimap_ :: arr -> x -> y -instance {-# INCOHERENT #-} Solomap_ a b a b where-  solomap_ = id+-- | Heterogeneous lists of arrows are constructed as lists separated by+-- @(':+')@ and terminated by @()@.+--+-- === Example+--+-- Given @f :: a -> a'@ and @g :: b -> b'@,+-- @(f ':+' g ':+' ())@ is a list with the two elements @f@ and @g@.+--+-- @+-- if+--   f :: a -> a'+--   g :: b -> b'+--+-- then+--   f ':+' g ':+' ()  ::  (a -> a') ':+' (b -> b') ':+' ()+-- @+--+-- Those lists are used by 'gmultimap' and 'multimap'.+--+-- @+-- bimap_ :: (a -> a') -> (b -> b') -> (Maybe a, [Either b a]) -> (Maybe a', [Either b' a'])+-- bimap_ f g = 'multimap' (f ':+' g ':+' ())+-- @+data a :+ b = a :+ b+infixr 1 :+ +-- | @arr@ is the list of arrows provided by the user. It is constant.+-- When testing whether any arrow matches, @arr'@ is the remaining list of+-- arrows to be tested.+data S arr arr' = S arr arr'++type S2 arr = S arr arr++s2 :: arr -> S2 arr+s2 f = S f f++instance {-# INCOHERENT #-} Multimap_ (S arr ((a -> b) :+ arr')) a b where+  multimap_ (S _ (f :+ _)) = f++instance Multimap_ (S arr arr') x y => Multimap_ (S arr ((a -> b) :+ arr')) x y where+  multimap_ (S f (_ :+ g')) = multimap_ (S f g')+ -- "id" instance-instance {-# INCOHERENT #-} Solomap_ a b x x where-  solomap_ _ = id+instance {-# INCOHERENT #-} Multimap_ (S arr ()) x x where+  multimap_ _ = id  -- "Functor" instance-instance {-# INCOHERENT #-} (Functor f, Solomap_ a b x y) => Solomap_ a b (f x) (f y) where-  solomap_ = fmap . solomap_+instance {-# INCOHERENT #-} (Functor f, Multimap arr x y)+  => Multimap_ (S arr ()) (f x) (f y) where+  multimap_ (S f ()) = fmap (multimap f)  -- Intersection of "id" and "Functor" instances. Prefer "id". -- When both of those instances match then this one should match and avoid an -- unnecessary and overly restrictive Functor constraint.-instance {-# INCOHERENT #-} Solomap_ a b (f x) (f x) where-  solomap_ _ = id+instance {-# INCOHERENT #-} Multimap_ (S arr ()) (f x) (f x) where+  multimap_ _ = id -instance (Solomap_ a b y1 x1, Solomap_ a b x2 y2) => Solomap_ a b (x1 -> x2) (y1 -> y2) where-  solomap_ f u = solomap_ f . u . solomap_ f+instance (Multimap arr y1 x1, Multimap arr x2 y2)+  => Multimap_ (S arr ()) (x1 -> x2) (y1 -> y2) where+  multimap_ (S f ()) u = multimap f . u . multimap f  -- "Bifunctor" instance.-instance {-# INCOHERENT #-} (Bifunctor f, Solomap_ a b x1 y1, Solomap_ a b x2 y2)-  => Solomap_ a b (f x1 x2) (f y1 y2) where-  solomap_ f = bimap (solomap_ f) (solomap_ f)+instance {-# INCOHERENT #-} (Bifunctor f, Multimap arr x1 y1, Multimap arr x2 y2)+  => Multimap_ (S arr ()) (f x1 x2) (f y1 y2) where+  multimap_ (S f ()) = bimap (multimap f) (multimap f)  -- Intersection of "Bifunctor" and "Functor" instances. Prefer "Functor".-instance {-# INCOHERENT #-} (Functor (f x), Solomap_ a b x2 y2)-  => Solomap_ a b (f x x2) (f x y2) where-  solomap_ = fmap . solomap_+instance {-# INCOHERENT #-} (Functor (f x), Multimap arr x2 y2)+  => Multimap_ (S arr ()) (f x x2) (f x y2) where+  multimap_ (S f ()) = fmap (multimap f)  -- Intersection of "Bifunctor", "Functor", and "id" instances. Prefer "id".-instance {-# INCOHERENT #-} Solomap_ a b (f x y) (f x y) where-  solomap_ _ = id+instance {-# INCOHERENT #-} Multimap_ (S arr ()) (f x y) (f x y) where+  multimap_ _ = id

@@ -70,6 +70,31 @@ map4 = solomap map4' = fmap . fmap . fmap . fmap +-- Deriving Bifunctor++data Tree a b = Node a (Tree a b) (Tree a b) | Leaf b+  deriving (Eq, Show, Generic)+  deriving Functor via (DeriveFunctor (Tree a))+  deriving Bifunctor via (DeriveBifunctor Tree)++data CofreeF f a b = a :< f b+  deriving (Eq, Show, Generic)+  deriving Bifunctor via (DeriveBifunctor (CofreeF f))++-- Multimap++data Three a b c = One a | Two b | Three c+  deriving (Eq, Show, Generic)++mapThree :: (a -> a') -> (b -> b') -> (c -> c') -> Three a b c -> Three a' b' c'+mapThree f g h = gmultimap (f :+ g :+ h :+ ())++type F5 a b c = Either a (b, c)++map5 :: (a -> a') -> (b -> b') -> (c -> c') -> F5 a b c -> F5 a' b' c'+map5 f g h = multimap (f :+ g :+ h :+ ())+map5' f g h = bimap f (bimap g h)+ -- Run at least once  twice :: Int -> Int@@ -85,6 +110,9 @@   Square () () 8 10 @= fmap twice (Square () () 4 5)   Square 8 10 () () @= mapFirst twice (Square 4 5 () ())   [Twice (Left 8), Twice (Right 10)] @= (fmap . fmap) twice [Twice (Left 4), Twice (Right 5)]+  Node 8 (Leaf 10) (Leaf 12) @= bimap twice twice (Node 4 (Leaf 5) (Leaf 6))+  (8 :< Just 10) @= bimap twice twice (4 :< Just 5)+  [One 8, Two False, Three 1] @= fmap (mapThree twice not length) [One 4, Two True, Three [()]]    let t1 = Right (Just [((), 4)])   map1 twice t1 @= map1' twice t1@@ -97,6 +125,9 @@    let t4 = ((), Just [Right 4])   map4 twice t4 @= map4' twice t4++  let t5 = [Left 4, Right (False, [()])]+  fmap (map5 twice not length) t5 @= fmap (map5 twice not length) t5  -- Assert equality (@=) :: (Eq a, Show a) => a -> a -> IO ()