Hello community, here is the log from the commit of package ghc-generics-sop for openSUSE:Factory checked in at 2017-02-21 13:45:32 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-generics-sop (Old) and /work/SRC/openSUSE:Factory/.ghc-generics-sop.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-generics-sop" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-generics-sop/ghc-generics-sop.changes 2017-01-12 15:49:21.558391746 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-generics-sop.new/ghc-generics-sop.changes 2017-02-21 13:45:33.540837397 +0100 @@ -1,0 +2,5 @@ +Sun Feb 5 19:32:20 UTC 2017 - [email protected] + +- Update to version 0.2.4.0 with cabal2obs. + +------------------------------------------------------------------- Old: ---- generics-sop-0.2.3.0.tar.gz New: ---- generics-sop-0.2.4.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-generics-sop.spec ++++++ --- /var/tmp/diff_new_pack.ljIqif/_old 2017-02-21 13:45:33.952779282 +0100 +++ /var/tmp/diff_new_pack.ljIqif/_new 2017-02-21 13:45:33.956778717 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-generics-sop # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,7 +18,7 @@ %global pkg_name generics-sop Name: ghc-%{pkg_name} -Version: 0.2.3.0 +Version: 0.2.4.0 Release: 0 Summary: Generic Programming using True Sums of Products License: BSD-3-Clause ++++++ generics-sop-0.2.3.0.tar.gz -> generics-sop-0.2.4.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/generics-sop-0.2.3.0/CHANGELOG.md new/generics-sop-0.2.4.0/CHANGELOG.md --- old/generics-sop-0.2.3.0/CHANGELOG.md 2016-12-04 11:26:01.000000000 +0100 +++ new/generics-sop-0.2.4.0/CHANGELOG.md 2017-02-02 14:06:35.000000000 +0100 @@ -1,4 +1,12 @@ -# 0.2.3.0 +# 0.2.4.0 (2017-02-02) + +* Add `hindex` (and `index_NS` and `index_SOP`). + +* Add `hapInjs` as a generalization of `apInjs_NP` and `apInjs_POP`. + +* Make basic functors instances of lifted classes (such as `Eq1` etc). + +# 0.2.3.0 (2016-12-04) * Add various metadata getters @@ -25,7 +33,7 @@ `Projection` and `projections` as duals of `Injection` and `injections`. -# 0.2 (2015-10-23) +# 0.2.0.0 (2015-10-23) * Now tested with ghc-7.10 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/generics-sop-0.2.3.0/generics-sop.cabal new/generics-sop-0.2.4.0/generics-sop.cabal --- old/generics-sop-0.2.3.0/generics-sop.cabal 2016-12-04 11:26:01.000000000 +0100 +++ new/generics-sop-0.2.4.0/generics-sop.cabal 2017-02-02 14:06:35.000000000 +0100 @@ -1,5 +1,5 @@ name: generics-sop -version: 0.2.3.0 +version: 0.2.4.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 +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.* source-repository head type: git @@ -61,8 +61,11 @@ build-depends: base >= 4.6 && < 5, template-haskell >= 2.8 && < 2.13, ghc-prim >= 0.3 && < 0.6 - if impl (ghc < 7.8) + if !impl (ghc >= 7.8) build-depends: tagged >= 0.7 && < 0.9 + if !impl (ghc >= 8.0) + build-depends: transformers-compat >= 0.3 && < 0.6, + transformers >= 0.3 && < 0.6 hs-source-dirs: src default-language: Haskell2010 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/generics-sop-0.2.3.0/src/Generics/SOP/BasicFunctors.hs new/generics-sop-0.2.4.0/src/Generics/SOP/BasicFunctors.hs --- old/generics-sop-0.2.3.0/src/Generics/SOP/BasicFunctors.hs 2016-12-04 11:26:01.000000000 +0100 +++ new/generics-sop-0.2.4.0/src/Generics/SOP/BasicFunctors.hs 2017-02-02 14:06:35.000000000 +0100 @@ -39,6 +39,20 @@ #endif import qualified GHC.Generics as GHC +import Data.Functor.Classes + +#if MIN_VERSION_base(4,9,0) +#define LIFTED_CLASSES 1 +#else +#if MIN_VERSION_transformers(0,5,0) +#define LIFTED_CLASSES 1 +#else +#if MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0) +#define LIFTED_CLASSES 1 +#endif +#endif +#endif + -- | The constant type functor. -- -- Like 'Data.Functor.Constant.Constant', but kind-polymorphic @@ -46,9 +60,9 @@ -- newtype K (a :: *) (b :: k) = K a #if MIN_VERSION_base(4,7,0) - deriving (Show, Functor, Foldable, Traversable, GHC.Generic) + deriving (Functor, Foldable, Traversable, GHC.Generic) #else - deriving (Show, GHC.Generic) + deriving (GHC.Generic) instance Functor (K a) where fmap _ (K x) = K x @@ -61,6 +75,53 @@ traverse _ (K x) = pure (K x) #endif +#ifdef LIFTED_CLASSES +instance Eq2 K where + liftEq2 eq _ (K x) (K y) = eq x y +instance Ord2 K where + liftCompare2 comp _ (K x) (K y) = comp x y +instance Read2 K where + liftReadsPrec2 rp _ _ _ = readsData $ + readsUnaryWith rp "K" K +instance Show2 K where + liftShowsPrec2 sp _ _ _ d (K x) = showsUnaryWith sp "K" d x + +instance (Eq a) => Eq1 (K a) where + liftEq = liftEq2 (==) +instance (Ord a) => Ord1 (K a) where + liftCompare = liftCompare2 compare +instance (Read a) => Read1 (K a) where + liftReadsPrec = liftReadsPrec2 readsPrec readList +instance (Show a) => Show1 (K a) where + liftShowsPrec = liftShowsPrec2 showsPrec showList +#else +instance (Eq a) => Eq1 (K a) where + eq1 (K x) (K y) = x == y +instance (Ord a) => Ord1 (K a) where + compare1 (K x) (K y) = compare x y +instance (Read a) => Read1 (K a) where + readsPrec1 = readsData $ readsUnary "K" K +instance (Show a) => Show1 (K a) where + showsPrec1 d (K x) = showsUnary "K" d x +#endif + +-- This have to be implemented manually, K is polykinded. +instance (Eq a) => Eq (K a b) where + K x == K y = x == y +instance (Ord a) => Ord (K a b) where + compare (K x) (K y) = compare x y +#ifdef LIFTED_CLASSES +instance (Read a) => Read (K a b) where + readsPrec = readsData $ readsUnaryWith readsPrec "K" K +instance (Show a) => Show (K a b) where + showsPrec d (K x) = showsUnaryWith showsPrec "K" d x +#else +instance (Read a) => Read (K a b) where + readsPrec = readsData $ readsUnary "K" K +instance (Show a) => Show (K a b) where + showsPrec d (K x) = showsUnary "K" d x +#endif + instance Monoid a => Applicative (K a) where pure _ = K mempty K x <*> K y = K (x <> y) @@ -75,9 +136,9 @@ -- newtype I (a :: *) = I a #if MIN_VERSION_base(4,7,0) - deriving (Show, Functor, Foldable, Traversable, GHC.Generic) + deriving (Functor, Foldable, Traversable, GHC.Generic) #else - deriving (Show, GHC.Generic) + deriving (GHC.Generic) instance Functor I where fmap f (I x) = I (f x) @@ -98,6 +159,33 @@ return = I I x >>= f = f x + +#ifdef LIFTED_CLASSES +instance Eq1 I where + liftEq eq (I x) (I y) = eq x y +instance Ord1 I where + liftCompare comp (I x) (I y) = comp x y +instance Read1 I where + liftReadsPrec rp _ = readsData $ + readsUnaryWith rp "I" I +instance Show1 I where + liftShowsPrec sp _ d (I x) = showsUnaryWith sp "I" d x +#else +instance Eq1 I where + eq1 (I x) (I y) = x == y +instance Ord1 I where + compare1 (I x) (I y) = compare x y +instance Read1 I where + readsPrec1 = readsData $ readsUnary "I" I +instance Show1 I where + showsPrec1 d (I x) = showsUnary "I" d x +#endif + +instance (Eq a) => Eq (I a) where (==) = eq1 +instance (Ord a) => Ord (I a) where compare = compare1 +instance (Read a) => Read (I a) where readsPrec = readsPrec1 +instance (Show a) => Show (I a) where showsPrec = showsPrec1 + -- | Extract the contents of an 'I' value. unI :: I a -> a unI (I x) = x @@ -108,14 +196,81 @@ -- and with a shorter name. -- newtype (:.:) (f :: l -> *) (g :: k -> l) (p :: k) = Comp (f (g p)) - deriving (Show, GHC.Generic) + deriving (GHC.Generic) infixr 7 :.: instance (Functor f, Functor g) => Functor (f :.: g) where fmap f (Comp x) = Comp (fmap (fmap f) x) +-- Instances of lifted Prelude classes + +#ifdef LIFTED_CLASSES +instance (Eq1 f, Eq1 g) => Eq1 (f :.: g) where + liftEq eq (Comp x) (Comp y) = liftEq (liftEq eq) x y + +instance (Ord1 f, Ord1 g) => Ord1 (f :.: g) where + liftCompare comp (Comp x) (Comp y) = + liftCompare (liftCompare comp) x y + +instance (Read1 f, Read1 g) => Read1 (f :.: g) where + liftReadsPrec rp rl = readsData $ + readsUnaryWith (liftReadsPrec rp' rl') "Comp" Comp + where + rp' = liftReadsPrec rp rl + rl' = liftReadList rp rl + +instance (Show1 f, Show1 g) => Show1 (f :.: g) where + liftShowsPrec sp sl d (Comp x) = + showsUnaryWith (liftShowsPrec sp' sl') "Comp" d x + where + sp' = liftShowsPrec sp sl + sl' = liftShowList sp sl + +instance (Eq1 f, Eq1 g, Eq a) => Eq ((f :.: g) a) where (==) = eq1 +instance (Ord1 f, Ord1 g, Ord a) => Ord ((f :.: g) a) where compare = compare1 +instance (Read1 f, Read1 g, Read a) => Read ((f :.: g) a) where readsPrec = readsPrec1 +instance (Show1 f, Show1 g, Show a) => Show ((f :.: g) a) where showsPrec = showsPrec1 +#else +-- kludge to get type with the same instances as g a +newtype Apply g a = Apply (g a) + +getApply :: Apply g a -> g a +getApply (Apply x) = x + +instance (Eq1 g, Eq a) => Eq (Apply g a) where + Apply x == Apply y = eq1 x y + +instance (Ord1 g, Ord a) => Ord (Apply g a) where + compare (Apply x) (Apply y) = compare1 x y + +instance (Read1 g, Read a) => Read (Apply g a) where + readsPrec d s = [(Apply a, t) | (a, t) <- readsPrec1 d s] + +instance (Show1 g, Show a) => Show (Apply g a) where + showsPrec d (Apply x) = showsPrec1 d x + +instance (Functor f, Eq1 f, Eq1 g, Eq a) => Eq ((f :.: g) a) where + Comp x == Comp y = eq1 (fmap Apply x) (fmap Apply y) + +instance (Functor f, Ord1 f, Ord1 g, Ord a) => Ord ((f :.: g) a) where + compare (Comp x) (Comp y) = compare1 (fmap Apply x) (fmap Apply y) + +instance (Functor f, Read1 f, Read1 g, Read a) => Read ((f :.: g) a) where + readsPrec = readsData $ readsUnary1 "Comp" (Comp . fmap getApply) + +instance (Functor f, Show1 f, Show1 g, Show a) => Show ((f :.: g) a) where + showsPrec d (Comp x) = showsUnary1 "Comp" d (fmap Apply x) + +instance (Functor f, Eq1 f, Eq1 g) => Eq1 (f :.: g) where eq1 = (==) +instance (Functor f, Ord1 f, Ord1 g) => Ord1 (f :.: g) where + compare1 = compare +instance (Functor f, Read1 f, Read1 g) => Read1 (f :.: g) where + readsPrec1 = readsPrec +instance (Functor f, Show1 f, Show1 g) => Show1 (f :.: g) where + showsPrec1 = showsPrec +#endif + -- | Extract the contents of a 'Comp' value. unComp :: (f :.: g) p -> f (g p) unComp (Comp x) = x - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/generics-sop-0.2.3.0/src/Generics/SOP/Classes.hs new/generics-sop-0.2.4.0/src/Generics/SOP/Classes.hs --- old/generics-sop-0.2.3.0/src/Generics/SOP/Classes.hs 2016-12-04 11:26:01.000000000 +0100 +++ new/generics-sop-0.2.4.0/src/Generics/SOP/Classes.hs 2017-02-02 14:06:35.000000000 +0100 @@ -29,7 +29,45 @@ -- The actual instances are defined in "Generics.SOP.NP" and -- "Generics.SOP.NS". -- -module Generics.SOP.Classes where +module Generics.SOP.Classes + ( -- * Generalized applicative functor structure + -- ** Generalized 'Control.Applicative.pure' + HPure(..) + -- ** Generalized 'Control.Applicative.<*>' + , type (-.->)(..) + , fn + , fn_2 + , fn_3 + , fn_4 + , Prod + , HAp(..) + -- ** Derived functions + , hliftA + , hliftA2 + , hliftA3 + , hmap + , hzipWith + , hzipWith3 + , hcliftA + , hcliftA2 + , hcliftA3 + , hcmap + , hczipWith + , hczipWith3 + -- * Collapsing homogeneous structures + , CollapseTo + , HCollapse(..) + -- * Sequencing effects + , HSequence(..) + -- ** Derived functions + , hsequence + , hsequenceK + -- * Indexing into sums + , HIndex(..) + -- * Applying all injections + , UnProd + , HApInjs(..) + ) where #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative (Applicative) @@ -38,6 +76,10 @@ import Generics.SOP.BasicFunctors import Generics.SOP.Constraint +-- * Generalized applicative functor structure + +-- ** Generalized 'Control.Applicative.pure' + -- | A generalization of 'Control.Applicative.pure' or -- 'Control.Monad.return' to higher kinds. class HPure (h :: (k -> *) -> (l -> *)) where @@ -46,7 +88,7 @@ -- /Instances:/ -- -- @ - -- 'hpure', 'Generics.SOP.NP.pure_NP' :: 'SListI' xs => (forall a. f a) -> 'Generics.SOP.NP.NP' f xs + -- 'hpure', 'Generics.SOP.NP.pure_NP' :: 'Generics.SOP.Sing.SListI' xs => (forall a. f a) -> 'Generics.SOP.NP.NP' f xs -- 'hpure', 'Generics.SOP.NP.pure_POP' :: 'SListI2' xss => (forall a. f a) -> 'Generics.SOP.NP.POP' f xss -- @ -- @@ -76,14 +118,10 @@ -- hcpure :: (AllN h c xs) => proxy c -> (forall a. c a => f a) -> h f xs -{------------------------------------------------------------------------------- - Application --------------------------------------------------------------------------------} +-- ** Generalized 'Control.Applicative.<*>' -- | Lifted functions. newtype (f -.-> g) a = Fn { apFn :: f a -> g a } - --- TODO: What is the right precedence? infixr 1 -.-> -- | Construct a lifted function. @@ -138,9 +176,7 @@ -- hap :: Prod h (f -.-> g) xs -> h f xs -> h g xs -{------------------------------------------------------------------------------- - Derived from application --------------------------------------------------------------------------------} +-- ** Derived functions -- | A generalized form of 'Control.Applicative.liftA', -- which in turn is a generalized 'map'. @@ -157,8 +193,8 @@ -- /Instances:/ -- -- @ --- 'hliftA', 'Generics.SOP.NP.liftA_NP' :: 'SListI' xs => (forall a. f a -> f' a) -> 'Generics.SOP.NP.NP' f xs -> 'Generics.SOP.NP.NP' f' xs --- 'hliftA', 'Generics.SOP.NS.liftA_NS' :: 'SListI' xs => (forall a. f a -> f' a) -> 'Generics.SOP.NS.NS' f xs -> 'Generics.SOP.NS.NS' f' xs +-- 'hliftA', 'Generics.SOP.NP.liftA_NP' :: 'Generics.SOP.Sing.SListI' xs => (forall a. f a -> f' a) -> 'Generics.SOP.NP.NP' f xs -> 'Generics.SOP.NP.NP' f' xs +-- 'hliftA', 'Generics.SOP.NS.liftA_NS' :: 'Generics.SOP.Sing.SListI' xs => (forall a. f a -> f' a) -> 'Generics.SOP.NS.NS' f xs -> 'Generics.SOP.NS.NS' f' xs -- 'hliftA', 'Generics.SOP.NP.liftA_POP' :: 'SListI2' xss => (forall a. f a -> f' a) -> 'Generics.SOP.NP.POP' f xss -> 'Generics.SOP.NP.POP' f' xss -- 'hliftA', 'Generics.SOP.NS.liftA_SOP' :: 'SListI2' xss => (forall a. f a -> f' a) -> 'Generics.SOP.NS.SOP' f xss -> 'Generics.SOP.NS.SOP' f' xss -- @ @@ -183,8 +219,8 @@ -- /Instances:/ -- -- @ --- 'hliftA2', 'Generics.SOP.NP.liftA2_NP' :: 'SListI' xs => (forall a. f a -> f' a -> f'' a) -> 'Generics.SOP.NP.NP' f xs -> 'Generics.SOP.NP.NP' f' xs -> 'Generics.SOP.NP.NP' f'' xs --- 'hliftA2', 'Generics.SOP.NS.liftA2_NS' :: 'SListI' xs => (forall a. f a -> f' a -> f'' a) -> 'Generics.SOP.NP.NP' f xs -> 'Generics.SOP.NS.NS' f' xs -> 'Generics.SOP.NS.NS' f'' xs +-- 'hliftA2', 'Generics.SOP.NP.liftA2_NP' :: 'Generics.SOP.Sing.SListI' xs => (forall a. f a -> f' a -> f'' a) -> 'Generics.SOP.NP.NP' f xs -> 'Generics.SOP.NP.NP' f' xs -> 'Generics.SOP.NP.NP' f'' xs +-- 'hliftA2', 'Generics.SOP.NS.liftA2_NS' :: 'Generics.SOP.Sing.SListI' xs => (forall a. f a -> f' a -> f'' a) -> 'Generics.SOP.NP.NP' f xs -> 'Generics.SOP.NS.NS' f' xs -> 'Generics.SOP.NS.NS' f'' xs -- 'hliftA2', 'Generics.SOP.NP.liftA2_POP' :: 'SListI2' xss => (forall a. f a -> f' a -> f'' a) -> 'Generics.SOP.NP.POP' f xss -> 'Generics.SOP.NP.POP' f' xss -> 'Generics.SOP.NP.POP' f'' xss -- 'hliftA2', 'Generics.SOP.NS.liftA2_SOP' :: 'SListI2' xss => (forall a. f a -> f' a -> f'' a) -> 'Generics.SOP.NP.POP' f xss -> 'Generics.SOP.NS.SOP' f' xss -> 'Generics.SOP.NS.SOP' f'' xss -- @ @@ -209,8 +245,8 @@ -- /Instances:/ -- -- @ --- 'hliftA3', 'Generics.SOP.NP.liftA3_NP' :: 'SListI' xs => (forall a. f a -> f' a -> f'' a -> f''' a) -> 'Generics.SOP.NP.NP' f xs -> 'Generics.SOP.NP.NP' f' xs -> 'Generics.SOP.NP.NP' f'' xs -> 'Generics.SOP.NP.NP' f''' xs --- 'hliftA3', 'Generics.SOP.NS.liftA3_NS' :: 'SListI' xs => (forall a. f a -> f' a -> f'' a -> f''' a) -> 'Generics.SOP.NP.NP' f xs -> 'Generics.SOP.NP.NP' f' xs -> 'Generics.SOP.NS.NS' f'' xs -> 'Generics.SOP.NS.NS' f''' xs +-- 'hliftA3', 'Generics.SOP.NP.liftA3_NP' :: 'Generics.SOP.Sing.SListI' xs => (forall a. f a -> f' a -> f'' a -> f''' a) -> 'Generics.SOP.NP.NP' f xs -> 'Generics.SOP.NP.NP' f' xs -> 'Generics.SOP.NP.NP' f'' xs -> 'Generics.SOP.NP.NP' f''' xs +-- 'hliftA3', 'Generics.SOP.NS.liftA3_NS' :: 'Generics.SOP.Sing.SListI' xs => (forall a. f a -> f' a -> f'' a -> f''' a) -> 'Generics.SOP.NP.NP' f xs -> 'Generics.SOP.NP.NP' f' xs -> 'Generics.SOP.NS.NS' f'' xs -> 'Generics.SOP.NS.NS' f''' xs -- 'hliftA3', 'Generics.SOP.NP.liftA3_POP' :: 'SListI2' xss => (forall a. f a -> f' a -> f'' a -> f''' a) -> 'Generics.SOP.NP.POP' f xss -> 'Generics.SOP.NP.POP' f' xss -> 'Generics.SOP.NP.POP' f'' xss -> 'Generics.SOP.NP.POP' f''' xs -- 'hliftA3', 'Generics.SOP.NS.liftA3_SOP' :: 'SListI2' xss => (forall a. f a -> f' a -> f'' a -> f''' a) -> 'Generics.SOP.NP.POP' f xss -> 'Generics.SOP.NP.POP' f' xss -> 'Generics.SOP.NS.SOP' f'' xss -> 'Generics.SOP.NP.SOP' f''' xs -- @ @@ -299,6 +335,8 @@ hczipWith = hcliftA2 hczipWith3 = hcliftA3 +-- * Collapsing homogeneous structures + -- | Maps products to lists, and sums to identities. type family CollapseTo (h :: (k -> *) -> (l -> *)) (x :: *) :: * @@ -326,6 +364,8 @@ -- hcollapse :: SListIN h xs => h (K a) xs -> CollapseTo h a +-- * Sequencing effects + -- | A generalization of 'Data.Traversable.sequenceA'. class HAp h => HSequence (h :: (k -> *) -> (l -> *)) where @@ -336,14 +376,16 @@ -- /Instances:/ -- -- @ - -- 'hsequence'', 'Generics.SOP.NP.sequence'_NP' :: ('SListI' xs , 'Applicative' f) => 'Generics.SOP.NP.NP' (f ':.:' g) xs -> f ('Generics.SOP.NP.NP' g xs ) - -- 'hsequence'', 'Generics.SOP.NS.sequence'_NS' :: ('SListI' xs , 'Applicative' f) => 'Generics.SOP.NS.NS' (f ':.:' g) xs -> f ('Generics.SOP.NS.NS' g xs ) + -- 'hsequence'', 'Generics.SOP.NP.sequence'_NP' :: ('Generics.SOP.Sing.SListI' xs , 'Applicative' f) => 'Generics.SOP.NP.NP' (f ':.:' g) xs -> f ('Generics.SOP.NP.NP' g xs ) + -- 'hsequence'', 'Generics.SOP.NS.sequence'_NS' :: ('Generics.SOP.Sing.SListI' xs , 'Applicative' f) => 'Generics.SOP.NS.NS' (f ':.:' g) xs -> f ('Generics.SOP.NS.NS' g xs ) -- 'hsequence'', 'Generics.SOP.NP.sequence'_POP' :: ('SListI2' xss, 'Applicative' f) => 'Generics.SOP.NP.POP' (f ':.:' g) xss -> f ('Generics.SOP.NP.POP' g xss) -- 'hsequence'', 'Generics.SOP.NS.sequence'_SOP' :: ('SListI2' xss, 'Applicative' f) => 'Generics.SOP.NS.SOP' (f ':.:' g) xss -> f ('Generics.SOP.NS.SOP' g xss) -- @ -- hsequence' :: (SListIN h xs, Applicative f) => h (f :.: g) xs -> f (h g xs) +-- ** Derived functions + -- | Special case of 'hsequence'' where @g = 'I'@. hsequence :: (SListIN h xs, SListIN (Prod h) xs, HSequence h) => Applicative f => h f xs -> f (h I xs) hsequence = hsequence' . hliftA (Comp . fmap I) @@ -351,3 +393,73 @@ -- | Special case of 'hsequence'' where @g = 'K' a@. hsequenceK :: (SListIN h xs, SListIN (Prod h) xs, Applicative f, HSequence h) => h (K (f a)) xs -> f (h (K a) xs) hsequenceK = hsequence' . hliftA (Comp . fmap K . unK) + +-- * Indexing into sums + +-- | A class for determining which choice in a sum-like structure +-- a value represents. +-- +class HIndex (h :: (k -> *) -> (l -> *)) where + + -- | If 'h' is a sum-like structure representing a choice + -- between @n@ different options, and @x@ is a value of + -- type @h f xs@, then @'hindex' x@ returns a number between + -- @0@ and @n - 1@ representing the index of the choice + -- made by @x@. + -- + -- /Instances:/ + -- + -- @ + -- 'hindex', 'Generics.SOP.NS.index_NS' :: 'Generics.SOP.NS.NS' f xs -> Int + -- 'hindex', 'Generics.SOP.NS.index_SOP' :: 'Generics.SOP.NS.SOP' f xs -> Int + -- @ + -- + -- /Examples:/ + -- + -- >>> hindex (S (S (Z (I False)))) + -- 2 + -- >>> hindex (Z (K ())) + -- 0 + -- >>> hindex (SOP (S (Z (I True :* I 'x' :* Nil)))) + -- 1 + -- + -- @since 0.2.4.0 + -- + hindex :: h f xs -> Int + +-- * Applying all injections + +-- | Maps a structure containing products to the corresponding +-- sum structure. +-- +-- @since 0.2.4.0 +-- +type family UnProd (h :: (k -> *) -> (l -> *)) :: (k -> *) -> (l -> *) + +-- | A class for applying all injections corresponding to a sum-like +-- structure to a table containing suitable arguments. +-- +class (UnProd (Prod h) ~ h) => HApInjs (h :: (k -> *) -> (l -> *)) where + + -- | For a given table (product-like structure), produce a list where + -- each element corresponds to the application of an injection function + -- into the corresponding sum-like structure. + -- + -- /Instances:/ + -- + -- @ + -- 'hapInjs', 'Generics.SOP.NS.apInjs_NP' :: 'Generics.SOP.Sing.SListI' xs => 'Generics.SOP.NP.NP' f xs -> ['Generics.SOP.NS.NS' f xs ] + -- 'hapInjs', 'Generics.SOP.NS.apInjs_SOP' :: 'SListI2' xss => 'Generics.SOP.NP.POP' f xs -> ['Generics.SOP.NS.SOP' f xss] + -- @ + -- + -- /Examples:/ + -- + -- >>> hapInjs (I 'x' :* I True :* I 2 :* Nil) + -- [Z (I 'x'), S (Z (I True)), S (S (Z (I 2)))] + -- + -- >>> hapInjs (POP ((I 'x' :* Nil) :* (I True :* I 2 :* Nil) :* Nil) + -- [SOP (Z (I 'x' :* Nil)), SOP (S (Z (I True :* (I 2 :* Nil))))] + -- + -- @since 0.2.4.0 + -- + hapInjs :: (SListIN h xs) => Prod h f xs -> [h f xs] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/generics-sop-0.2.3.0/src/Generics/SOP/Metadata.hs new/generics-sop-0.2.4.0/src/Generics/SOP/Metadata.hs --- old/generics-sop-0.2.3.0/src/Generics/SOP/Metadata.hs 2016-12-04 11:26:01.000000000 +0100 +++ new/generics-sop-0.2.4.0/src/Generics/SOP/Metadata.hs 2017-02-02 14:06:35.000000000 +0100 @@ -39,14 +39,26 @@ -- Newtype Newtype :: ModuleName -> DatatypeName -> ConstructorInfo '[x] -> DatatypeInfo '[ '[x] ] +-- | The module name where a datatype is defined. +-- +-- @since 0.2.3.0 +-- moduleName :: DatatypeInfo xss -> ModuleName moduleName (ADT name _ _) = name moduleName (Newtype name _ _) = name +-- | The name of a datatype (or newtype). +-- +-- @since 0.2.3.0 +-- datatypeName :: DatatypeInfo xss -> DatatypeName datatypeName (ADT _ name _ ) = name datatypeName (Newtype _ name _) = name +-- | The constructor info for a datatype (or newtype). +-- +-- @since 0.2.3.0 +-- constructorInfo :: DatatypeInfo xss -> NP ConstructorInfo xss constructorInfo (ADT _ _ cs) = cs constructorInfo (Newtype _ _ c) = c :* Nil @@ -67,6 +79,10 @@ -- Record constructor Record :: SListI xs => ConstructorName -> NP FieldInfo xs -> ConstructorInfo xs +-- | The name of a constructor. +-- +-- @since 0.2.3.0 +-- constructorName :: ConstructorInfo xs -> ConstructorName constructorName (Constructor name) = name constructorName (Infix name _ _) = name @@ -81,6 +97,10 @@ FieldInfo :: FieldName -> FieldInfo a deriving (Show, Eq, Ord, Functor) +-- | The name of a field. +-- +-- @since 0.2.3.0 +-- fieldName :: FieldInfo a -> FieldName fieldName (FieldInfo n) = n diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/generics-sop-0.2.3.0/src/Generics/SOP/NS.hs new/generics-sop-0.2.4.0/src/Generics/SOP/NS.hs --- old/generics-sop-0.2.3.0/src/Generics/SOP/NS.hs 2016-12-04 11:26:01.000000000 +0100 +++ new/generics-sop-0.2.4.0/src/Generics/SOP/NS.hs 2017-02-02 14:06:35.000000000 +0100 @@ -1,11 +1,14 @@ -{-# LANGUAGE PolyKinds, StandaloneDeriving, UndecidableInstances #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} -- | n-ary sums (and sums of products) module Generics.SOP.NS ( -- * Datatypes NS(..) , SOP(..) - , unZ , unSOP -- * Constructing sums , Injection @@ -14,6 +17,10 @@ , shiftInjection , apInjs_NP , apInjs_POP + -- * Destructing sums + , unZ + , index_NS + , index_SOP -- * Application , ap_NS , ap_SOP @@ -123,6 +130,31 @@ unZ (Z x) = x unZ _ = error "inaccessible" -- needed even in GHC 8.0.1 +-- | Obtain the index from an n-ary sum. +-- +-- An n-nary sum represents a choice between n different options. +-- This function returns an integer between 0 and n - 1 indicating +-- the option chosen by the given value. +-- +-- /Examples:/ +-- +-- >>> index_NS (S (S (Z (I False)))) +-- 2 +-- >>> index_NS (Z (K ())) +-- 0 +-- +-- @since 0.2.4.0 +-- +index_NS :: forall f xs . NS f xs -> Int +index_NS = go 0 + where + go :: forall ys . Int -> NS f ys -> Int + go !acc (Z _) = acc + go !acc (S x) = go (acc + 1) x + +instance HIndex NS where + hindex = index_NS + -- | A sum of products. -- -- This is a 'newtype' for an 'NS' of an 'NP'. The elements of the @@ -146,6 +178,31 @@ unSOP :: SOP f xss -> NS (NP f) xss unSOP (SOP xss) = xss +-- | Obtain the index from an n-ary sum of products. +-- +-- An n-nary sum represents a choice between n different options. +-- This function returns an integer between 0 and n - 1 indicating +-- the option chosen by the given value. +-- +-- /Specification:/ +-- +-- @ +-- 'index_SOP' = 'index_NS' '.' 'unSOP' +-- @ +-- +-- /Example:/ +-- +-- >>> index_SOP (SOP (S (Z (I True :* I 'x' :* Nil)))) +-- 1 +-- +-- @since 0.2.4.0 +-- +index_SOP :: SOP f xs -> Int +index_SOP = index_NS . unSOP + +instance HIndex SOP where + hindex = index_SOP + -- * Constructing sums -- | The type of injections into an n-ary sum. @@ -212,6 +269,15 @@ apInjs_POP :: SListI xss => POP f xss -> [SOP f xss] apInjs_POP = map SOP . apInjs_NP . unPOP +type instance UnProd NP = NS +type instance UnProd POP = SOP + +instance HApInjs NS where + hapInjs = apInjs_NP + +instance HApInjs SOP where + hapInjs = apInjs_POP + -- * Application -- | Specialization of 'hap'. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/generics-sop-0.2.3.0/src/Generics/SOP.hs new/generics-sop-0.2.4.0/src/Generics/SOP.hs --- old/generics-sop-0.2.3.0/src/Generics/SOP.hs 2016-12-04 11:26:01.000000000 +0100 +++ new/generics-sop-0.2.4.0/src/Generics/SOP.hs 2017-02-02 14:06:35.000000000 +0100 @@ -221,7 +221,6 @@ -- * n-ary datatypes , NP(..) , NS(..) - , unZ , SOP(..) , unSOP , POP(..) @@ -277,8 +276,13 @@ , injections , shift , shiftInjection - , apInjs_NP - , apInjs_POP + , UnProd + , HApInjs(..) + , apInjs_NP -- deprecated export + , apInjs_POP -- deprecated export + -- ** Destructing sums + , unZ + , HIndex(..) -- ** Dealing with @'All' c@ , hcliftA' , hcliftA2'
