generics-sop 0.3.1.0 → 0.3.2.0

raw patch · 8 files changed

+631/−48 lines, 8 filesdep −taggeddep ~template-haskelldep ~transformersdep ~transformers-compatPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: tagged

Dependency ranges changed: template-haskell, transformers, transformers-compat

API changes (from Hackage documentation)

Files

• CHANGELOG.md +18/−1
• doctest.sh +24/−0
• generics-sop.cabal +5/−8
• src/Generics/SOP.hs +31/−4
• src/Generics/SOP/Classes.hs +110/−7
• src/Generics/SOP/NP.hs +157/−10
• src/Generics/SOP/NS.hs +263/−8
• src/Generics/SOP/TH.hs +23/−10

@@ -1,6 +1,23 @@+# 0.3.2.0 (2018-01-08)++* Make TH `deriveGenericFunctions` work properly with+  parameterized types (note that the more widely used+  `deriveGeneric` was already working correctly).++* Make TH `deriveGeneric` work properly with empty+  types.++* Add `compare_NS`, `ccompare_NS`, `compare_SOP`, and+  `ccompare_SOP` to better support comparison of sum+  structures.++* Add `hctraverse_` and `hctraverse'` as well as their+  unconstrained variants and a number of derived functions,+  to support effectful traversals.+ # 0.3.1.0 (2017-06-11) -* Add AllZip, htrans, hcoerce, hfromI, htoI.+* Add `AllZip`, `htrans`, `hcoerce`, `hfromI`, `htoI`.   These functions are for converting between related   structures that do not have common signatures. 

@@ -0,0 +1,24 @@+#!/bin/sh++set -ex++doctest --preserve-it \+  -XCPP \+  -XScopedTypeVariables \+  -XTypeFamilies \+  -XRankNTypes \+  -XTypeOperators \+  -XGADTs \+  -XConstraintKinds \+  -XMultiParamTypeClasses \+  -XTypeSynonymInstances \+  -XFlexibleInstances \+  -XFlexibleContexts \+  -XDeriveFunctor \+  -XDeriveFoldable \+  -XDeriveTraversable \+  -XDefaultSignatures \+  -XKindSignatures \+  -XDataKinds \+  -XFunctionalDependencies \+  $(find src -name '*.hs')

@@ -1,5 +1,5 @@ name:                generics-sop-version:             0.3.1.0+version:             0.3.2.0 synopsis:            Generic Programming using True Sums of Products description:   A library to support the definition of generic functions.@@ -36,8 +36,8 @@ category:            Generics build-type:          Simple cabal-version:       >=1.10-extra-source-files:  CHANGELOG.md-tested-with:         GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1, GHC == 8.0.2, GHC == 8.1.*+extra-source-files:  CHANGELOG.md doctest.sh+tested-with:         GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1, GHC == 8.0.2, GHC == 8.2.1, GHC == 8.2.2, GHC == 8.3.*  source-repository head   type:                git@@ -60,11 +60,9 @@                        Generics.SOP.Universe                        Generics.SOP.Sing   build-depends:       base                 >= 4.7  && < 5,-                       template-haskell     >= 2.8  && < 2.13,+                       template-haskell     >= 2.8  && < 2.14,                        ghc-prim             >= 0.3  && < 0.6,                        deepseq              >= 1.3  && < 1.5-  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@@ -90,8 +88,7 @@                        KindSignatures                        DataKinds                        FunctionalDependencies-  if impl (ghc >= 7.8)-    default-extensions:  AutoDeriveTypeable+                       AutoDeriveTypeable   other-extensions:    OverloadedStrings                        PolyKinds                        UndecidableInstances

@@ -145,16 +145,20 @@ -- -- @ -- grnf :: ('Generic' a, 'All2' NFData ('Code' a)) => a -> ()--- grnf = 'rnf' . 'hcollapse' . 'hcliftA' ('Proxy' :: 'Proxy' NFData) (\\ ('I' x) -> 'K' (rnf x)) . 'from'+-- grnf = 'rnf' . 'hcollapse' . 'hcmap' ('Proxy' :: 'Proxy' NFData) ('mapIK' rnf) . 'from' -- @ --+-- 'mapIK' and friends ('mapII', 'mapKI', etc.) are small helpers for working+-- with 'I' and 'K' functors, for example 'mapIK' is defined as+-- @'mapIK' f = \\ ('I' x) -> 'K' (f x)@+-- -- The following interaction should provide an idea of the individual -- transformation steps: -- -- >>> let x = G 2.5 'A' False :: B Double -- >>> from x -- SOP (S (Z (I 2.5 :* I 'A' :* I False :* Nil)))--- >>> hcliftA (Proxy :: Proxy NFData) (\ (I x) -> K (rnf x)) it+-- >>> hcmap (Proxy :: Proxy NFData) (mapIK rnf) it -- SOP (S (Z (K () :* K () :* K () :* Nil))) -- >>> hcollapse it -- [(),(),()]@@ -162,7 +166,7 @@ -- () -- -- The 'from' call converts into the structural representation.--- Via 'hcliftA', we apply 'rnf' to all the components. The result+-- Via 'hcmap', we apply 'rnf' to all the components. The result -- is a sum of products of the same shape, but the components are -- no longer heterogeneous ('I'), but homogeneous (@'K' ()@). A -- homogeneous structure can be collapsed ('hcollapse') into a@@ -179,6 +183,7 @@ -- () -- >>> grnf (G 2.5 undefined False) -- *** Exception: Prelude.undefined+-- ... -- -- Note that the type of 'grnf' requires that all components of the -- type are in the 'Control.DeepSeq.NFData' class. For a recursive@@ -291,13 +296,23 @@   , hcliftA'   , hcliftA2'   , hcliftA3'+    -- ** Comparison+  , compare_NS+  , ccompare_NS+  , compare_SOP+  , ccompare_SOP     -- ** Collapsing   , CollapseTo   , HCollapse(..)-    -- ** Sequencing+    -- ** Folding and sequencing+  , HTraverse_(..)+  , hcfoldMap+  , hcfor_   , HSequence(..)   , hsequence   , hsequenceK+  , hctraverse+  , hcfor     -- ** Expanding sums to products   , HExpand(..)     -- ** Transformation of index lists and coercions@@ -376,3 +391,15 @@ import Generics.SOP.Universe import Generics.SOP.Sing +-- $setup+--+-- >>> :set -XDeriveGeneric+-- >>> import qualified GHC.Generics as GHC+-- >>> import Generics.SOP+-- >>> import Control.DeepSeq+-- >>> data B a = F | G a Char Bool deriving (Show, GHC.Generic)+-- >>> data A   = C Bool | D A Int | E (B ()) deriving (Show, GHC.Generic)+-- >>> instance Generic A     -- empty+-- >>> instance Generic (B a) -- empty+--+-- >>> let grnf = rnf . hcollapse . hcmap (Proxy :: Proxy NFData) (\ (I x) -> K (rnf x)) . from

@@ -58,11 +58,16 @@     -- * Collapsing homogeneous structures   , CollapseTo   , HCollapse(..)-    -- * Sequencing effects+    -- * Folding and sequencing+  , HTraverse_(..)   , HSequence(..)     -- ** Derived functions+  , hcfoldMap+  , hcfor_   , hsequence   , hsequenceK+  , hctraverse+  , hcfor     -- * Indexing into sums   , HIndex(..)     -- * Applying all injections@@ -78,6 +83,7 @@  #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative (Applicative)+import Data.Monoid (Monoid) #endif  import Generics.SOP.BasicFunctors@@ -374,6 +380,56 @@   --   hcollapse :: SListIN h xs => h (K a) xs -> CollapseTo h a +-- | A generalization of 'Data.Foldable.traverse_' or 'Data.Foldable.foldMap'.+--+-- @since 0.3.2.0+--+class HTraverse_ (h :: (k -> *) -> (l -> *)) where++  -- | Corresponds to 'Data.Foldable.traverse_'.+  --+  -- /Instances:/+  --+  -- @+  -- 'hctraverse_', 'Generics.SOP.NP.ctraverse__NP'  :: ('All'  c xs , 'Applicative' g) => proxy c -> (forall a. c a => f a -> g ()) -> 'Generics.SOP.NP.NP'  f xs  -> g ()+  -- 'hctraverse_', 'Generics.SOP.NS.ctraverse__NS'  :: ('All2' c xs , 'Applicative' g) => proxy c -> (forall a. c a => f a -> g ()) -> 'Generics.SOP.NS.NS'  f xs  -> g ()+  -- 'hctraverse_', 'Generics.SOP.NP.ctraverse__POP' :: ('All'  c xss, 'Applicative' g) => proxy c -> (forall a. c a => f a -> g ()) -> 'Generics.SOP.NP.POP' f xss -> g ()+  -- 'hctraverse_', 'Generics.SOP.NS.ctraverse__SOP' :: ('All2' c xss, 'Applicative' g) => proxy c -> (forall a. c a => f a -> g ()) -> 'Generics.SOP.NS.SOP' f xss -> g ()+  -- @+  --+  -- @since 0.3.2.0+  --+  hctraverse_ :: (AllN h c xs, Applicative g) => proxy c -> (forall a. c a => f a -> g ()) -> h f xs -> g ()++  -- | Unconstrained version of 'hctraverse_'.+  --+  -- /Instances:/+  --+  -- @+  -- 'traverse_', 'Generics.SOP.NP.traverse__NP'  :: ('SListI'  xs , 'Applicative g') => (forall a. f a -> g ()) -> 'Generics.SOP.NP.NP'  f xs  -> g ()+  -- 'traverse_', 'Generics.SOP.NS.traverse__NS'  :: ('SListI'  xs , 'Applicative g') => (forall a. f a -> g ()) -> 'Generics.SOP.NS.NS'  f xs  -> g ()+  -- 'traverse_', 'Generics.SOP.NP.traverse__POP' :: ('SListI2' xss, 'Applicative g') => (forall a. f a -> g ()) -> 'Generics.SOP.NP.POP' f xss -> g ()+  -- 'traverse_', 'Generics.SOP.NS.traverse__SOP' :: ('SListI2' xss, 'Applicative g') => (forall a. f a -> g ()) -> 'Generics.SOP.NS.SOP' f xss -> g ()+  -- @+  --+  -- @since 0.3.2.0+  --+  htraverse_ :: (SListIN h xs, Applicative g) => (forall a. f a -> g ()) -> h f xs -> g ()++-- | Flipped version of 'hctraverse_'.+--+-- @since 0.3.2.0+--+hcfor_ :: (HTraverse_ h, AllN h c xs, Applicative g) => proxy c -> h f xs -> (forall a. c a => f a -> g ()) -> g ()+hcfor_ p xs f = hctraverse_ p f xs++-- | Special case of 'hctraverse_'.+--+-- @since 0.3.2.0+--+hcfoldMap :: (HTraverse_ h, AllN h c xs, Monoid m) => proxy c -> (forall a. c a => f a -> m) -> h f xs -> m+hcfoldMap p f = unK . hctraverse_ p (K . f)+ -- * Sequencing effects  -- | A generalization of 'Data.Traversable.sequenceA'.@@ -394,8 +450,53 @@   --   hsequence' :: (SListIN h xs, Applicative f) => h (f :.: g) xs -> f (h g xs) ++  -- | Corresponds to 'Data.Traversable.traverse'.+  --+  -- /Instances:/+  --+  -- @+  -- 'hctraverse'', 'Generics.SOP.NP.ctraverse'_NP'  :: ('All'  c xs , 'Applicative' g) => proxy c -> (forall a. c a => f a -> g (f' a)) -> 'Generics.SOP.NP.NP'  f xs  -> g ('Generics.SOP.NP.NP'  f' xs )+  -- 'hctraverse'', 'Generics.SOP.NS.ctraverse'_NS'  :: ('All2' c xs , 'Applicative' g) => proxy c -> (forall a. c a => f a -> g (f' a)) -> 'Generics.SOP.NS.NS'  f xs  -> g ('Generics.SOP.NS.NS'  f' xs )+  -- 'hctraverse'', 'Generics.SOP.NP.ctraverse'_POP' :: ('All'  c xss, 'Applicative' g) => proxy c -> (forall a. c a => f a -> g (f' a)) -> 'Generics.SOP.NP.POP' f xss -> g ('Generics.SOP.NP.POP' f' xss)+  -- 'hctraverse'', 'Generics.SOP.NS.ctraverse'_SOP' :: ('All2' c xss, 'Applicative' g) => proxy c -> (forall a. c a => f a -> g (f' a)) -> 'Generics.SOP.NS.SOP' f xss -> g ('Generics.SOP.NS.SOP' f' xss)+  -- @+  --+  -- @since 0.3.2.0+  --+  hctraverse' :: (AllN h c xs, Applicative g) => proxy c -> (forall a. c a => f a -> g (f' a)) -> h f xs -> g (h f' xs)++  -- | Unconstrained variant of `htraverse'`.+  --+  -- /Instances:/+  --+  -- @+  -- 'htraverse'', 'Generics.SOP.NP.traverse'_NP'  :: ('SListI'  xs , 'Applicative' g) => (forall a. c a => f a -> g (f' a)) -> 'Generics.SOP.NP.NP'  f xs  -> g ('Generics.SOP.NP.NP'  f' xs )+  -- 'htraverse'', 'Generics.SOP.NS.traverse'_NS'  :: ('SListI2' xs , 'Applicative' g) => (forall a. c a => f a -> g (f' a)) -> 'Generics.SOP.NS.NS'  f xs  -> g ('Generics.SOP.NS.NS'  f' xs )+  -- 'htraverse'', 'Generics.SOP.NP.traverse'_POP' :: ('SListI'  xss, 'Applicative' g) => (forall a. c a => f a -> g (f' a)) -> 'Generics.SOP.NP.POP' f xss -> g ('Generics.SOP.NP.POP' f' xss)+  -- 'htraverse'', 'Generics.SOP.NS.traverse'_SOP' :: ('SListI2' xss, 'Applicative' g) => (forall a. c a => f a -> g (f' a)) -> 'Generics.SOP.NS.SOP' f xss -> g ('Generics.SOP.NS.SOP' f' xss)+  -- @+  --+  -- @since 0.3.2.0+  --+  htraverse' :: (SListIN h xs, Applicative g) => (forall a. f a -> g (f' a)) -> h f xs -> g (h f' xs)+ -- ** Derived functions +-- | Special case of 'hctraverse'' where @f' = 'I'@.+--+-- @since 0.3.2.0+--+hctraverse :: (HSequence h, AllN h c xs, Applicative g) => proxy c -> (forall a. c a => f a -> g a) -> h f xs -> g (h I xs)+hctraverse p f = hctraverse' p (fmap I . f)++-- | Flipped version of 'hctraverse'.+--+-- @since 0.3.2.0+--+hcfor :: (HSequence h, AllN h c xs, Applicative g) => proxy c -> h f xs -> (forall a. c a => f a -> g a) -> g (h I xs)+hcfor p xs f = hctraverse p f xs+ -- | 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)@@ -464,12 +565,14 @@   --   -- /Examples:/   ---  -- >>> hapInjs (I 'x' :* I True :* I 2 :* Nil)-  -- [Z (I 'x'), S (Z (I True)), S (S (Z (I 2)))]+  -- >>> hapInjs (I 'x' :* I True :* I 2 :* Nil) :: [NS I '[Char, Bool, Int]]+  -- [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))))]+  -- >>> hapInjs (POP ((I 'x' :* Nil) :* (I True :* I 2 :* Nil) :* Nil)) :: [SOP I '[ '[Char], '[Bool, Int]]]+  -- [SOP (Z (I 'x' :* Nil)),SOP (S (Z (I True :* I 2 :* Nil)))]   --+  -- Unfortunately the type-signatures are required in GHC-7.10 and older.+  --   -- @since 0.2.4.0   --   hapInjs :: (SListIN h xs) => Prod h f xs -> [h f xs]@@ -551,9 +654,9 @@   -- /Examples:/   --   -- >>> hcoerce (I (Just LT) :* I (Just 'x') :* I (Just True) :* Nil) :: NP Maybe '[Ordering, Char, Bool]-  -- Just LT :* (Just 'x' :* (Just True :* Nil))+  -- 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)))+  -- SOP (Z (I True :* I False :* Nil))   --   -- @since 0.3.1.0   hcoerce ::

@@ -54,11 +54,23 @@     -- * Collapsing   , collapse_NP   , collapse_POP-    -- * Sequencing+    -- * Folding and sequencing+  , ctraverse__NP+  , ctraverse__POP+  , traverse__NP+  , traverse__POP+  , cfoldMap_NP+  , cfoldMap_POP   , sequence'_NP   , sequence'_POP   , sequence_NP   , sequence_POP+  , ctraverse'_NP+  , ctraverse'_POP+  , traverse'_NP+  , traverse'_POP+  , ctraverse_NP+  , ctraverse_POP     -- * Catamorphism and anamorphism   , cata_NP   , ccata_NP@@ -77,6 +89,7 @@  #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative+import Data.Monoid (Monoid (..)) #endif import Data.Coerce import Data.Proxy (Proxy(..))@@ -123,7 +136,15 @@  infixr 5 :* -deriving instance All (Show `Compose` f) xs => Show (NP f xs)+-- This is written manually,+-- because built-in deriving doesn't use associativity information!+instance All (Show `Compose` f) xs => Show (NP f xs) where+  showsPrec _ Nil       = showString "Nil"+  showsPrec d (f :* fs) = showParen (d > 5)+    $ showsPrec (5 + 1) f+    . showString " :* "+    . showsPrec 5 fs+ deriving instance All (Eq   `Compose` f) xs => Eq   (NP f xs) deriving instance (All (Eq `Compose` f) xs, All (Ord `Compose` f) xs) => Ord (NP f xs) @@ -476,7 +497,7 @@ -- /Example:/ -- -- >>> collapse_POP (POP ((K 'a' :* Nil) :* (K 'b' :* K 'c' :* Nil) :* Nil) :: POP (K Char) '[ '[(a :: *)], '[b, c] ])--- ["a", "bc"]+-- ["a","bc"] -- -- (The type signature is only necessary in this case to fix the kind of the type variables.) --@@ -493,22 +514,133 @@ instance HCollapse NP  where hcollapse = collapse_NP instance HCollapse POP where hcollapse = collapse_POP +-- * Folding++-- | Specialization of 'hctraverse_'.+--+-- @since 0.3.2.0+--+ctraverse__NP ::+     forall c proxy xs f g. (All c xs, Applicative g)+  => proxy c -> (forall a. c a => f a -> g ()) -> NP f xs -> g ()+ctraverse__NP _ f = go+  where+    go :: All c ys => NP f ys -> g ()+    go Nil       = pure ()+    go (x :* xs) = f x *> go xs++-- | Specialization of 'htraverse_'.+--+-- @since 0.3.2.0+--+traverse__NP ::+     forall xs f g. (SListI xs, Applicative g)+  => (forall a. f a -> g ()) -> NP f xs -> g ()+traverse__NP f = go+  where+    go :: NP f ys -> g ()+    go Nil       = pure ()+    go (x :* xs) = f x *> go xs++-- | Specialization of 'hctraverse_'.+--+-- @since 0.3.2.0+--+ctraverse__POP ::+     forall c proxy xss f g. (All2 c xss, Applicative g)+  => proxy c -> (forall a. c a => f a -> g ()) -> POP f xss -> g ()+ctraverse__POP p f = ctraverse__NP (allP p) (ctraverse__NP p f) . unPOP++-- | Specialization of 'htraverse_'.+--+-- @since 0.3.2.0+--+traverse__POP ::+     forall xss f g. (SListI2 xss, Applicative g)+  => (forall a. f a -> g ()) -> POP f xss -> g ()+traverse__POP f = ctraverse__NP sListP (traverse__NP f) . unPOP++instance HTraverse_ NP  where+  hctraverse_ = ctraverse__NP+  htraverse_  = traverse__NP++instance HTraverse_ POP where+  hctraverse_ = ctraverse__POP+  htraverse_  = traverse__POP++-- | Specialization of 'hcfoldMap'.+--+-- @since 0.3.2.0+--+cfoldMap_NP :: (All c xs, Monoid m) => proxy c -> (forall a. c a => f a -> m) -> NP f xs -> m+cfoldMap_NP  = hcfoldMap++-- | Specialization of 'hcfoldMap'.+--+-- @since 0.3.2.0+--+cfoldMap_POP :: (All2 c xs, Monoid m) => proxy c -> (forall a. c a => f a -> m) -> POP f xs -> m+cfoldMap_POP = hcfoldMap+ -- * Sequencing  -- | Specialization of 'hsequence''.-sequence'_NP  ::             Applicative f  => NP  (f :.: g) xs  -> f (NP  g xs)+sequence'_NP  ::              Applicative f  => NP  (f :.: g) xs  -> f (NP  g xs)+sequence'_NP Nil         = pure Nil+sequence'_NP (mx :* mxs) = (:*) <$> unComp mx <*> sequence'_NP mxs  -- | Specialization of 'hsequence''. sequence'_POP :: (SListI xss, Applicative f) => POP (f :.: g) xss -> f (POP g xss)+sequence'_POP = fmap POP . sequence'_NP . hliftA (Comp . sequence'_NP) . unPOP -sequence'_NP Nil         = pure Nil-sequence'_NP (mx :* mxs) = (:*) <$> unComp mx <*> sequence'_NP mxs+-- | Specialization of 'hctraverse''.+--+-- @since 0.3.2.0+--+ctraverse'_NP  ::+     forall c proxy xs f f' g. (All c xs,  Applicative g)+  => proxy c -> (forall a. c a => f a -> g (f' a)) -> NP f xs  -> g (NP f' xs)+ctraverse'_NP _ f = go where+  go :: All c ys => NP f ys -> g (NP f' ys)+  go Nil       = pure Nil+  go (x :* xs) = (:*) <$> f x <*> go xs -sequence'_POP = fmap POP . sequence'_NP . hliftA (Comp . sequence'_NP) . unPOP+-- | Specialization of 'htraverse''.+--+-- @since 0.3.2.0+--+traverse'_NP  ::+     forall xs f f' g. (SListI xs,  Applicative g)+  => (forall a. f a -> g (f' a)) -> NP f xs  -> g (NP f' xs)+traverse'_NP f = go where+  go :: NP f ys -> g (NP f' ys)+  go Nil       = pure Nil+  go (x :* xs) = (:*) <$> f x <*> go xs -instance HSequence NP  where hsequence' = sequence'_NP-instance HSequence POP where hsequence' = sequence'_POP+-- | Specialization of 'hctraverse''.+--+-- @since 0.3.2.0+--+ctraverse'_POP :: (All2 c xss, Applicative g) => proxy c -> (forall a. c a => f a -> g (f' a)) -> POP f xss -> g (POP f' xss)+ctraverse'_POP p f = fmap POP . ctraverse'_NP (allP p) (ctraverse'_NP p f) . unPOP +-- | Specialization of 'hctraverse''.+--+-- @since 0.3.2.0+--+traverse'_POP :: (SListI2 xss, Applicative g) => (forall a. f a -> g (f' a)) -> POP f xss -> g (POP f' xss)+traverse'_POP f = fmap POP . ctraverse'_NP sListP (traverse'_NP f) . unPOP++instance HSequence NP  where+  hsequence'  = sequence'_NP+  hctraverse' = ctraverse'_NP+  htraverse'  = traverse'_NP++instance HSequence POP where+  hsequence'  = sequence'_POP+  hctraverse' = ctraverse'_POP+  htraverse'  = traverse'_POP+ -- | Specialization of 'hsequence'. -- -- /Example:/@@ -523,12 +655,27 @@ -- /Example:/ -- -- >>> sequence_POP (POP ((Just 1 :* Nil) :* (Just 2 :* Just 3 :* Nil) :* Nil))--- Just (POP ((I 1 :* Nil) :* ((I 2 :* (I 3 :* Nil)) :* Nil)))+-- Just (POP ((I 1 :* Nil) :* (I 2 :* I 3 :* Nil) :* Nil)) -- sequence_POP :: (All SListI xss, Applicative f) => POP f xss -> f (POP I xss)  sequence_NP   = hsequence sequence_POP  = hsequence++-- | Specialization of 'hctraverse'.+--+-- @since 0.3.2.0+--+ctraverse_NP  :: (All  c xs, Applicative g) => proxy c -> (forall a. c a => f a -> g a) -> NP  f xs -> g (NP  I xs)++-- | Specialization of 'hctraverse'.+--+-- @since 0.3.2.0+--+ctraverse_POP :: (All2 c xs, Applicative g) => proxy c -> (forall a. c a => f a -> g a) -> POP f xs -> g (POP I xs)++ctraverse_NP  = hctraverse+ctraverse_POP = hctraverse  -- * Catamorphism and anamorphism 

@@ -41,14 +41,31 @@   , cmap_SOP     -- * Dealing with @'All' c@   , cliftA2'_NS+    -- * Comparison+  , compare_NS+  , ccompare_NS+  , compare_SOP+  , ccompare_SOP     -- * Collapsing   , collapse_NS   , collapse_SOP-    -- * Sequencing+    -- * Folding and sequencing+  , ctraverse__NS+  , ctraverse__SOP+  , traverse__NS+  , traverse__SOP+  , cfoldMap_NS+  , cfoldMap_SOP   , sequence'_NS   , sequence'_SOP   , sequence_NS   , sequence_SOP+  , ctraverse'_NS+  , ctraverse'_SOP+  , traverse'_NS+  , traverse'_SOP+  , ctraverse_NS+  , ctraverse_SOP     -- * Catamorphism and anamorphism   , cata_NS   , ccata_NS@@ -72,6 +89,7 @@  #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative+import Data.Monoid (Monoid) #endif import Data.Coerce import Data.Proxy@@ -208,6 +226,9 @@ unSOP :: SOP f xss -> NS (NP f) xss unSOP (SOP xss) = xss +type instance AllN NS  c = All  c+type instance AllN SOP c = All2 c+ -- | Obtain the index from an n-ary sum of products. -- -- An n-nary sum represents a choice between n different options.@@ -279,7 +300,7 @@ -- /Example:/ -- -- >>> apInjs_NP (I 'x' :* I True :* I 2 :* Nil)--- [Z (I 'x'), S (Z (I True)), S (S (Z (I 2)))]+-- [Z (I 'x'),S (Z (I True)),S (S (Z (I 2)))] -- apInjs_NP  :: SListI xs  => NP  f xs  -> [NS  f xs] apInjs_NP  = hcollapse . apInjs'_NP@@ -304,7 +325,7 @@ -- /Example:/ -- -- >>> apInjs_POP (POP ((I 'x' :* Nil) :* (I True :* I 2 :* Nil) :* Nil))--- [SOP (Z (I 'x' :* Nil)),SOP (S (Z (I True :* (I 2 :* Nil))))]+-- [SOP (Z (I 'x' :* Nil)),SOP (S (Z (I True :* I 2 :* Nil)))] -- apInjs_POP :: SListI xss => POP f xss -> [SOP f xss] apInjs_POP = map SOP . apInjs_NP . unPOP@@ -423,6 +444,95 @@  cliftA2'_NS = hcliftA2' +-- * Comparison++-- | Compare two sums with respect to the choice they+-- are making.+--+-- A value that chooses the first option+-- is considered smaller than one that chooses the second+-- option.+--+-- If the choices are different, then either the first+-- (if the first is smaller than the second)+-- or the third (if the first is larger than the second)+-- argument are called. If both choices are equal, then the+-- second argument is called, which has access to the+-- elements contained in the sums.+--+-- @since 0.3.2.0+--+compare_NS ::+     forall r f g xs .+     r                             -- ^ what to do if first is smaller+  -> (forall x . f x -> g x -> r)  -- ^ what to do if both are equal+  -> r                             -- ^ what to do if first is larger+  -> NS f xs -> NS g xs+  -> r+compare_NS lt eq gt = go+  where+    go :: forall ys . NS f ys -> NS g ys -> r+    go (Z x)  (Z y)  = eq x y+    go (Z _)  (S _)  = lt+    go (S _)  (Z _)  = gt+    go (S xs) (S ys) = go xs ys++-- | Constrained version of 'compare_NS'.+--+-- @since 0.3.2.0+--+ccompare_NS ::+     forall c proxy r f g xs .+     (All c xs)+  => proxy c+  -> r                                    -- ^ what to do if first is smaller+  -> (forall x . c x => f x -> g x -> r)  -- ^ what to do if both are equal+  -> r                                    -- ^ what to do if first is larger+  -> NS f xs -> NS g xs+  -> r+ccompare_NS _ lt eq gt = go+  where+    go :: forall ys . (All c ys) => NS f ys -> NS g ys -> r+    go (Z x)  (Z y)  = eq x y+    go (Z _)  (S _)  = lt+    go (S _)  (Z _)  = gt+    go (S xs) (S ys) = go xs ys++-- | Compare two sums of products with respect to the+-- choice in the sum they are making.+--+-- Only the sum structure is used for comparison.+-- This is a small wrapper around 'ccompare_NS' for+-- a common special case.+--+-- @since 0.3.2.0+--+compare_SOP ::+     forall r f g xss .+     r                                      -- ^ what to do if first is smaller+  -> (forall xs . NP f xs -> NP g xs -> r)  -- ^ what to do if both are equal+  -> r                                      -- ^ what to do if first is larger+  -> SOP f xss -> SOP g xss+  -> r+compare_SOP lt eq gt (SOP xs) (SOP ys) =+  compare_NS lt eq gt xs ys++-- | Constrained version of 'compare_SOP'.+--+-- @since 0.3.2.0+--+ccompare_SOP ::+     forall c proxy r f g xss .+     (All2 c xss)+  => proxy c+  -> r                                                  -- ^ what to do if first is smaller+  -> (forall xs . All c xs => NP f xs -> NP g xs -> r)  -- ^ what to do if both are equal+  -> r                                                  -- ^ what to do if first is larger+  -> SOP f xss -> SOP g xss+  -> r+ccompare_SOP p lt eq gt (SOP xs) (SOP ys) =+  ccompare_NS (allP p) lt eq gt xs ys+ -- * Collapsing  -- | Specialization of 'hcollapse'.@@ -441,22 +551,152 @@ instance HCollapse NS  where hcollapse = collapse_NS instance HCollapse SOP where hcollapse = collapse_SOP +-- * Folding++-- | Specialization of 'hctraverse_'.+--+-- /Note:/ we don't need 'Applicative' constraint.+--+-- @since 0.3.2.0+--+ctraverse__NS ::+     forall c proxy xs f g. (All c xs)+  => proxy c -> (forall a. c a => f a -> g ()) -> NS f xs -> g ()+ctraverse__NS _ f = go+  where+    go :: All c ys => NS f ys -> g ()+    go (Z x)  = f x+    go (S xs) = go xs++-- | Specialization of 'htraverse_'.+--+-- /Note:/ we don't need 'Applicative' constraint.+--+-- @since 0.3.2.0+--+traverse__NS ::+     forall xs f g. (SListI xs)+  => (forall a. f a -> g ()) -> NS f xs -> g ()+traverse__NS f = go+  where+    go :: NS f ys -> g ()+    go (Z x)  = f x+    go (S xs) = go xs++-- | Specialization of 'hctraverse_'.+--+-- @since 0.3.2.0+--+ctraverse__SOP ::+     forall c proxy xss f g. (All2 c xss, Applicative g)+  => proxy c -> (forall a. c a => f a -> g ()) -> SOP f xss -> g ()+ctraverse__SOP p f = ctraverse__NS (allP p) (ctraverse__NP p f) . unSOP++-- | Specialization of 'htraverse_'.+--+-- @since 0.3.2.0+--+traverse__SOP ::+     forall xss f g. (SListI2 xss, Applicative g)+  => (forall a. f a -> g ()) -> SOP f xss -> g ()+traverse__SOP f = ctraverse__NS sListP (traverse__NP f) . unSOP++sListP :: Proxy SListI+sListP = Proxy++instance HTraverse_ NS  where+  hctraverse_ = ctraverse__NS+  htraverse_  = traverse__NS++instance HTraverse_ SOP where+  hctraverse_ = ctraverse__SOP+  htraverse_  = traverse__SOP++-- | Specialization of 'hcfoldMap'.+--+-- /Note:/ We don't need 'Monoid' instance.+--+-- @since 0.3.2.0+--+cfoldMap_NS ::+     forall c proxy f xs m. (All c xs)+  => proxy c -> (forall a. c a => f a -> m) -> NS f xs -> m+cfoldMap_NS _ f = go+  where+    go :: All c ys => NS f ys -> m+    go (Z x)  = f x+    go (S xs) = go xs++-- | Specialization of 'hcfoldMap'.+--+-- @since 0.3.2.0+--+cfoldMap_SOP :: (All2 c xs, Monoid m) => proxy c -> (forall a. c a => f a -> m) -> SOP f xs -> m+cfoldMap_SOP = hcfoldMap+ -- * Sequencing  -- | Specialization of 'hsequence''. sequence'_NS  ::              Applicative f  => NS  (f :.: g) xs  -> f (NS  g xs)+sequence'_NS (Z mx)  = Z <$> unComp mx+sequence'_NS (S mxs) = S <$> sequence'_NS mxs  -- | Specialization of 'hsequence''. sequence'_SOP :: (SListI xss, Applicative f) => SOP (f :.: g) xss -> f (SOP g xss)+sequence'_SOP = fmap SOP . sequence'_NS . hliftA (Comp . sequence'_NP) . unSOP -sequence'_NS (Z mx)  = Z <$> unComp mx-sequence'_NS (S mxs) = S <$> sequence'_NS mxs+-- | Specialization of 'hctraverse''.+--+-- /Note:/ as 'NS' has exactly one element, the 'Functor' constraint is enough.+--+-- @since 0.3.2.0+--+ctraverse'_NS  ::+     forall c proxy xs f f' g. (All c xs,  Functor g)+  => proxy c -> (forall a. c a => f a -> g (f' a)) -> NS f xs  -> g (NS f' xs)+ctraverse'_NS _ f = go where+  go :: All c ys => NS f ys -> g (NS f' ys)+  go (Z x)  = Z <$> f x+  go (S xs) = S <$> go xs -sequence'_SOP = fmap SOP . sequence'_NS . hliftA (Comp . sequence'_NP) . unSOP+-- | Specialization of 'htraverse''.+--+-- /Note:/ as 'NS' has exactly one element, the 'Functor' constraint is enough.+--+-- @since 0.3.2.0+--+traverse'_NS  ::+     forall xs f f' g. (SListI xs,  Functor g)+  => (forall a. f a -> g (f' a)) -> NS f xs  -> g (NS f' xs)+traverse'_NS f = go where+  go :: NS f ys -> g (NS f' ys)+  go (Z x)  = Z <$> f x+  go (S xs) = S <$> go xs -instance HSequence NS  where hsequence' = sequence'_NS-instance HSequence SOP where hsequence' = sequence'_SOP+-- | Specialization of 'hctraverse''.+--+-- @since 0.3.2.0+--+ctraverse'_SOP :: (All2 c xss, Applicative g) => proxy c -> (forall a. c a => f a -> g (f' a)) -> SOP f xss -> g (SOP f' xss)+ctraverse'_SOP p f = fmap SOP . ctraverse'_NS (allP p) (ctraverse'_NP p f) . unSOP +-- | Specialization of 'htraverse''.+--+-- @since 0.3.2.0+--+traverse'_SOP :: (SListI2 xss, Applicative g) => (forall a. f a -> g (f' a)) -> SOP f xss -> g (SOP f' xss)+traverse'_SOP f = fmap SOP . ctraverse'_NS sListP (traverse'_NP f) . unSOP++instance HSequence NS  where+  hsequence'  = sequence'_NS+  hctraverse' = ctraverse'_NS+  htraverse'  = traverse'_NS++instance HSequence SOP where+  hsequence'  = sequence'_SOP+  hctraverse' = ctraverse'_SOP+  htraverse'  = traverse'_SOP+ -- | Specialization of 'hsequence'. sequence_NS  :: (SListI xs,  Applicative f) => NS  f xs  -> f (NS  I xs) @@ -465,6 +705,21 @@  sequence_NS   = hsequence sequence_SOP  = hsequence++-- | Specialization of 'hctraverse'.+--+-- @since 0.3.2.0+--+ctraverse_NS  :: (All  c xs, Applicative g) => proxy c -> (forall a. c a => f a -> g a) -> NP  f xs -> g (NP  I xs)++-- | Specialization of 'hctraverse'.+--+-- @since 0.3.2.0+--+ctraverse_SOP :: (All2 c xs, Applicative g) => proxy c -> (forall a. c a => f a -> g a) -> POP f xs -> g (POP I xs)++ctraverse_NS = hctraverse+ctraverse_SOP = hctraverse  -- * Catamorphism and anamorphism 

@@ -101,18 +101,19 @@ -- deriveGenericFunctions :: Name -> String -> String -> String -> Q [Dec] deriveGenericFunctions n codeName fromName toName = do-  let codeName'  = mkName codeName+  let codeName' = mkName codeName   let fromName' = mkName fromName   let toName'   = mkName toName   dec <- reifyDec n-  withDataDec dec $ \_isNewtype _cxt name _bndrs cons _derivs -> do+  withDataDec dec $ \_isNewtype _cxt name bndrs cons _derivs -> do     let codeType = codeFor cons                        -- '[ '[Int], '[Tree, Tree] ]-    let repType = [t| SOP I $(conT codeName') |]       -- SOP I TreeCode+    let origType = appTyVars name bndrs                -- Tree+    let repType  = [t| SOP I $(appTyVars codeName' bndrs) |] -- SOP I TreeCode     sequence-      [ tySynD codeName' [] codeType                    -- type TreeCode = '[ '[Int], '[Tree, Tree] ]-      , sigD fromName' [t| $(conT name) -> $repType |]  -- fromTree :: Tree -> SOP I TreeCode+      [ tySynD codeName' bndrs codeType                 -- type TreeCode = '[ '[Int], '[Tree, Tree] ]+      , sigD fromName' [t| $origType -> $repType |]     -- fromTree :: Tree -> SOP I TreeCode       , embedding fromName' cons                        -- fromTree ... =-      , sigD toName' [t| $repType -> $(conT name) |]    -- toTree :: SOP I TreeCode -> Tree+      , sigD toName' [t| $repType -> $origType |]       -- toTree :: SOP I TreeCode -> Tree       , projection toName' cons                         -- toTree ... =       ] @@ -128,7 +129,7 @@ -- > treeDatatypeInfo = ADT "Main" "Tree" -- >     (Constructor "Leaf" :* Constructor "Node" :* Nil) ----- /Note:/ CodeType need to be derived with 'deriveGenericFunctions'.+-- /Note:/ CodeType needs to be derived with 'deriveGenericFunctions'. -- -- @since 0.2 --@@ -138,7 +139,7 @@   let datatypeInfoName' = mkName datatypeInfoName   dec <- reifyDec n   withDataDec dec $ \isNewtype _cxt name _bndrs cons _derivs -> do-    sequence [ sigD datatypeInfoName' [t| SOP.DatatypeInfo $(conT codeName') |]                    -- treeDatatypeInfo :: DatatypeInfo TreeCode+    sequence [ sigD datatypeInfoName' [t| SOP.DatatypeInfo $(conT codeName') |]                -- treeDatatypeInfo :: DatatypeInfo TreeCode              , funD datatypeInfoName' [clause [] (normalB $ metadata' isNewtype name cons) []] -- treeDatatypeInfo = ...              ] {-# DEPRECATED deriveMetadataValue "Use 'deriveMetadataType' and 'demoteDatatypeInfo' instead." #-}@@ -211,8 +212,14 @@ -------------------------------------------------------------------------------}  embedding :: Name -> [Con] -> Q Dec-embedding fromName = funD fromName . go (\e -> [| Z $e |])+embedding fromName = funD fromName . go' (\e -> [| Z $e |])   where+    go' :: (Q Exp -> Q Exp) -> [Con] -> [Q Clause]+    go' _ [] = (:[]) $ do+      x <- newName "x"+      clause [varP x] (normalB (caseE (varE x) [])) []+    go' br cs = go br cs+     go :: (Q Exp -> Q Exp) -> [Con] -> [Q Clause]     go _  []     = []     go br (c:cs) = mkClause br c : go (\e -> [| S $(br e) |]) cs@@ -226,8 +233,14 @@              []  projection :: Name -> [Con] -> Q Dec-projection toName = funD toName . go (\p -> conP 'Z [p])+projection toName = funD toName . go' (\p -> conP 'Z [p])   where+    go' :: (Q Pat -> Q Pat) -> [Con] -> [Q Clause]+    go' _ [] = (:[]) $ do+      x <- newName "x"+      clause [varP x] (normalB (caseE (varE x) [])) []+    go' br cs = go br cs+     go :: (Q Pat -> Q Pat) -> [Con] -> [Q Clause]     go _ [] = [unreachable]     go br (c:cs) = mkClause br c : go (\p -> conP 'S [br p]) cs