generics-sop 0.2.3.0 → 0.2.4.0

raw patch · 7 files changed

+402/−34 lines, 7 filesdep +transformersdep +transformers-compatPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: transformers, transformers-compat

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−2
• generics-sop.cabal +6/−3
• src/Generics/SOP.hs +7/−3
• src/Generics/SOP/BasicFunctors.hs +161/−6
• src/Generics/SOP/Classes.hs +130/−18
• src/Generics/SOP/Metadata.hs +20/−0
• src/Generics/SOP/NS.hs +68/−2

@@ -1,5 +1,13 @@-# 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  * Add `hdicts`.@@ -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 

@@ -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

@@ -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'

@@ -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-

@@ -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]

@@ -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 

@@ -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.@@ -211,6 +268,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