generics-sop 0.3.0.0 → 0.3.1.0

raw patch · 10 files changed

+534/−11 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +21/−3
• generics-sop.cabal +5/−4
• src/Generics/SOP.hs +15/−1
• src/Generics/SOP/Classes.hs +59/−0
• src/Generics/SOP/Constraint.hs +90/−3
• src/Generics/SOP/NP.hs +138/−0
• src/Generics/SOP/NS.hs +136/−0
• src/Generics/SOP/Universe.hs +40/−0
• test/Example.hs +3/−0
• test/HTransExample.hs +27/−0

@@ -1,3 +1,21 @@+# 0.3.1.0 (2017-06-11)++* Add AllZip, htrans, hcoerce, hfromI, htoI.+  These functions are for converting between related+  structures that do not have common signatures.++  The most common application of these functions seems+  to be the scenario where a datatype has components+  that are all wrapped in a common type constructor+  application, e.g. a datatype where every component+  is a `Maybe`. Then we can use `hfromI` after `from`+  to turn the generically derived `SOP` of `I`s into+  an `SOP` of `Maybe`s (and back).++* Add `IsProductType`, `IsEnumType`, `IsWrappedType`+  and `IsNewtype` constraint synonyms capturing+  specific classes of datypes.+ # 0.3.0.0 (2017-04-29)  * No longer compatible with GHC 7.6, due to the lack of@@ -112,8 +130,8 @@        hcliftA' p = hcliftA (allP p)         where-	      allP :: proxy c -> Proxy (All c)-		  allP _ = Proxy+          allP :: proxy c -> Proxy (All c)+          allP _ = Proxy  * Because `All` and `All2` are now type classes, they now have   superclass constraints implying that the type-level lists they@@ -132,7 +150,7 @@    For one-dimensional type-level lists, replace -      SingI xs => ... +      SingI xs => ...    by 

@@ -1,5 +1,5 @@ name:                generics-sop-version:             0.3.0.0+version:             0.3.1.0 synopsis:            Generic Programming using True Sums of Products description:   A library to support the definition of generic functions.@@ -37,7 +37,7 @@ build-type:          Simple cabal-version:       >=1.10 extra-source-files:  CHANGELOG.md-tested-with:         GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1, GHC == 8.0.2, GHC == 8.1.*+tested-with:         GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1, GHC == 8.0.2, GHC == 8.1.*  source-repository head   type:                git@@ -59,7 +59,7 @@                        Generics.SOP.NS                        Generics.SOP.Universe                        Generics.SOP.Sing-  build-depends:       base                 >= 4.6  && < 5,+  build-depends:       base                 >= 4.7  && < 5,                        template-haskell     >= 2.8  && < 2.13,                        ghc-prim             >= 0.3  && < 0.6,                        deepseq              >= 1.3  && < 1.5@@ -101,9 +101,10 @@   if impl (ghc < 7.10)     other-extensions:    OverlappingInstances -test-suite generic-sop-examples+test-suite generics-sop-examples   type:                exitcode-stdio-1.0   main-is:             Example.hs+  other-modules:       HTransExample   hs-source-dirs:      test   default-language:    Haskell2010   ghc-options:         -Wall

@@ -218,6 +218,10 @@     -- * Codes and interpretations     Generic(..)   , Rep+  , IsProductType+  , IsEnumType+  , IsWrappedType+  , IsNewtype     -- * n-ary datatypes   , NP(..)   , NS(..)@@ -296,6 +300,10 @@   , hsequenceK     -- ** Expanding sums to products   , HExpand(..)+    -- ** Transformation of index lists and coercions+  , HTrans(..)+  , hfromI+  , htoI     -- ** Partial operations   , fromList     -- * Utilities@@ -322,10 +330,16 @@     -- ** Mapping constraints   , All   , All2+  , AllZip+  , AllZip2+  , AllN+  , AllZipN+    -- ** Other constraints   , Compose   , And   , Top-  , AllN+  , LiftedCoercible+  , SameShapeAs     -- ** Singletons   , SList(..)   , SListI(..)

@@ -39,6 +39,7 @@   , fn_2   , fn_3   , fn_4+  , Same   , Prod   , HAp(..)     -- ** Derived functions@@ -69,6 +70,10 @@   , HApInjs(..)     -- * Expanding sums to products   , HExpand(..)+    -- * Transformation of index lists and coercions+  , HTrans(..)+  , hfromI+  , htoI   ) where  #if !(MIN_VERSION_base(4,8,0))@@ -147,6 +152,9 @@ fn_3 f = Fn $ \x -> Fn $ \x' -> Fn $ \x'' -> f x x' x'' fn_4 f = Fn $ \x -> Fn $ \x' -> Fn $ \x'' -> Fn $ \x''' -> f x x' x'' x''' +-- | Maps a structure to the same structure.+type family Same (h :: (k1 -> *) -> (l1 -> *)) :: (k2 -> *) -> (l2 -> *)+ -- | Maps a structure containing sums to the corresponding -- product structure. type family Prod (h :: (k -> *) -> (l -> *)) :: (k -> *) -> (l -> *)@@ -518,6 +526,57 @@   -- @since 0.2.5.0   --   hcexpand :: (AllN (Prod h) c xs) => proxy c -> (forall x . c x => f x) -> h f xs -> Prod h f xs++-- | A class for transforming structures into related structures with+-- a different index list, as long as the index lists have the same shape+-- and the elements and interpretation functions are suitably related.+--+-- @since 0.3.1.0+--+class (Same h1 ~ h2, Same h2 ~ h1) => HTrans (h1 :: (k1 -> *) -> (l1 -> *)) (h2 :: (k2 -> *) -> (l2 -> *)) where++  -- | Transform a structure into a related structure given a conversion+  -- function for the elements.+  --+  -- @since 0.3.1.0+  --+  htrans ::+       AllZipN (Prod h1) c xs ys+    => proxy c+    -> (forall x y . c x y => f x -> g y)+    -> h1 f xs -> h2 g ys++  -- | Coerce a structure into a representationally equal structure.+  --+  -- /Examples:/+  --+  -- >>> hcoerce (I (Just LT) :* I (Just 'x') :* I (Just True) :* Nil) :: NP Maybe '[Ordering, Char, Bool]+  -- Just LT :* (Just 'x' :* (Just True :* Nil))+  -- >>> hcoerce (SOP (Z (K True :* K False :* Nil))) :: SOP I '[ '[Bool, Bool], '[Bool] ]+  -- SOP (Z (I True :* (I False :* Nil)))+  --+  -- @since 0.3.1.0+  hcoerce ::+       (AllZipN (Prod h1) (LiftedCoercible f g) xs ys, HTrans h1 h2)+    => h1 f xs -> h2 g ys++-- | Specialization of 'hcoerce'.+--+-- @since 0.3.1.0+--+hfromI ::+       (AllZipN (Prod h1) (LiftedCoercible I f) xs ys, HTrans h1 h2)+    => h1 I xs -> h2 f ys+hfromI = hcoerce++-- | Specialization of 'hcoerce'.+--+-- @since 0.3.1.0+--+htoI ::+       (AllZipN (Prod h1) (LiftedCoercible f I) xs ys, HTrans h1 h2)+    => h1 f xs -> h2 I ys+htoI = hcoerce  -- $setup -- >>> import Generics.SOP

@@ -17,7 +17,9 @@   , Constraint   ) where +import Data.Coerce import GHC.Exts (Constraint)+ import Generics.SOP.Sing  -- | Require a constraint for every element of a list.@@ -46,9 +48,10 @@  -- | Type family used to implement 'All'. ---type family AllF (c :: k -> Constraint) (xs :: [k]) :: Constraint-type instance AllF _c '[]       = ()-type instance AllF  c (x ': xs) = (c x, All c xs)+type family+  AllF (c :: k -> Constraint) (xs :: [k]) :: Constraint where+  AllF _c '[]       = ()+  AllF  c (x ': xs) = (c x, All c xs)  -- | Require a singleton for every inner list in a list of lists. type SListI2 = All SListI@@ -87,6 +90,83 @@ -- it triggers GHC's superclass cycle check when used in a -- class context. +-- | Require a constraint for pointwise for every pair of+-- elements from two lists.+--+-- /Example:/ The constraint+--+-- > All (~) '[ Int, Bool, Char ] '[ a, b, c ]+--+-- is equivalent to the constraint+--+-- > (Int ~ a, Bool ~ b, Char ~ c)+--+-- @since 0.3.1.0+--+class+  ( SListI xs, SListI ys+  , SameShapeAs xs ys, SameShapeAs ys xs+  , AllZipF c xs ys+  ) => AllZip (c :: a -> b -> Constraint) (xs :: [a]) (ys :: [b])+instance+  ( SListI xs, SListI ys+  , SameShapeAs xs ys, SameShapeAs ys xs+  , AllZipF c xs ys+  ) => AllZip c xs ys++-- | Type family used to implement 'AllZip'.+--+-- @since 0.3.1.0+--+type family+  AllZipF (c :: a -> b -> Constraint) (xs :: [a]) (ys :: [b])+    :: Constraint where+  AllZipF _c '[]      '[]        = ()+  AllZipF  c (x ': xs) (y ': ys) = (c x y, AllZip c xs ys)++-- | Type family that forces a type-level list to be of the same+-- shape as the given type-level list.+--+-- The main use of this constraint is to help type inference to+-- learn something about otherwise unknown type-level lists.+--+-- @since 0.3.1.0+--+type family+  SameShapeAs (xs :: [a]) (ys :: [b]) :: Constraint where+  SameShapeAs '[]       ys = (ys ~ '[])+  SameShapeAs (x ': xs) ys =+    (ys ~ (Head ys ': Tail ys), SameShapeAs xs (Tail ys))++-- | Utility function to compute the head of a type-level list.+--+-- @since 0.3.1.0+--+type family Head (xs :: [a]) :: a where+  Head (x ': xs) = x++-- | Utility function to compute the tail of a type-level list.+--+-- @since 0.3.1.0+--+type family Tail (xs :: [a]) :: [a] where+  Tail (x ': xs) = xs++-- | The constraint @LiftedCoercible f g x y@ is equivalent+-- to @Coercible (f x) (g y)@.+--+-- @since 0.3.1.0+--+class Coercible (f x) (g y) => LiftedCoercible f g x y+instance Coercible (f x) (g y) => LiftedCoercible f g x y++-- | Require a constraint for pointwise for every pair of+-- elements from two lists of lists.+--+--+class (AllZipF (AllZip f) xss yss, SListI xss, SListI yss, SameShapeAs xss yss, SameShapeAs yss xss) => AllZip2 f xss yss+instance (AllZipF (AllZip f) xss yss, SListI xss, SListI yss, SameShapeAs xss yss, SameShapeAs yss xss) => AllZip2 f xss yss+ -- | Composition of constraints. -- -- Note that the result of the composition must be a constraint,@@ -125,6 +205,13 @@ -- the argument is indexed by a list or a list of lists. -- type family AllN (h :: (k -> *) -> (l -> *)) (c :: k -> Constraint) :: l -> Constraint++-- | A generalization of 'AllZip' and 'AllZip2'.+--+-- The family 'AllZipN' expands to 'AllZip' or 'AllZip2' depending on+-- whther the argument is indexed by a list or a list of lists.+--+type family AllZipN (h :: (k -> *) -> (l -> *)) (c :: k1 -> k2 -> Constraint) :: l1 -> l2 -> Constraint  -- | A generalization of 'SListI'. --

@@ -64,12 +64,23 @@   , ccata_NP   , ana_NP   , cana_NP+    -- * Transformation of index lists and coercions+  , trans_NP+  , trans_POP+  , coerce_NP+  , coerce_POP+  , fromI_NP+  , fromI_POP+  , toI_NP+  , toI_POP   ) where  #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative #endif+import Data.Coerce import Data.Proxy (Proxy(..))+import Unsafe.Coerce  import Control.DeepSeq (NFData(..)) @@ -152,6 +163,9 @@ type instance AllN NP  c = All  c type instance AllN POP c = All2 c +type instance AllZipN NP  c = AllZip  c+type instance AllZipN POP c = AllZip2 c+ type instance SListIN NP  = SListI type instance SListIN POP = SListI2 @@ -266,6 +280,9 @@ _ap_POP_spec :: SListI xss => POP (f -.-> g) xss -> POP  f xss -> POP  g xss _ap_POP_spec (POP fs) (POP xs) = POP (liftA2_NP ap_NP fs xs) +type instance Same NP  = NP+type instance Same POP = POP+ type instance Prod NP  = NP type instance Prod POP = POP @@ -602,3 +619,124 @@     go SNil  _ = Nil     go SCons s = case uncons s of       (x, s') -> x :* go sList s'++-- | Specialization of 'htrans'.+--+-- @since 0.3.1.0+--+trans_NP ::+     AllZip c xs ys+  => proxy c+  -> (forall x y . c x y => f x -> g y)+  -> NP f xs -> NP g ys+trans_NP _ _t Nil       = Nil+trans_NP p  t (x :* xs) = t x :* trans_NP p t xs++-- | Specialization of 'htrans'.+--+-- @since 0.3.1.0+--+trans_POP ::+     AllZip2 c xss yss+  => proxy c+  -> (forall x y . c x y => f x -> g y)+  -> POP f xss -> POP g yss+trans_POP p t =+  POP . trans_NP (allZipP p) (trans_NP p t) . unPOP++allZipP :: proxy c -> Proxy (AllZip c)+allZipP _ = Proxy++-- | Specialization of 'hcoerce'.+--+-- @since 0.3.1.0+--+coerce_NP ::+     forall f g xs ys .+     AllZip (LiftedCoercible f g) xs ys+  => NP f xs -> NP g ys+coerce_NP =+  unsafeCoerce++-- There is a bug in the way coerce works for higher-kinded+-- type variables that seems to occur only in GHC 7.10.+--+-- Therefore, the safe versions of the coercion functions+-- are excluded below. This is harmless because they're only+-- present for documentation purposes and not exported.++#if __GLASGOW_HASKELL__ < 710 || __GLASGOW_HASKELL__ >= 800+_safe_coerce_NP ::+     forall f g xs ys .+     AllZip (LiftedCoercible f g) xs ys+  => NP f xs -> NP g ys+_safe_coerce_NP =+  trans_NP (Proxy :: Proxy (LiftedCoercible f g)) coerce+#endif++-- | Specialization of 'hcoerce'.+--+-- @since 0.3.1.0+--+coerce_POP ::+     forall f g xss yss .+     AllZip2 (LiftedCoercible f g) xss yss+  => POP f xss -> POP g yss+coerce_POP =+  unsafeCoerce++#if __GLASGOW_HASKELL__ < 710 || __GLASGOW_HASKELL__ >= 800+_safe_coerce_POP ::+     forall f g xss yss .+     AllZip2 (LiftedCoercible f g) xss yss+  => POP f xss -> POP g yss+_safe_coerce_POP =+  trans_POP (Proxy :: Proxy (LiftedCoercible f g)) coerce+#endif++-- | Specialization of 'hfromI'.+--+-- @since 0.3.1.0+--+fromI_NP ::+     forall f xs ys .+     AllZip (LiftedCoercible I f) xs ys+  => NP I xs -> NP f ys+fromI_NP = hfromI++-- | Specialization of 'htoI'.+--+-- @since 0.3.1.0+--+toI_NP ::+     forall f xs ys .+     AllZip (LiftedCoercible f I) xs ys+  => NP f xs -> NP I ys+toI_NP = htoI++-- | Specialization of 'hfromI'.+--+-- @since 0.3.1.0+--+fromI_POP ::+     forall f xss yss .+     AllZip2 (LiftedCoercible I f) xss yss+  => POP I xss -> POP f yss+fromI_POP = hfromI++-- | Specialization of 'htoI'.+--+-- @since 0.3.1.0+--+toI_POP ::+     forall f xss yss .+     AllZip2 (LiftedCoercible f I) xss yss+  => POP f xss -> POP I yss+toI_POP = htoI++instance HTrans NP NP where+  htrans  = trans_NP+  hcoerce = coerce_NP+instance HTrans POP POP where+  htrans  = trans_POP+  hcoerce = coerce_POP

@@ -59,12 +59,23 @@   , cexpand_NS   , expand_SOP   , cexpand_SOP+    -- * Transformation of index lists and coercions+  , trans_NS+  , trans_SOP+  , coerce_NS+  , coerce_SOP+  , fromI_NS+  , fromI_SOP+  , toI_NS+  , toI_SOP   ) where  #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative #endif+import Data.Coerce import Data.Proxy+import Unsafe.Coerce  import Control.DeepSeq (NFData(..)) @@ -342,6 +353,9 @@ _ap_SOP_spec :: SListI xss => POP (t -.-> f) xss -> SOP t xss -> SOP f xss _ap_SOP_spec (POP fs) (SOP xs) = SOP (liftA2_NS ap_NP fs xs) +type instance Same NS  = NS+type instance Same SOP = SOP+ type instance Prod NS  = NP type instance Prod SOP = POP @@ -591,3 +605,125 @@ instance HExpand SOP where   hexpand  = expand_SOP   hcexpand = cexpand_SOP++-- | Specialization of 'htrans'.+--+-- @since 0.3.1.0+--+trans_NS ::+     AllZip c xs ys+  => proxy c+  -> (forall x y . c x y => f x -> g y)+  -> NS f xs -> NS g ys+trans_NS _ t (Z x)      = Z (t x)+trans_NS p t (S x)      = S (trans_NS p t x)++-- | Specialization of 'htrans'.+--+-- @since 0.3.1.0+--+trans_SOP ::+     AllZip2 c xss yss+  => proxy c+  -> (forall x y . c x y => f x -> g y)+  -> SOP f xss -> SOP g yss+trans_SOP p t =+  SOP . trans_NS (allZipP p) (trans_NP p t) . unSOP++allZipP :: proxy c -> Proxy (AllZip c)+allZipP _ = Proxy++-- | Specialization of 'hcoerce'.+--+-- @since 0.3.1.0+--+coerce_NS ::+     forall f g xs ys .+     AllZip (LiftedCoercible f g) xs ys+  => NS f xs -> NS g ys+coerce_NS =+  unsafeCoerce++-- There is a bug in the way coerce works for higher-kinded+-- type variables that seems to occur only in GHC 7.10.+--+-- Therefore, the safe versions of the coercion functions+-- are excluded below. This is harmless because they're only+-- present for documentation purposes and not exported.++#if __GLASGOW_HASKELL__ < 710 || __GLASGOW_HASKELL__ >= 800+_safe_coerce_NS ::+     forall f g xs ys .+     AllZip (LiftedCoercible f g) xs ys+  => NS f xs -> NS g ys+_safe_coerce_NS =+  trans_NS (Proxy :: Proxy (LiftedCoercible f g)) coerce+#endif++-- | Specialization of 'hcoerce'.+--+-- @since 0.3.1.0+--+coerce_SOP ::+     forall f g xss yss .+     AllZip2 (LiftedCoercible f g) xss yss+  => SOP f xss -> SOP g yss+coerce_SOP =+  unsafeCoerce++#if __GLASGOW_HASKELL__ < 710 || __GLASGOW_HASKELL__ >= 800+_safe_coerce_SOP ::+     forall f g xss yss .+     AllZip2 (LiftedCoercible f g) xss yss+  => SOP f xss -> SOP g yss+_safe_coerce_SOP =+  trans_SOP (Proxy :: Proxy (LiftedCoercible f g)) coerce+#endif++-- | Specialization of 'hfromI'.+--+-- @since 0.3.1.0+--+fromI_NS ::+     forall f xs ys .+     AllZip (LiftedCoercible I f) xs ys+  => NS I xs -> NS f ys+fromI_NS = hfromI++-- | Specialization of 'htoI'.+--+-- @since 0.3.1.0+--+toI_NS ::+     forall f xs ys .+     AllZip (LiftedCoercible f I) xs ys+  => NS f xs -> NS I ys+toI_NS = htoI++-- | Specialization of 'hfromI'.+--+-- @since 0.3.1.0+--+fromI_SOP ::+     forall f xss yss .+     AllZip2 (LiftedCoercible I f) xss yss+  => SOP I xss -> SOP f yss+fromI_SOP = hfromI++-- | Specialization of 'htoI'.+--+-- @since 0.3.1.0+--+toI_SOP ::+     forall f xss yss .+     AllZip2 (LiftedCoercible f I) xss yss+  => SOP f xss -> SOP I yss+toI_SOP = htoI++instance HTrans NS NS where+  htrans  = trans_NS+  hcoerce = coerce_NS++instance HTrans SOP SOP where+  htrans  = trans_SOP+  hcoerce = coerce_SOP

@@ -5,6 +5,7 @@ -- | Codes and interpretations module Generics.SOP.Universe where +import Data.Coerce (Coercible) import qualified GHC.Generics as GHC  import Generics.SOP.BasicFunctors@@ -152,3 +153,42 @@   datatypeInfo         :: proxy a -> DatatypeInfo (Code a)   default datatypeInfo :: (GDatatypeInfo a, GCode a ~ Code a) => proxy a -> DatatypeInfo (Code a)   datatypeInfo = gdatatypeInfo++-- | Constraint that captures that a datatype is a product type,+-- i.e., a type with a single constructor.+--+-- It also gives access to the code for the arguments of that+-- constructor.+--+-- @since 0.3.1.0+--+type IsProductType (a :: *) (xs :: [*]) =+  (Generic a, Code a ~ '[ xs ])++-- | Constraint that captures that a datatype is an enumeration type,+-- i.e., none of the constructors have any arguments.+--+-- @since 0.3.1.0+--+type IsEnumType (a :: *) =+  (Generic a, All ((~) '[]) (Code a))++-- | Constraint that captures that a datatype is a single-constructor,+-- single-field datatype. This always holds for newtype-defined types,+-- but it can also be true for data-defined types.+--+-- The constraint also gives access to the type that is wrapped.+--+-- @since 0.3.1.0+--+type IsWrappedType (a :: *) (x :: *) =+  (Generic a, Code a ~ '[ '[ x ] ])++-- | Constraint that captures that a datatype is a newtype.+-- This makes use of the fact that newtypes are always coercible+-- to the type they wrap, whereas datatypes are not.+--+-- @since 0.3.1.0+--+type IsNewtype (a :: *) (x :: *) =+  (IsWrappedType a x, Coercible a x)

@@ -12,6 +12,8 @@ import Generics.SOP.TH import qualified Generics.SOP.Type.Metadata as T +import HTransExample+ -- Generic show, kind of gshow :: (Generic a, All2 Show (Code a)) => a -> String gshow x = gshowS (from x)@@ -76,3 +78,4 @@   print treeDatatypeInfo   print demotedTreeDatatypeInfo   print (treeDatatypeInfo == demotedTreeDatatypeInfo)+  print $ convertFull tree

@@ -0,0 +1,27 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+module HTransExample where++import Generics.SOP++class IsTupleTypeOf xs y | xs -> y where+  toTuple :: NP I xs -> y+  default toTuple :: (Generic y, Code y ~ '[ xs ]) => NP I xs -> y+  toTuple = to . SOP . Z++instance IsTupleTypeOf '[] ()+instance IsTupleTypeOf '[x1] x1 where toTuple = unI . hd+instance IsTupleTypeOf '[x1, x2] (x1, x2)+instance IsTupleTypeOf '[x1, x2, x3] (x1, x2, x3)+instance IsTupleTypeOf '[x1, x2, x3, x4] (x1, x2, x3, x4)++convert :: (AllZip IsTupleTypeOf xss ys) => NS (NP I) xss -> NS I ys+convert = htrans (Proxy :: Proxy IsTupleTypeOf) (I . toTuple)++convertFull :: (Generic a, AllZip IsTupleTypeOf (Code a) ys) => a -> NS I ys+convertFull = convert . unSOP . from