generics-sop 0.2.4.0 → 0.2.5.0

raw patch · 8 files changed

+424/−8 lines, 8 filesdep +deepseqdep ~basedep ~template-haskelldep ~transformers-compatPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: deepseq

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

API changes (from Hackage documentation)

Files

• CHANGELOG.md +23/−0
• generics-sop.cabal +3/−2
• src/Generics/SOP.hs +15/−0
• src/Generics/SOP/BasicFunctors.hs +201/−1
• src/Generics/SOP/Classes.hs +58/−0
• src/Generics/SOP/NP.hs +11/−0
• src/Generics/SOP/NS.hs +107/−2
• src/Generics/SOP/Universe.hs +6/−3

@@ -1,3 +1,26 @@+# 0.2.5.0 (2017-04-21)++* GHC 8.2 compatibility.++* Make `:.:` an instance of `Applicative`, `Foldable` and+  `Traversable`.++* Add functions `apInjs'_NP` and `apInjs'_POP`. These are+  variants of `apInjs_NP` and `apInjs'_POP` that return their+  result as an n-ary product, rather than collapsing it into+  a list.++* Add `hexpand` (and `expand_NS` and `expand_SOP`). These+  functions expand sums into products, given a default value+  to fill the other slots.++* Add utility functions such as `mapII` or `mapIK` that lift+  functions into different combinations of identity and+  constant functors.++* Add `NFData` (and lifted variants) instances for basic functors,+  products and sums.+ # 0.2.4.0 (2017-02-02)  * Add `hindex` (and `index_NS` and `index_SOP`).

@@ -1,5 +1,5 @@ name:                generics-sop-version:             0.2.4.0+version:             0.2.5.0 synopsis:            Generic Programming using True Sums of Products description:   A library to support the definition of generic functions.@@ -60,7 +60,8 @@                        Generics.SOP.Sing   build-depends:       base                 >= 4.6  && < 5,                        template-haskell     >= 2.8  && < 2.13,-                       ghc-prim             >= 0.3  && < 0.6+                       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)

@@ -294,6 +294,8 @@   , HSequence(..)   , hsequence   , hsequenceK+    -- ** Expanding sums to products+  , HExpand(..)     -- ** Partial operations   , fromList     -- * Utilities@@ -304,6 +306,19 @@   , unI   , (:.:)(..)   , unComp+    -- *** Mapping functions+  , mapII+  , mapIK+  , mapKI+  , mapKK+  , mapIII+  , mapIIK+  , mapIKI+  , mapIKK+  , mapKII+  , mapKIK+  , mapKKI+  , mapKKK     -- ** Mapping constraints   , All   , All2

@@ -21,12 +21,26 @@ -- properly. See <https://ghc.haskell.org/trac/ghc/ticket/8779>. -- module Generics.SOP.BasicFunctors-  ( K(..)+  ( -- * Basic functors+    K(..)   , unK   , I(..)   , unI   , (:.:)(..)   , unComp+    -- * Mapping functions+  , mapII+  , mapIK+  , mapKI+  , mapKK+  , mapIII+  , mapIIK+  , mapIKI+  , mapIKK+  , mapKII+  , mapKIK+  , mapKKI+  , mapKKK   ) where  #if MIN_VERSION_base(4,8,0)@@ -53,6 +67,13 @@ #endif #endif +import Control.DeepSeq (NFData(..))+#if MIN_VERSION_deepseq(1,4,3)+import Control.DeepSeq (NFData1(..), NFData2(..))+#endif++-- * Basic functors+ -- | The constant type functor. -- -- Like 'Data.Functor.Constant.Constant', but kind-polymorphic@@ -76,31 +97,43 @@ #endif  #ifdef LIFTED_CLASSES+-- | @since 0.2.4.0 instance Eq2 K where     liftEq2 eq _ (K x) (K y) = eq x y+-- | @since 0.2.4.0 instance Ord2 K where     liftCompare2 comp _ (K x) (K y) = comp x y+-- | @since 0.2.4.0 instance Read2 K where     liftReadsPrec2 rp _ _ _ = readsData $          readsUnaryWith rp "K" K+-- | @since 0.2.4.0 instance Show2 K where     liftShowsPrec2 sp _ _ _ d (K x) = showsUnaryWith sp "K" d x +-- | @since 0.2.4.0 instance (Eq a) => Eq1 (K a) where     liftEq = liftEq2 (==)+-- | @since 0.2.4.0 instance (Ord a) => Ord1 (K a) where     liftCompare = liftCompare2 compare+-- | @since 0.2.4.0 instance (Read a) => Read1 (K a) where     liftReadsPrec = liftReadsPrec2 readsPrec readList+-- | @since 0.2.4.0 instance (Show a) => Show1 (K a) where     liftShowsPrec = liftShowsPrec2 showsPrec showList #else+-- | @since 0.2.4.0 instance (Eq a) => Eq1 (K a) where     eq1 (K x) (K y) = x == y+-- | @since 0.2.4.0 instance (Ord a) => Ord1 (K a) where     compare1 (K x) (K y) = compare x y+-- | @since 0.2.4.0 instance (Read a) => Read1 (K a) where     readsPrec1 = readsData $ readsUnary "K" K+-- | @since 0.2.4.0 instance (Show a) => Show1 (K a) where     showsPrec1 d (K x) = showsUnary "K" d x #endif@@ -161,22 +194,30 @@   #ifdef LIFTED_CLASSES+-- | @since 0.2.4.0 instance Eq1 I where     liftEq eq (I x) (I y) = eq x y+-- | @since 0.2.4.0 instance Ord1 I where     liftCompare comp (I x) (I y) = comp x y+-- | @since 0.2.4.0 instance Read1 I where     liftReadsPrec rp _ = readsData $          readsUnaryWith rp "I" I+-- | @since 0.2.4.0 instance Show1 I where     liftShowsPrec sp _ d (I x) = showsUnaryWith sp "I" d x #else+-- | @since 0.2.4.0 instance Eq1 I where     eq1 (I x) (I y) = x == y+-- | @since 0.2.4.0 instance Ord1 I where     compare1 (I x) (I y) = compare x y+-- | @since 0.2.4.0 instance Read1 I where     readsPrec1 = readsData $ readsUnary "I" I+-- | @since 0.2.4.0 instance Show1 I where     showsPrec1 d (I x) = showsUnary "I" d x #endif@@ -203,16 +244,33 @@ instance (Functor f, Functor g) => Functor (f :.: g) where   fmap f (Comp x) = Comp (fmap (fmap f) x) +-- | @since 0.2.5.0+instance (Applicative f, Applicative g) => Applicative (f :.: g) where+  pure x = Comp (pure (pure x))+  Comp f <*> Comp x = Comp ((<*>) <$> f <*> x)++-- | @since 0.2.5.0+instance (Foldable f, Foldable g) => Foldable (f :.: g) where+  foldMap f (Comp t) = foldMap (foldMap f) t++-- | @since 0.2.5.0+instance (Traversable f, Traversable g) => Traversable (f :.: g) where+  traverse f (Comp t) = Comp <$> traverse (traverse f) t++ -- Instances of lifted Prelude classes  #ifdef LIFTED_CLASSES+-- | @since 0.2.4.0 instance (Eq1 f, Eq1 g) => Eq1 (f :.: g) where     liftEq eq (Comp x) (Comp y) = liftEq (liftEq eq) x y +-- | @since 0.2.4.0 instance (Ord1 f, Ord1 g) => Ord1 (f :.: g) where     liftCompare comp (Comp x) (Comp y) =         liftCompare (liftCompare comp) x y +-- | @since 0.2.4.0 instance (Read1 f, Read1 g) => Read1 (f :.: g) where     liftReadsPrec rp rl = readsData $         readsUnaryWith (liftReadsPrec rp' rl') "Comp" Comp@@ -220,6 +278,7 @@         rp' = liftReadsPrec rp rl         rl' = liftReadList rp rl +-- | @since 0.2.4.0 instance (Show1 f, Show1 g) => Show1 (f :.: g) where     liftShowsPrec sp sl d (Comp x) =         showsUnaryWith (liftShowsPrec sp' sl') "Comp" d x@@ -262,15 +321,156 @@ instance (Functor f, Show1 f, Show1 g, Show a) => Show ((f :.: g) a) where     showsPrec d (Comp x) = showsUnary1 "Comp" d (fmap Apply x) +-- | @since 0.2.4.0 instance (Functor f, Eq1 f, Eq1 g) => Eq1 (f :.: g) where eq1 = (==)+-- | @since 0.2.4.0 instance (Functor f, Ord1 f, Ord1 g) => Ord1 (f :.: g) where     compare1 = compare+-- | @since 0.2.4.0 instance (Functor f, Read1 f, Read1 g) => Read1 (f :.: g) where     readsPrec1 = readsPrec+-- | @since 0.2.4.0 instance (Functor f, Show1 f, Show1 g) => Show1 (f :.: g) where     showsPrec1 = showsPrec #endif +-- NFData Instances++-- | @since 0.2.5.0+instance NFData a => NFData (I a) where+    rnf (I x) = rnf x++-- | @since 0.2.5.0+instance NFData a => NFData (K a b) where+    rnf (K x) = rnf x++-- | @since 0.2.5.0+instance NFData (f (g a)) => NFData ((f :.: g)  a) where+    rnf (Comp x) = rnf x++#if MIN_VERSION_deepseq(1,4,3)+-- | @since 0.2.5.0+instance NFData1 I where+    liftRnf r (I x) = r x++-- | @since 0.2.5.0+instance NFData a => NFData1 (K a) where+    liftRnf _ (K x) = rnf x++-- | @since 0.2.5.0+instance NFData2 K where+    liftRnf2 r _ (K x) = r x++-- | @since 0.2.5.0+instance (NFData1 f, NFData1 g) => NFData1 (f :.: g) where+    liftRnf r (Comp x) = liftRnf (liftRnf r) x+#endif+ -- | Extract the contents of a 'Comp' value. unComp :: (f :.: g) p -> f (g p) unComp (Comp x) = x++-- * Mapping functions++-- Implementation note:+--+-- All of these functions are just type specializations of+-- 'coerce'. However, we currently still support GHC 7.6+-- which does not support 'coerce', so we write them+-- explicitly.++-- | Lift the given function.+--+-- @since 0.2.5.0+--+mapII :: (a -> b) -> I a -> I b+mapII = \ f (I a) -> I (f a)+{-# INLINE mapII #-}++-- | Lift the given function.+--+-- @since 0.2.5.0+--+mapIK :: (a -> b) -> I a -> K b c+mapIK = \ f (I a) -> K (f a)+{-# INLINE mapIK #-}++-- | Lift the given function.+--+-- @since 0.2.5.0+--+mapKI :: (a -> b) -> K a c -> I b+mapKI = \ f (K a) -> I (f a)+{-# INLINE mapKI #-}++-- | Lift the given function.+--+-- @since 0.2.5.0+--+mapKK :: (a -> b) -> K a c -> K b d+mapKK = \ f (K a) -> K (f a)+{-# INLINE mapKK #-}++-- | Lift the given function.+--+-- @since 0.2.5.0+--+mapIII :: (a -> b -> c) -> I a -> I b -> I c+mapIII = \ f (I a) (I b) -> I (f a b)+{-# INLINE mapIII #-}++-- | Lift the given function.+--+-- @since 0.2.5.0+--+mapIIK :: (a -> b -> c) -> I a -> I b -> K c d+mapIIK = \ f (I a) (I b) -> K (f a b)+{-# INLINE mapIIK #-}++-- | Lift the given function.+--+-- @since 0.2.5.0+--+mapIKI :: (a -> b -> c) -> I a -> K b d -> I c+mapIKI = \ f (I a) (K b) -> I (f a b)+{-# INLINE mapIKI #-}++-- | Lift the given function.+--+-- @since 0.2.5.0+--+mapIKK :: (a -> b -> c) -> I a -> K b d -> K c e+mapIKK = \ f (I a) (K b) -> K (f a b)+{-# INLINE mapIKK #-}++-- | Lift the given function.+--+-- @since 0.2.5.0+--+mapKII :: (a -> b -> c) -> K a d -> I b -> I c+mapKII = \ f (K a) (I b) -> I (f a b)+{-# INLINE mapKII #-}++-- | Lift the given function.+--+-- @since 0.2.5.0+--+mapKIK :: (a -> b -> c) -> K a d -> I b -> K c e+mapKIK = \ f (K a) (I b) -> K (f a b)+{-# INLINE mapKIK #-}++-- | Lift the given function.+--+-- @since 0.2.5.0+--+mapKKI :: (a -> b -> c) -> K a d -> K b e -> I c+mapKKI = \ f (K a) (K b) -> I (f a b)+{-# INLINE mapKKI #-}++-- | Lift the given function.+--+-- @since 0.2.5.0+--+mapKKK :: (a -> b -> c) -> K a d -> K b e -> K c f+mapKKK = \ f (K a) (K b) -> K (f a b)+{-# INLINE mapKKK #-}

@@ -67,6 +67,8 @@     -- * Applying all injections   , UnProd   , HApInjs(..)+    -- * Expanding sums to products+  , HExpand(..)   ) where  #if !(MIN_VERSION_base(4,8,0))@@ -463,3 +465,59 @@   -- @since 0.2.4.0   --   hapInjs :: (SListIN h xs) => Prod h f xs -> [h f xs]++-- * Expanding sums to products++-- | A class for expanding sum structures into corresponding product+-- structures, filling in the slots not targeted by the sum with+-- default values.+--+-- @since 0.2.5.0+--+class HExpand (h :: (k -> *) -> (l -> *)) where++  -- | Expand a given sum structure into a corresponding product+  -- structure by placing the value contained in the sum into the+  -- corresponding position in the product, and using the given+  -- default value for all other positions.+  --+  -- /Instances:/+  --+  -- @+  -- 'hexpand', 'Generics.SOP.NS.expand_NS'  :: 'Generics.SOP.Sing.SListI' xs  => (forall x . f x) -> 'Generics.SOP.NS.NS'  f xs  -> 'Generics.SOP.NS.NP'  f xs+  -- 'hexpand', 'Generics.SOP.NS.expand_SOP' :: 'SListI2' xss => (forall x . f x) -> 'Generics.SOP.NS.SOP' f xss -> 'Generics.SOP.NP.POP' f xss+  -- @+  --+  -- /Examples:/+  --+  -- >>> hexpand Nothing (S (Z (Just 3))) :: NP Maybe '[Char, Int, Bool]+  -- Nothing :* Just 3 :* Nothing :* Nil+  -- >>> hexpand [] (SOP (S (Z ([1,2] :* "xyz" :* Nil)))) :: POP [] '[ '[Bool], '[Int, Char] ]+  -- POP (([] :* Nil) :* ([1,2] :* "xyz" :* Nil) :* Nil)+  --+  -- @since 0.2.5.0+  --+  hexpand :: (SListIN (Prod h) xs) => (forall x . f x) -> h f xs -> Prod h f xs++  -- | Variant of 'hexpand' that allows passing a constrained default.+  --+  -- /Instances:/+  --+  -- @+  -- 'hcexpand', 'Generics.SOP.NS.cexpand_NS'  :: 'All'  c xs  => proxy c -> (forall x . c x => f x) -> 'Generics.SOP.NS.NS'  f xs  -> 'Generics.SOP.NP.NP'  f xs+  -- 'hcexpand', 'Generics.SOP.NS.cexpand_SOP' :: 'All2' c xss => proxy c -> (forall x . c x => f x) -> 'Generics.SOP.NS.SOP' f xss -> 'Generics.SOP.NP.POP' f xss+  -- @+  --+  -- /Examples:/+  --+  -- >>> hcexpand (Proxy :: Proxy Bounded) (I minBound) (S (Z (I 20))) :: NP I '[Bool, Int, Ordering]+  -- I False :* I 20 :* I LT :* Nil+  -- >>> hcexpand (Proxy :: Proxy Num) (I 0) (SOP (S (Z (I 1 :* I 2 :* Nil)))) :: POP I '[ '[Double], '[Int, Int] ]+  -- POP ((I 0.0 :* Nil) :* (I 1 :* I 2 :* Nil) :* Nil)+  --+  -- @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++-- $setup+-- >>> import Generics.SOP

@@ -71,6 +71,8 @@ #endif import Data.Proxy (Proxy(..)) +import Control.DeepSeq (NFData(..))+ import Generics.SOP.BasicFunctors import Generics.SOP.Classes import Generics.SOP.Constraint@@ -114,6 +116,11 @@ 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) +-- | @since 0.2.5.0+instance All (NFData `Compose` f) xs => NFData (NP f xs) where+    rnf Nil       = ()+    rnf (x :* xs) = rnf x `seq` rnf xs+ -- | A product of products. -- -- This is a 'newtype' for an 'NP' of an 'NP'. The elements of the@@ -133,6 +140,10 @@ deriving instance (Show (NP (NP f) xss)) => Show (POP f xss) deriving instance (Eq   (NP (NP f) xss)) => Eq   (POP f xss) deriving instance (Ord  (NP (NP f) xss)) => Ord  (POP f xss)++-- | @since 0.2.5.0+instance (NFData (NP (NP f) xss)) => NFData (POP f xss) where+    rnf (POP xss) = rnf xss  -- | Unwrap a product of products. unPOP :: POP f xss -> NP (NP f) xss

@@ -16,7 +16,9 @@   , shift   , shiftInjection   , apInjs_NP+  , apInjs'_NP   , apInjs_POP+  , apInjs'_POP     -- * Destructing sums   , unZ   , index_NS@@ -52,12 +54,20 @@   , ccata_NS   , ana_NS   , cana_NS+    -- * Expanding sums to products+  , expand_NS+  , cexpand_NS+  , expand_SOP+  , cexpand_SOP   ) where  #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative #endif+import Data.Proxy +import Control.DeepSeq (NFData(..))+ import Generics.SOP.BasicFunctors import Generics.SOP.Classes import Generics.SOP.Constraint@@ -114,6 +124,11 @@ deriving instance All (Eq   `Compose` f) xs => Eq   (NS f xs) deriving instance (All (Eq `Compose` f) xs, All (Ord `Compose` f) xs) => Ord (NS f xs) +-- | @since 0.2.5.0+instance All (NFData `Compose` f) xs => NFData (NS f xs) where+    rnf (Z x)  = rnf x+    rnf (S xs) = rnf xs+ -- | Extract the payload from a unary sum. -- -- For larger sums, this function would be partial, so it is only@@ -172,8 +187,12 @@  deriving instance (Show (NS (NP f) xss)) => Show (SOP f xss) deriving instance (Eq   (NS (NP f) xss)) => Eq   (SOP f xss)-deriving instance (Ord  (NS (NP f) xss)) => Ord  (SOP f xss) +deriving instance (Ord  (NS (NP f) xss)) => Ord  (SOP f xss) +-- | @since 0.2.5.0+instance (NFData (NS (NP f) xss)) => NFData (SOP f xss) where+    rnf (SOP xss) = rnf xss+ -- | Unwrap a sum of products. unSOP :: SOP f xss -> NS (NP f) xss unSOP (SOP xss) = xss@@ -252,8 +271,18 @@ -- [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 . hap injections+apInjs_NP  = hcollapse . apInjs'_NP +-- | `apInjs_NP` without `hcollapse`.+--+-- >>> apInjs'_NP (I 'x' :* I True :* I 2 :* Nil)+-- K (Z (I 'x')) :* K (S (Z (I True))) :* K (S (S (Z (I 2)))) :* Nil+--+-- @since 0.2.5.0+--+apInjs'_NP :: SListI xs => NP f xs -> NP (K (NS f xs)) xs+apInjs'_NP = hap injections+ -- | Apply injections to a product of product. -- -- This operates on the outer product only. Given a product@@ -269,6 +298,18 @@ apInjs_POP :: SListI xss => POP f xss -> [SOP f xss] apInjs_POP = map SOP . apInjs_NP . unPOP +-- | `apInjs_POP` without `hcollapse`.+--+-- /Example:/+--+-- >>> apInjs'_POP (POP ((I 'x' :* Nil) :* (I True :* I 2 :* Nil) :* Nil))+-- K (SOP (Z (I 'x' :* Nil))) :* K (SOP (S (Z (I True :* I 2 :* Nil)))) :* Nil+--+-- @since 0.2.5.0+--+apInjs'_POP :: SListI xss => POP f xss -> NP (K (SOP f xss)) xss+apInjs'_POP = hmap (K . SOP . unK) . hap injections . unPOP+ type instance UnProd NP  = NS type instance UnProd POP = SOP @@ -486,3 +527,67 @@     go SCons s = case decide s of       Left x   -> Z x       Right s' -> S (go sList s')++-- * Expanding sums to products++-- | Specialization of 'hexpand'.+--+-- @since 0.2.5.0+--+expand_NS :: forall f xs .+     (SListI xs)+  => (forall x . f x)+  -> NS f xs -> NP f xs+expand_NS d = go sList+  where+    go :: forall ys . SList ys -> NS f ys -> NP f ys+    go SCons (Z x) = x :* hpure d+    go SCons (S i) = d :* go sList i+    go SNil  _     = error "inaccessible" -- still required in ghc-8.0.*++-- | Specialization of 'hcexpand'.+--+-- @since 0.2.5.0+--+cexpand_NS :: forall c proxy f xs .+     (All c xs)+  => proxy c -> (forall x . c x => f x)+  -> NS f xs -> NP f xs+cexpand_NS p d = go+  where+    go :: forall ys . All c ys => NS f ys -> NP f ys+    go (Z x) = x :* hcpure p d+    go (S i) = d :* go i++-- | Specialization of 'hexpand'.+--+-- @since 0.2.5.0+--+expand_SOP :: forall f xss .+     (All SListI xss)+  => (forall x . f x)+  -> SOP f xss -> POP f xss+expand_SOP d =+  POP . cexpand_NS (Proxy :: Proxy SListI) (hpure d) . unSOP++-- | Specialization of 'hcexpand'.+--+-- @since 0.2.5.0+--+cexpand_SOP :: forall c proxy f xss .+     (All2 c xss)+  => proxy c -> (forall x . c x => f x)+  -> SOP f xss -> POP f xss+cexpand_SOP p d =+  POP . cexpand_NS (allP p) (hcpure p d) . unSOP++allP :: proxy c -> Proxy (All c)+allP _ = Proxy++instance HExpand NS where+  hexpand  = expand_NS+  hcexpand = cexpand_NS++instance HExpand SOP where+  hexpand  = expand_SOP+  hcexpand = cexpand_SOP

@@ -115,13 +115,15 @@    -- | Converts from a value to its structural representation.   from         :: a -> Rep a-  default from :: (GFrom a, GHC.Generic a) => a -> SOP I (GCode a)+  default from :: (GFrom a, GHC.Generic a, Rep a ~ SOP I (GCode a))+               => a -> Rep a   from = gfrom    -- | Converts from a structural representation back to the   -- original value.   to         :: Rep a -> a-  default to :: (GTo a, GHC.Generic a) => SOP I (GCode a) -> a+  default to :: (GTo a, GHC.Generic a, Rep a ~ SOP I (GCode a))+             => Rep a -> a   to = gto  -- | A class of datatypes that have associated metadata.@@ -136,5 +138,6 @@ -- class HasDatatypeInfo a where   datatypeInfo         :: proxy a -> DatatypeInfo (Code a)-  default datatypeInfo :: GDatatypeInfo a => proxy a -> DatatypeInfo (GCode a)+  default datatypeInfo :: (GDatatypeInfo a, Code a ~ GCode a)+                       => proxy a -> DatatypeInfo (Code a)   datatypeInfo = gdatatypeInfo