kind-generics 0.1.1.0 → 0.2.0

raw patch · 4 files changed

+2/−195 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• kind-generics.cabal +2/−4
• src/Generics/Kind/Derive/Eq.hs +0/−56
• src/Generics/Kind/Derive/Functor.hs +0/−110
• src/Generics/Kind/Examples.hs +0/−25

@@ -1,6 +1,6 @@ cabal-version:       >=1.10 name:                kind-generics-version:             0.1.1.0+version:             0.2.0 synopsis:            Generic programming in GHC style for arbitrary kinds and GADTs. description:         This package provides functionality to extend the data type generic programming functionality in GHC to classes of arbitrary kind, and constructors featuring constraints and existentials, as usually gound in GADTs. -- bug-reports:@@ -19,9 +19,7 @@  library   exposed-modules:     Generics.Kind,-                       Generics.Kind.Examples,-                       Generics.Kind.Derive.Eq,-                       Generics.Kind.Derive.Functor+                       Generics.Kind.Examples   -- other-modules:   -- other-extensions:   build-depends:       base >=4.12 && <5, kind-apply

@@ -1,56 +0,0 @@-{-# language DataKinds             #-}-{-# language PolyKinds             #-}-{-# language KindSignatures        #-}-{-# language MultiParamTypeClasses #-}-{-# language QuantifiedConstraints #-}-{-# language TypeOperators         #-}-{-# language FlexibleInstances     #-}-{-# language FlexibleContexts      #-}-{-# language UndecidableInstances  #-}-{-# language AllowAmbiguousTypes   #-}-{-# language ScopedTypeVariables   #-}-{-# language TypeFamilies          #-}-{-# language TypeApplications      #-}-module Generics.Kind.Derive.Eq where--import Generics.Kind-import Type.Reflection--geq' :: forall t f x. (GenericS t f x, GEq (RepK f) x)-     => t -> t -> Bool-geq' x y = geq (fromS x) (fromS y)--class GEq (f :: LoT k -> *) (tys :: LoT k) where-  geq :: f tys -> f tys -> Bool--instance GEq U1 tys where-  geq U1 U1 = True--instance (GEq f tys) => GEq (M1 i c f) tys where-  geq (M1 x) (M1 y) = geq x y--instance (GEq f tys, GEq g tys) => GEq (f :+: g) tys where-  geq (L1 x) (L1 y) = geq x y-  geq (R1 x) (R1 y) = geq x y-  geq _      _      = False--instance (GEq f tys, GEq g tys) => GEq (f :*: g) tys where-  geq (x1 :*: x2) (y1 :*: y2) = geq x1 y1 && geq x2 y2--instance (Eq (Ty t tys)) => GEq (F t) tys where-  geq (F x) (F y) = x == y--instance (Ty c tys => GEq f tys) => GEq (c :=>: f) tys where-  geq (C x) (C y) = geq x y--instance (forall t. (GEq f (t :&&: tys), Typeable t)) => GEq (E f) tys where-  geq (E (x :: f (t1 :&&: tys))) (E (y :: f (t2 :&&: tys)))-    = case eqTypeRep (typeRep @t1) (typeRep @t2) of-        Nothing    -> False-        Just HRefl -> geq x y--instance (forall t. GEq f (t :&&: tys)) => GEq (ERefl f) tys where-  geq (ERefl (x :: f (t1 :&&: tys))) (ERefl (y :: f (t2 :&&: tys)))-    = case eqTypeRep (typeRep @t1) (typeRep @t2) of-        Nothing    -> False-        Just HRefl -> geq x y

@@ -1,110 +0,0 @@-{-# language DataKinds              #-}-{-# language PolyKinds              #-}-{-# language GADTs                  #-}-{-# language RankNTypes             #-}-{-# language TypeOperators          #-}-{-# language MultiParamTypeClasses  #-}-{-# language FlexibleInstances      #-}-{-# language FlexibleContexts       #-}-{-# language QuantifiedConstraints  #-}-{-# language UndecidableInstances   #-}-{-# language ScopedTypeVariables    #-}-{-# language FunctionalDependencies #-}-{-# language TypeApplications       #-}-{-# language DefaultSignatures      #-}-{-# language AllowAmbiguousTypes    #-}-{-# language TypeFamilies           #-}-module Generics.Kind.Derive.Functor where--import Data.PolyKinded.Functor-import Data.Proxy--import Generics.Kind--kfmapDefault :: forall (f :: k) v as bs. (GenericK f as, GenericK f bs, GFunctor (RepK f) v as bs)-             => Mappings v as bs -> f :@@: as -> f :@@: bs-kfmapDefault v = toK @k @f @bs . gfmap v . fromK @k @f @as--fmapDefault :: forall (f :: * -> *) a b.-               (GenericK f (a ':&&: 'LoT0), GenericK f (b ':&&: 'LoT0),-                GFunctor (RepK f) '[ 'Co ] (a ':&&: 'LoT0) (b ':&&: 'LoT0))-             => (a -> b) -> f a -> f b-fmapDefault f = kfmapDefault (f :^: M0 :: Mappings '[ 'Co ] (a ':&&: 'LoT0) (b ':&&: 'LoT0))--class GFunctor (f :: LoT k -> *) (v :: Variances) (as :: LoT k) (bs :: LoT k) where-  gfmap :: Mappings v as bs -> f as -> f bs--instance GFunctor U1 v as bs where-  gfmap _ U1 = U1--instance GFunctor f v as bs => GFunctor (M1 i c f) v as bs where-  gfmap v (M1 x) = M1 (gfmap v x)--instance (GFunctor f v as bs, GFunctor g v as bs)-         => GFunctor (f :+: g) v as bs where-  gfmap v (L1 x) = L1 (gfmap v x)-  gfmap v (R1 x) = R1 (gfmap v x)--instance (GFunctor f v as bs, GFunctor g v as bs)-         => GFunctor (f :*: g) v as bs where-  gfmap v (x :*: y) = gfmap v x :*: gfmap v y--instance (Ty c as => GFunctor f v as bs, {- Ty c as => -} Ty c bs)-         => GFunctor (c :=>: f) v as bs where-  gfmap v (C x) = C (gfmap v x)--instance forall f v as bs.-         (forall (t :: *). GFunctor f ('Co ': v) (t ':&&: as) (t ':&&: bs))-         => GFunctor (E f) v as bs where-  gfmap v (E (x :: f (t ':&&: x))) = E (gfmap ((id :^: v) :: Mappings ('Co ': v) (t ':&&: as) (t ':&&: bs)) x)--instance forall f v as bs.-         (forall (t :: *). GFunctor f ('Co ': v) (t ':&&: as) (t ':&&: bs))-         => GFunctor (ERefl f) v as bs where-  gfmap v (ERefl (x :: f (t ':&&: x))) = ERefl (gfmap ((id :^: v) :: Mappings ('Co ': v) (t ':&&: as) (t ':&&: bs)) x)--class GFunctorArg (t :: Atom d (*))-                  (v :: Variances) (intended :: Variance)-                  (as :: LoT d) (bs :: LoT d) where-  gfmapf :: Proxy t -> Proxy intended-         -> Mappings v as bs-         -> Mapping intended (Ty t as) (Ty t bs)--instance forall t v as bs. GFunctorArg t v 'Co as bs-         => GFunctor (F t) v as bs where-  gfmap v (F x) = F (gfmapf (Proxy @t) (Proxy @'Co) v x)--instance GFunctorArg ('Kon t) v 'Co as bs where-  gfmapf _ _ _ = id-instance GFunctorArg ('Kon t) v 'Contra as bs where-  gfmapf _ _ _ = id--instance GFunctorArg ('Var 'VZ) (r ': v) r (a ':&&: as) (b ':&&: bs) where-  gfmapf _ _ (f :^: _) = f--instance forall vr pre v intended a as b bs.-         GFunctorArg ('Var vr) v intended as bs-         => GFunctorArg ('Var ('VS vr)) (pre ': v) intended (a ':&&: as) (b ':&&: bs) where-  gfmapf _ _ (_ :^: rest) = gfmapf (Proxy @('Var vr)) (Proxy @intended) rest--instance forall f x v v1 as bs.-         (KFunctor f '[v1] (Ty x as ':&&: 'LoT0) (Ty x bs ':&&: 'LoT0),-          GFunctorArg x v v1 as bs)-         => GFunctorArg (f :$: x) v 'Co as bs where-  gfmapf _ _ v = kfmap (gfmapf (Proxy @x) (Proxy @v1) v :^: M0)--instance forall f x y v v1 v2 as bs.-         (KFunctor f '[v1, v2] (Ty x as ':&&: Ty y as ':&&: 'LoT0) (Ty x bs ':&&: Ty y bs ':&&: 'LoT0),-          GFunctorArg x v v1 as bs, GFunctorArg y v v2 as bs)-         => GFunctorArg (f :$: x ':@: y) v 'Co as bs where-  gfmapf _ _ v = kfmap (gfmapf (Proxy @x) (Proxy @v1) v :^:-                        gfmapf (Proxy @y) (Proxy @v2) v :^: M0)--instance forall f x y z v v1 v2 v3 as bs.-         (KFunctor f '[v1, v2, v3] (Ty x as ':&&: Ty y as ':&&: Ty z as ':&&: 'LoT0)-                                   (Ty x bs ':&&: Ty y bs ':&&: Ty z bs ':&&: 'LoT0),-          GFunctorArg x v v1 as bs, GFunctorArg y v v2 as bs, GFunctorArg z v v3 as bs)-         => GFunctorArg (f :$: x ':@: y ':@: z) v 'Co as bs where-  gfmapf _ _ v = kfmap (gfmapf (Proxy @x) (Proxy @v1) v :^:-                        gfmapf (Proxy @y) (Proxy @v2) v :^:-                        gfmapf (Proxy @z) (Proxy @v3) v :^: M0)

@@ -14,8 +14,6 @@ import Type.Reflection  import Generics.Kind-import Generics.Kind.Derive.Eq-import Generics.Kind.Derive.Functor  -- Obtained from Generic @@ -23,9 +21,6 @@ instance GenericK Maybe (a ':&&: 'LoT0) where   type RepK Maybe = U1 :+: F V0 -instance KFunctor Maybe '[ 'Co ] (a ':&&: 'LoT0) (b ':&&: 'LoT0) where-  kfmap = kfmapDefault- -- From the docs  data Tree a = Branch (Tree a) (Tree a) | Leaf a@@ -35,15 +30,6 @@ instance GenericK Tree (a ':&&: 'LoT0) where   type RepK Tree = F (Tree :$: V0) :*: F (Tree :$: V0) :+: F V0 -instance Eq a => Eq (Tree a) where-  (==) = geq'--instance KFunctor Tree '[ 'Co ] (a ':&&: 'LoT0) (b ':&&: 'LoT0) where-  kfmap = kfmapDefault--instance Functor Tree where-  fmap = fmapDefault- -- Hand-written instance  data WeirdTree a where@@ -62,9 +48,6 @@   toK (L1 (F l :*: F r)) = WeirdBranch l r   toK (R1 (E (C (F a :*: F x)))) = WeirdLeaf a x -instance Show b => KFunctor WeirdTree '[ 'Co ] (a ':&&: 'LoT0) (b ':&&: 'LoT0) where-  kfmap = kfmapDefault- -- Hand-written instance with reflection  data WeirdTreeR a where@@ -82,11 +65,3 @@    toK (L1 (F l :*: F r)) = WeirdBranchR l r   toK (R1 (ERefl (C (C (F a :*: F x))))) = WeirdLeafR a x--instance (Eq a) => Eq (WeirdTreeR a) where-  (==) = geq'--{--instance Show b => KFunctor WeirdTreeR '[ 'Co ] (a ':&&: 'LoT0) (b ':&&: 'LoT0) where-  kfmap = kfmapDefault--}