barbies 2.0.5.0 → 2.1.0.0

raw patch · 24 files changed

+95/−2001 lines, 24 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog.md +12/−0
• barbies.cabal +1/−55
• src/Barbies/Bi.hs +12/−0
• src/Barbies/Internal/ConstraintsB.hs +14/−0
• src/Barbies/Internal/ConstraintsT.hs +11/−0
• src/Barbies/Internal/TraversableB.hs +21/−0
• src/Barbies/Internal/TraversableT.hs +21/−0
• src/Data/Barbie.hs +0/−105
• src/Data/Barbie/Bare.hs +0/−14
• src/Data/Barbie/Constraints.hs +0/−22
• src/Data/Barbie/Internal/Product.hs +0/−166
• src/Data/Barbie/Internal/ProductC.hs +0/−133
• src/Data/Functor/Prod.hs +0/−246
• src/Data/Functor/Transformer.hs +3/−0
• test-legacy/Legacy/Clothes.hs +0/−189
• test-legacy/Legacy/Spec.hs +0/−204
• test-legacy/Legacy/Spec/Bare.hs +0/−30
• test-legacy/Legacy/Spec/Constraints.hs +0/−49
• test-legacy/Legacy/Spec/Functor.hs +0/−32
• test-legacy/Legacy/Spec/Product.hs +0/−45
• test-legacy/Legacy/Spec/Traversable.hs +0/−44
• test-legacy/Legacy/Spec/Wrapper.hs +0/−37
• test-legacy/Legacy/TestBarbies.hs +0/−306
• test-legacy/Legacy/TestBarbiesW.hs +0/−324

@@ -1,5 +1,17 @@ # Changelog for barbies +## 2.1.0.0+  - Remove the deprecated interface from 1.x version+  - Add flipped-argument versions of `traverse` functions )Jack Kelly).+    By analogy to `Data.Traversable.for` in `base` these are similarly-named:+    - `Data.Barbie.bfor`+    - `Data.Barbie.bfor_`+    - `Data.Barbie.bforC`+    - `Data.Functor.Transformer.tfor`+    - `Data.Functor.Transformer.tforC`+    - `Data.Functor.Transformer.tfor_`+    - `Barbies.Bi.btfor1`+ ## 2.0.5.0   - Add helper class Barbies.Constraints.(&) (#46) 

@@ -1,5 +1,5 @@ name:           barbies-version:        2.0.5.0+version:        2.1.0.0 synopsis:       Classes for working with types that can change clothes. description:    Types that are parametric on a functor are like Barbies that have an outfit for each role. This package provides the basic abstractions to work with them comfortably. category:       Data Structures@@ -33,12 +33,6 @@       Data.Functor.Barbie       Data.Functor.Transformer -      -- Deprecated modules-      Data.Barbie-      Data.Barbie.Bare-      Data.Barbie.Constraints-      Data.Functor.Prod-   other-modules:       Barbies.Generics.Applicative       Barbies.Generics.Bare@@ -74,10 +68,6 @@        Data.Generics.GenericN -      -- To be removed-      Data.Barbie.Internal.Product-      Data.Barbie.Internal.ProductC-   hs-source-dirs:       src @@ -139,50 +129,6 @@       barbies     , base >=4.7 && <5     , distributive-    , QuickCheck-    , tasty-    , tasty-hunit-    , tasty-quickcheck--  default-language: Haskell2010-  default-extensions:-    DeriveDataTypeable-    DeriveGeneric-    KindSignatures-    LambdaCase-    Rank2Types-    ScopedTypeVariables-    StandaloneDeriving-    TypeApplications-    TypeOperators---- This tests that the deprecated Data.Barbie interface--- can still be used to build code writen against 1.x,--- with deprecation warnings-test-suite barbies-test-legacy-  type: exitcode-stdio-1.0--  main-is: Legacy/Spec.hs--  other-modules:-      Legacy.TestBarbies-      Legacy.TestBarbiesW-      Legacy.Clothes-      Legacy.Spec.Bare-      Legacy.Spec.Constraints-      Legacy.Spec.Functor-      Legacy.Spec.Traversable-      Legacy.Spec.Product-      Legacy.Spec.Wrapper--  hs-source-dirs:-      test-legacy--  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wno-deprecations -O0--  build-depends:-      barbies-    , base >=4.7 && <5     , QuickCheck     , tasty     , tasty-hunit

@@ -20,6 +20,7 @@     --   and a 'TraversableB'.   , bttraverse   , bttraverse1+  , btfor1   , bttraverse_   , btfoldMap @@ -108,6 +109,17 @@ bttraverse1 h   = bttraverse h h {-# INLINE bttraverse1 #-}++-- | 'bttraverse1' with the arguments flipped.+btfor1+  :: ( TraversableB (b f)+     , TraversableT b+     , Monad t+     )+  => b f f+  -> (forall a . f a -> t (g a))+  -> t (b g g)+btfor1 b f = bttraverse1 f b  -- | Map each element to an action, evaluate these actions from left to right --   and ignore the results.

@@ -8,6 +8,7 @@   ( ConstraintsB(..)   , bmapC   , btraverseC+  , bforC   , AllBF   , bdicts   , bpureC@@ -147,6 +148,19 @@   -> e (b g) btraverseC f b   = btraverse (\(Pair (Dict :: Dict c a) x) -> f x) (baddDicts b)++-- | 'btraverseC' with the arguments flipped. Useful when the traversing function is a large lambda:+--+-- @+-- bforC someBarbie $ \fa -> ...+-- @+bforC+  :: forall c b f g e+  .  (TraversableB b, ConstraintsB b, AllB c b, Applicative e)+  => b f+  -> (forall a. c a => f a -> e (g a))+  -> e (b g)+bforC b f = btraverseC @c f b  bfoldMapC   :: forall c b m f

@@ -7,6 +7,7 @@   ( ConstraintsT(..)   , tmapC   , ttraverseC+  , tforC   , AllTF   , tdicts   , tpureC@@ -121,6 +122,16 @@   -> e (t g x) ttraverseC f t   = ttraverse (\(Pair (Dict :: Dict c a) x) -> f x) (taddDicts t)++-- | Like 'ttraverseC' but with the arguments flipped.+tforC+  :: forall c t f g e x+  .  (TraversableT t, ConstraintsT t, AllT c t, Applicative e)+  => t f x+  -> (forall a. c a => f a -> e (g a))+  -> e (t g x)+tforC t f+  = ttraverseC @c f t  -- | Like 'Data.Functor.Transformer.tfoldMap' but with a constraint on the function. tfoldMapC

@@ -3,7 +3,9 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Barbies.Internal.TraversableB   ( TraversableB(..)+  , bfor   , btraverse_+  , bfor_   , bsequence   , bsequence'   , bfoldMap@@ -50,6 +52,17 @@     -> e (b g)   btraverse = gbtraverseDefault +-- | 'btraverse' with the arguments flipped. Useful when the traversing function is a large lambda:+--+-- @+-- bfor someBarbie $ \fa -> ...+-- @+bfor+  :: (TraversableB b, Applicative e)+  => b f+  -> (forall a . f a -> e (g a))+  -> e (b g)+bfor b f = btraverse f b   -- | Map each element to an action, evaluate these actions from left to right,@@ -61,6 +74,14 @@   -> e () btraverse_ f   = void . btraverse (fmap (const $ Const ()) . f)++-- | 'btraverse_' with the arguments flipped.+bfor_+  :: (TraversableB b, Applicative e)+  => b f+  -> (forall a. f a -> e c)+  -> e ()+bfor_ b f = btraverse_ f b   -- | Evaluate each action in the structure from left to right,

@@ -4,7 +4,9 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Barbies.Internal.TraversableT   ( TraversableT(..)+  , tfor   , ttraverse_+  , tfor_   , tsequence   , tsequence'   , tfoldMap@@ -60,6 +62,17 @@     => (forall a . f a -> e (g a)) -> t f x -> e (t g x)   ttraverse = ttraverseDefault +-- | 'ttraverse' with the arguments flipped. Useful when the traversing function is a large lambda:+--+-- @+-- tfor someTransformer $ \fa -> ...+-- @+tfor+  :: (TraversableT t, Applicative e)+  => t f x+  -> (forall a . f a -> e (g a))+  -> e (t g x)+tfor t f = ttraverse f t   -- | Map each element to an action, evaluate these actions from left to right,@@ -70,6 +83,14 @@   -> t f x -> e () ttraverse_ f   = void . ttraverse (fmap (const $ Const ()) . f)++-- | 'ttraverse_' with the arguments flipped.+tfor_+  :: (TraversableT t, Applicative e)+  => t f x+  -> (forall a . f a -> e c)+  -> e ()+tfor_ t f = ttraverse_ f t   -- | Evaluate each action in the structure from left to right,

@@ -1,105 +0,0 @@-{-# OPTIONS_GHC -Wno-deprecations #-}-module Data.Barbie-  {-# DEPRECATED "Use Data.Functor.Barbie or Barbies instead" #-}-  (-    -- * Functor-    FunctorB(bmap)--    -- * Traversable-  , TraversableB(btraverse)-    -- ** Utility functions-  , btraverse_-  , bfoldMap-  , bsequence, bsequence'--    -- * Product-  , ProductB(buniq, bprod)-  , CanDeriveProductB--    -- ** Utility functions-  , App.bzip-  , App.bunzip-  , App.bzipWith-  , App.bzipWith3-  , App.bzipWith4--    -- * Constraints and instance dictionaries-  , ConstraintsB(AllB, baddDicts)-  , AllBF-    -- ** Utility functions-  , bmapC-  , btraverseC--    -- * Products and constaints-  , ProductBC(bdicts)-  , CanDeriveProductBC-    -- ** Utility functions-  , buniqC-  , bmempty--    -- * Wrapper-  , Barbie(..)--    -- * Trivial Barbies-  , Trivial.Void-  , Trivial.Unit (..)--    -- * Generic derivations-  , Rec(..)-  , GProductB(..)-  , GProductBC(..)--    -- * Deprecations-  , (/*/), (/*)-  )--where--import Barbies.Internal.ConstraintsB (AllBF, ConstraintsB (..), bmapC, btraverseC, bmempty)--import Barbies.Internal.FunctorB(FunctorB(..))-import Barbies.Internal.Wrappers(Barbie(..))-import qualified Barbies.Internal.ApplicativeB as App--import Data.Barbie.Internal.Product(ProductB(..), CanDeriveProductB, GProductB(..))-import Data.Barbie.Internal.ProductC(ProductBC(..), CanDeriveProductBC,  GProductBC(..), buniqC)--import Barbies.Internal.TraversableB-  ( TraversableB(..)-  , bsequence, bsequence'-  , bfoldMap, btraverse_-  )-import qualified Barbies.Internal.Trivial as Trivial--import Data.Functor.Product (Product(Pair))-import Data.Functor.Prod (Prod(..), oneTuple, prod)-import Data.Generics.GenericN (Rec(..))---{-# DEPRECATED (/*/), (/*) "Use bzipWith2, bzipWith3, etc" #-}---- | Like 'bprod', but returns a binary 'Prod', instead of 'Product', which---   composes better.------   See '/*/' for usage.-(/*/)-  :: ProductB b => b f -> b g -> b (Prod '[f, g])-l /*/ r-  = bmap (\(Pair f g) -> Cons f (Cons g Unit)) (l `bprod` r)-infixr 4 /*/---- | Similar to '/*/' but one of the sides is already a @'Prod' fs@.------   Note that '/*', '/*/' and 'Data.Functor.Prod.uncurryn' are meant to be used together:---   '/*' and '/*/' combine @b f1, b f2...b fn@ into a single product that---   can then be consumed by using `Data.Functor.Prod.uncurryn` on an n-ary function. E.g.------ @--- f :: f a -> g a -> h a -> i a------ 'bmap' ('Data.Functor.Prod.uncurryn' f) (bf '/*' bg '/*/' bh)--- @-(/*) :: ProductB b => b f -> b (Prod fs) -> b (Prod (f ': fs))-l /* r =-  bmap (\(Pair f fs) -> oneTuple f `prod` fs) (l `bprod` r)-infixr 4 /*

@@ -1,14 +0,0 @@-module Data.Barbie.Bare-  {-# DEPRECATED "Use Barbies.Bare" #-}-  ( -- * Bare values-    Barbies.Bare.Wear-  , Barbies.Bare.Bare-  , Barbies.Bare.Covered--    -- * Covering and stripping-  , Barbies.Bare.BareB(bstrip, bcover)-  , Barbies.Bare.bstripFrom-  , Barbies.Bare.bcoverWith-  ) where--import qualified Barbies.Bare

@@ -1,22 +0,0 @@-module Data.Barbie.Constraints-  {-# DEPRECATED "Use Data.Functor.Barbie or Barbie.Constraints" #-}-  ( -- * Instance dictionaries-    Dict(..)-  , requiringDict--    -- * Retrieving dictionaries-  , ConstraintsB(..)-  , ProductBC(..)-  , bmapC-  , btraverseC--  , AllBF-  , ClassF-  , ClassFG-  )--where--import Barbies.Internal.ConstraintsB-import Barbies.Internal.Dicts-import Data.Barbie.Internal.ProductC

@@ -1,166 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes  #-}-{-# LANGUAGE PolyKinds            #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-orphans -Wno-deprecations #-}-module Data.Barbie.Internal.Product-  ( ProductB(buniq, bprod)-  , CanDeriveProductB-  , gbprodDefault, gbuniqDefault-  , GProductB(..)-  )--where--import Barbies.Internal.FunctorB (FunctorB)-import Barbies.Internal.Trivial (Unit)-import Barbies.Internal.Wrappers (Barbie(..))-import qualified Barbies.Internal.ApplicativeB as App--import Data.Functor.Product (Product (..))-import Data.Kind            (Type)-import Data.Proxy           (Proxy (..))--import Data.Generics.GenericN---{-# DEPRECATED ProductB "Use ApplicativeB" #-}-{-# DEPRECATED buniq "Use bpure" #-}-class App.ApplicativeB b => ProductB (b :: (k -> Type) -> Type) where-  bprod :: b f -> b g -> b (f `Product` g)--  buniq :: (forall a . f a) -> b f--  default bprod :: CanDeriveProductB b f g => b f -> b g -> b (f `Product` g)-  bprod = gbprodDefault--  default buniq :: CanDeriveProductB b f f => (forall a . f a) -> b f-  buniq = gbuniqDefault----type CanDeriveProductB b f g-  = ( GenericN (b f)-    , GenericN (b g)-    , GenericN (b (f `Product` g))-    , GProductB f g (RepN (b f)) (RepN (b g)) (RepN (b (f `Product` g)))-    )--instance {-# OVERLAPPABLE #-} (ProductB b, FunctorB b) => App.ApplicativeB b where-  bpure = Data.Barbie.Internal.Product.buniq-  bprod = Data.Barbie.Internal.Product.bprod--instance ProductB Unit where--instance ProductB b => ProductB (Barbie b) where-    buniq x = Barbie (buniq x)-    bprod (Barbie l) (Barbie r) = Barbie (bprod l r)---- ======================================--- Generic derivation of instances--- ======================================---- | Default implementation of 'bprod' based on 'Generic'.-gbprodDefault-  :: forall b f g-  .  CanDeriveProductB b f g-  => b f -> b g -> b (f `Product` g)-gbprodDefault l r-  = toN $ gbprod (Proxy @f) (Proxy @g) (fromN l) (fromN r)-{-# INLINE gbprodDefault #-}--gbuniqDefault:: forall b f . CanDeriveProductB b f f => (forall a . f a) -> b f-gbuniqDefault x-  = toN $ gbuniq (Proxy @f) (Proxy @(RepN (b f))) (Proxy @(RepN (b (f `Product` f)))) x-{-# INLINE gbuniqDefault #-}--class GProductB (f :: k -> Type) (g :: k -> Type) repbf repbg repbfg where-  gbprod :: Proxy f -> Proxy g -> repbf x -> repbg x -> repbfg x--  gbuniq :: (f ~ g, repbf ~ repbg) => Proxy f -> Proxy repbf -> Proxy repbfg -> (forall a . f a) -> repbf x---- ------------------------------------- Trivial cases--- ------------------------------------instance GProductB f g repf repg repfg => GProductB f g (M1 i c repf)-                                                        (M1 i c repg)-                                                        (M1 i c repfg) where-  gbprod pf pg (M1 l) (M1 r) = M1 (gbprod pf pg l r)-  {-# INLINE gbprod #-}--  gbuniq pf _ _ x = M1 (gbuniq pf (Proxy @repf) (Proxy @repfg) x)-  {-# INLINE gbuniq #-}---instance GProductB f g U1 U1 U1 where-  gbprod _ _ U1 U1 = U1-  {-# INLINE gbprod #-}--  gbuniq _ _ _ _ = U1-  {-# INLINE gbuniq #-}--instance-  ( GProductB f g lf lg lfg-  , GProductB f g rf rg rfg-  ) => GProductB f g (lf  :*: rf)-                     (lg  :*: rg)-                     (lfg :*: rfg) where-  gbprod pf pg (l1 :*: l2) (r1 :*: r2)-    = (l1 `lprod` r1) :*: (l2 `rprod` r2)-    where-      lprod = gbprod pf pg-      rprod = gbprod pf pg-  {-# INLINE gbprod #-}--  gbuniq pf _ _ x = (gbuniq pf (Proxy @lf) (Proxy @lfg) x :*: gbuniq pf (Proxy @rf) (Proxy @rfg) x)-  {-# INLINE gbuniq #-}---- ----------------------------------- The interesting cases--- ----------------------------------type P0 = Param 0--instance GProductB f g (Rec (P0 f a_or_pma) (f a))-                       (Rec (P0 g a_or_pma) (g a))-                       (Rec (P0 (f `Product` g) a_or_pma) ((f `Product` g) a)) where-  gbprod _ _ (Rec (K1 fa)) (Rec (K1 ga))-    = Rec (K1 (Pair fa ga))-  {-# INLINE gbprod #-}--  gbuniq _ _ _ x = Rec (K1 x)-  {-# INLINE gbuniq #-}----- b' is b, maybe with 'Param' annotations-instance-  ( ProductB b-  ) => GProductB f g (Rec (b' (P0 f)) (b f))-                     (Rec (b' (P0 g)) (b g))-                     (Rec (b' (P0 (f `Product` g))) (b (f `Product` g))) where-  gbprod _ _ (Rec (K1 bf)) (Rec (K1 bg))-    = Rec (K1 (bf `bprod` bg))-  {-# INLINE gbprod #-}--  gbuniq _ _ _ x = Rec (K1 (buniq x))-  {-# INLINE gbuniq #-}----- ----------------------------------- Instances for base types--- ----------------------------------instance ProductB Proxy where-  bprod _ _ = Proxy-  {-# INLINE bprod #-}--  buniq _ = Proxy-  {-# INLINE buniq #-}--instance (ProductB a, ProductB b) => ProductB (Product a b) where-  bprod (Pair ll lr) (Pair rl rr) = Pair (bprod ll rl) (bprod lr rr)-  {-# INLINE bprod #-}--  buniq x = Pair (buniq x) (buniq x)-  {-# INLINE buniq #-}

@@ -1,133 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes  #-}-{-# LANGUAGE PolyKinds            #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-deprecations #-}-module Data.Barbie.Internal.ProductC-  ( ProductBC(..)-  , buniqC--  , CanDeriveProductBC-  , GAll-  , GProductBC(..)-  , gbdictsDefault-  )--where--import Barbies.Generics.Constraints(GAll, Self, Other, X)-import Barbies.Internal.ConstraintsB(ConstraintsB(..), GAllRepB)-import Barbies.Internal.Dicts(Dict (..), requiringDict)-import Barbies.Internal.FunctorB(FunctorB(bmap))-import Barbies.Internal.Trivial(Unit(..))-import Barbies.Internal.Wrappers(Barbie(..))--import Data.Barbie.Internal.Product(ProductB(..))-import Data.Generics.GenericN--import Data.Functor.Product (Product (..))-import Data.Kind(Type)-import Data.Proxy(Proxy (..))--class (ConstraintsB b, ProductB b) => ProductBC (b :: (k -> Type) -> Type) where-  bdicts :: AllB c b => b (Dict c)--  default bdicts :: (CanDeriveProductBC c b, AllB c b) => b (Dict c)-  bdicts = gbdictsDefault---type CanDeriveProductBC c b-  = ( GenericN (b (Dict c))-    , AllB c b ~ GAll 0 c (GAllRepB b)-    , GProductBC c (GAllRepB b) (RepN (b (Dict c)))-    )--{-# DEPRECATED buniqC "Use bpureC instead" #-}-buniqC :: forall c f b . (AllB c b, ProductBC b) => (forall a . c a => f a) -> b f-buniqC x-  = bmap (requiringDict @c x) bdicts--instance ProductBC b => ProductBC (Barbie b) where-  bdicts = Barbie bdicts--instance ProductBC Unit where-  bdicts = Unit----- ===============================================================---  Generic derivations--- ===============================================================---- | Default implementation of 'bdicts' based on 'Generic'.-gbdictsDefault-  :: forall b c-  .  ( CanDeriveProductBC c b-     , AllB c b-     )-  => b (Dict c)-gbdictsDefault-  = toN $ gbdicts @c @(GAllRepB b)-{-# INLINE gbdictsDefault #-}---class GProductBC c repbx repbd where-  gbdicts :: GAll 0 c repbx => repbd x---- ------------------------------------- Trivial cases--- ------------------------------------instance GProductBC c repbx repbd => GProductBC c (M1 i k repbx) (M1 i k repbd) where-  gbdicts = M1 (gbdicts @c @repbx)-  {-# INLINE gbdicts #-}--instance GProductBC c U1 U1 where-  gbdicts = U1-  {-# INLINE gbdicts #-}--instance-  ( GProductBC c lx ld-  , GProductBC c rx rd-  ) => GProductBC c (lx :*: rx)-                    (ld :*: rd) where-  gbdicts = gbdicts @c @lx @ld :*: gbdicts @c @rx @rd-  {-# INLINE gbdicts #-}----- ----------------------------------- The interesting cases--- ----------------------------------type P0 = Param 0--instance c a => GProductBC c (Rec (P0 X a_or_pma) (X a))-                             (Rec (P0 (Dict c) a_or_pma) (Dict c a)) where-  gbdicts = Rec (K1 Dict)-  {-# INLINE gbdicts #-}--instance-  ( ProductBC b-  , AllB c b-  ) => GProductBC c (Self (b' (P0 X)) (b X))-                    (Rec (b' (P0 (Dict c))) (b (Dict c))) where-  gbdicts = Rec $ K1 $ bdicts @_ @b--instance-  ( ProductBC b-  , AllB c b-  ) => GProductBC c (Other (b' (P0 X)) (b X))-                    (Rec (b' (P0 (Dict c))) (b (Dict c))) where-  gbdicts = Rec $ K1 $ bdicts @_ @b----- ----------------------------------- Instances for base types--- ----------------------------------instance ProductBC Proxy where-  bdicts = Proxy-  {-# INLINE bdicts #-}--instance (ProductBC a, ProductBC b) => ProductBC (Product a b) where-  bdicts = Pair bdicts bdicts-  {-# INLINE bdicts #-}

@@ -1,246 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Functor.Prod------ Generalize the standard two-functor 'Product' to the product of--- @n@-functors. Intuitively, this means:------ @--- 'Product' f g a ~~ (f a, g a)------ 'Prod' '[]        a ~~  Const () a--- 'Prod' '[f]       a ~~ (f a)--- 'Prod' '[f, g]    a ~~ (f a, g a)--- 'Prod' '[f, g, h] a ~~ (f a, g a, h a)---     ⋮--- @------------------------------------------------------------------------------{-# LANGUAGE GADTs #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE TypeFamilies #-}-module Data.Functor.Prod- {-# DEPRECATED "The module is no longer part of the main api and will be removed " #-}- ( -- * n-tuples of functors.-    Prod(Unit, Cons)-  , zeroTuple-  , oneTuple-  , fromProduct-  , toProduct--    -- * Flat product of functor products-  , prod--    -- * Lifting functions-  , uncurryn--    -- * Type-level helpers-  , type (++)-  , Curried-  )--where--import Control.Applicative(Alternative(..))-import Data.Functor.Product(Product(..))-import Data.Functor.Classes(Eq1(..), Ord1(..), Show1(..))-import Data.Kind (Type)--import qualified Data.Functor.Classes as FC---- | Product of n functors.-data Prod :: [k -> Type] -> k -> Type where-  Unit :: Prod '[] a-  Cons :: (f a) -> Prod fs a -> Prod (f ': fs) a---- | The unit of the product.-zeroTuple :: Prod '[] a-zeroTuple-  = Unit---- | Lift a functor to a 1-tuple.-oneTuple :: f a -> Prod '[f] a-oneTuple fa-  = Cons fa Unit---- | Conversion from a standard 'Product'-fromProduct :: Product f g a -> Prod '[f, g] a-fromProduct (Pair fa ga)-  = Cons fa $ Cons ga Unit---- | Conversion to a standard 'Product'-toProduct :: Prod '[f, g] a -> Product f g a-toProduct (Cons fa (Cons ga Unit))-  = Pair fa ga----- | Flat product of products.-prod :: Prod ls a -> Prod rs a -> Prod (ls ++ rs) a-l `prod` r =-  case l of-    Unit -> r-    Cons la l' -> Cons la (l' `prod` r)---- | Type-level, poly-kinded, list-concatenation.-type family (++) l r :: [k] where-  '[]       ++ ys = ys-  (x ': xs) ++ ys = x ': (xs ++ ys)---- ----------------------------------------------------------------- Uncurrying of functions--- ------------------------------------------------------------------ | @'Prod' '[f, g, h] a -> r@ is the type of the uncurried form---   of a function @f a -> g a -> h a -> r@. 'Curried' moves from---   the former to the later. E.g.------ @--- 'Curried' ('Prod' '[]  a    -> r) = r a--- 'Curried' ('Prod' '[f] a    -> r) = f a -> r a--- 'Curried' ('Prod' '[f, g] a -> r) = f a -> g a -> r a--- @-type family Curried t  where-  Curried (Prod '[] a -> r a) = r a-  Curried (Prod (f ': fs) a -> r a) = f a -> Curried (Prod fs a -> r a)---- | Like 'uncurry' but using 'Prod' instead of pairs. Can---   be thought of as a family of functions:------ @--- 'uncurryn' :: r a -> 'Prod' '[] a--- 'uncurryn' :: (f a -> r a) -> 'Prod' '[f] a--- 'uncurryn' :: (f a -> g a -> r a) -> 'Prod' '[f, g] a--- 'uncurryn' :: (f a -> g a -> h a -> r a) -> 'Prod' '[f, g, h] a---         ⋮--- @-uncurryn :: Curried (Prod fs a -> r a) -> Prod fs a -> r a-uncurryn fun = \case-  Unit -> fun-  Cons fa fs' ->-    let fun' = fun fa-    in uncurryn fun' fs'---- -----------------------------------------------------------------  Instances--- ------------------------------------------------------------------ | Inductively defined instance: @'Functor' ('Prod' '[])@.-instance Functor (Prod '[]) where-  fmap _ Unit = Unit---- | Inductively defined instance: @'Functor' ('Prod' (f ': fs))@.-instance (Functor f, Functor (Prod fs)) => Functor (Prod (f ': fs))  where-  fmap f (Cons fa fas)-    =  Cons (fmap f fa) (fmap f fas)---- | Inductively defined instance: @'Applicative' ('Prod' '[])@.-instance Applicative (Prod '[]) where-  pure _-    = Unit--  Unit <*> Unit-    = Unit---- | Inductively defined instance: @'Applicative' ('Prod' (f ': fs))@.-instance (Applicative f, Applicative (Prod fs)) => Applicative (Prod (f ': fs)) where-  pure a-    = Cons (pure a) (pure a)--  Cons f fs <*> Cons a as-    = Cons (f <*> a) (fs <*> as)---- | Inductively defined instance: @'Alternative' ('Prod' '[])@.-instance Alternative (Prod '[]) where-  empty-    = Unit--  Unit <|> Unit-    = Unit---- | Inductively defined instance: @'Alternative' ('Prod' (f ': fs))@.-instance (Alternative f, Alternative (Prod fs)) => Alternative (Prod (f ': fs)) where-  empty-    = Cons empty empty--  Cons f fs <|> Cons g gs-    = Cons (f <|> g) (fs <|> gs)----- NB. There are Monad instances for `Data.Functor.Product`, but I'm not convinced they--- make much sense. In particular, we seem to get a O(n^2) bind.---- | Inductively defined instance: @'Foldable' ('Prod' '[])@.-instance Foldable (Prod '[]) where-  foldMap _ = mempty---- | Inductively defined instance: @'Foldable' ('Prod' (f ': fs))@.-instance (Foldable f, Foldable (Prod fs)) => Foldable (Prod (f ': fs)) where-  foldMap f (Cons fa fas)-    = foldMap f fa `mappend` foldMap f fas---- | Inductively defined instance: @'Traversable' ('Prod' '[])@.-instance Traversable (Prod '[]) where-  traverse _ Unit = pure Unit---- | Inductively defined instance: @'Traversable' ('Prod' (f ': fs))@.-instance (Traversable f, Traversable (Prod fs)) => Traversable (Prod (f ': fs)) where-  traverse f (Cons fa fas)-    = Cons <$> (traverse f fa) <*> (traverse f fas)---- | Inductively defined instance: @'Eq1' ('Prod' '[])@.-instance Eq1 (Prod '[]) where-  liftEq _ Unit Unit = True---- | Inductively defined instance: @'Eq1' ('Prod' (f ': fs))@.-instance (Eq1 f, Eq1 (Prod fs)) => Eq1 (Prod (f ': fs)) where-  liftEq eq (Cons l ls) (Cons r rs)-    = liftEq eq l r && liftEq eq ls rs---- | Inductively defined instance: @'Eq' ('Prod' '[])@.-instance Eq a => Eq (Prod '[] a) where-  (==) = FC.eq1---- | Inductively defined instance: @'Eq' ('Prod' (f ': fs))@.-instance (Eq1 f, Eq a, Eq1 (Prod fs)) => Eq (Prod (f ': fs) a) where-  (==) = FC.eq1---- | Inductively defined instance: @'Ord1' ('Prod' '[])@.-instance Ord1 (Prod '[]) where-  liftCompare _ Unit Unit = EQ---- | Inductively defined instance: @'Ord1' ('Prod' (f ': fs))@.-instance (Ord1 f, Ord1 (Prod fs)) => Ord1 (Prod (f ': fs)) where-  liftCompare cmp (Cons l ls) (Cons r rs)-    = liftCompare cmp l r `mappend` liftCompare cmp ls rs---- | Inductively defined instance: @'Ord' ('Prod' '[])@.-instance Ord a => Ord (Prod '[] a) where-  compare = FC.compare1---- | Inductively defined instance: @'Ord' ('Prod' (f ': fs))@.-instance (Ord1 f, Ord a, Ord1 (Prod fs)) => Ord (Prod (f ': fs) a) where-  compare = FC.compare1---- | Inductively defined instance: @'Show1' ('Prod' '[])@.-instance Show1 (Prod '[]) where-  liftShowsPrec _ _ _ Unit = showString "zeroTuple"---- | Inductively defined instance: @'Show1' ('Prod' (f ': fs))@.-instance (Show1 f, Show1 (Prod fs)) => Show1 (Prod (f ': fs)) where-  liftShowsPrec sp sl d = \case-    (Cons fa Unit) ->-      showParen (d > 10) $-        showString "oneTuple " . liftShowsPrec sp sl 11 fa-    (Cons fa fas)  ->-      showParen (d > 10) $-        showString "oneTuple " . liftShowsPrec sp sl 11 fa-          . showString " `prod` "-          . liftShowsPrec sp sl 0 fas---- | Inductively defined instance: @'Show' ('Prod' '[])@.-instance Show a => Show (Prod '[] a) where-  showsPrec = FC.showsPrec1---- | Inductively defined instance: @'Show' ('Prod' (f ': fs))@.-instance (Show1 f, Show a, Show1 (Prod fs)) => Show (Prod (f ': fs) a) where-  showsPrec = FC.showsPrec1-

@@ -12,7 +12,9 @@     -- * Traversable   , Trav.TraversableT(ttraverse)     -- ** Utility functions+  , Trav.tfor   , Trav.ttraverse_+  , Trav.tfor_   , Trav.tfoldMap   , Trav.tsequence   , Trav.tsequence'@@ -43,6 +45,7 @@     -- ** Utility functions   , Cons.tmapC   , Cons.ttraverseC+  , Cons.tforC      -- * Support for generic derivations   , GenericsN.Rec(..)

@@ -1,189 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Legacy.Clothes--where--import Prelude hiding ((.), id)--import Control.Category-import Data.Functor.Identity-import qualified Data.List.NonEmpty as NE-import Data.Typeable--import Test.Tasty.QuickCheck--data UnitF a = UnitF deriving(Eq, Show, Typeable)--data F a = F [a]-  deriving(Eq, Show, Typeable)--data G a = NoG | G1 a | Gn [a]-  deriving(Eq, Show, Typeable)--data H a = NoH1 | NoH2 | H1 [a] | H2 [a] | H3 [a]-  deriving(Eq, Show, Typeable)--data I a = NoI1 | NoI2 | NoI3 | I1 a | I2 (a,a)-  deriving(Eq, Show, Typeable)---instance Arbitrary a => Arbitrary (F a) where-  arbitrary = F <$> arbitrary--instance Arbitrary a => Arbitrary (G a) where-  arbitrary = oneof-    [ pure NoG-    , G1 <$> arbitrary-    , Gn <$> arbitrary-    ]--instance Arbitrary a => Arbitrary (H a) where-  arbitrary = oneof-    [ pure NoH1-    , pure NoH2-    , H1 <$> arbitrary-    , H2 <$> arbitrary-    , H3 <$> arbitrary-    ]--instance Arbitrary a => Arbitrary (I a) where-  arbitrary = oneof-    [ pure NoI1-    , pure NoI2-    , pure NoI3-    , I1 <$> arbitrary-    , I2 <$> arbitrary-    ]--newtype NatTransf f g-  = NatTransf {applyNat :: (forall a . f a -> g a)}---instance Category NatTransf where-  id    = NatTransf id-  f . g = NatTransf (applyNat f . applyNat g)--point :: (forall a . a -> f a) -> NatTransf Identity f-point mkPoint-  = NatTransf (\(Identity a) -> mkPoint a)--unit :: (forall a . f a) -> NatTransf UnitF f-unit u-  = NatTransf (\UnitF -> u)--headF :: NatTransf NE.NonEmpty Identity-headF-  = NatTransf (\(a NE.:| _) -> Identity a)--terminal :: NatTransf f UnitF-terminal-  = NatTransf (const UnitF)---instance (ArbitraryF f, ArbitraryF g) => Arbitrary (NatTransf f g) where-  arbitrary-    = do fromList <- arbitraryf-         pure (fromList . flattenf)---class ArbitraryF f where-  arbitraryf :: Gen (NatTransf [] f)-  flattenf   :: NatTransf f []---instance ArbitraryF F where-  arbitraryf-    = pure $ NatTransf F--  flattenf-    = NatTransf (\(F as) -> as)---instance ArbitraryF G where-  arbitraryf-    = mkArbitraryf-        [unit NoG]-        [point G1 , point (Gn . pure)]-        [NatTransf (Gn . NE.toList)]--  flattenf-    = NatTransf $ \case-        NoG   -> []-        G1 a  -> [a]-        Gn as -> as---instance ArbitraryF H where-  arbitraryf-    = mkArbitraryf-        [unit NoH1, unit NoH2]-        [point (H1 . pure), point (H2 . pure)]-        [ NatTransf (H1 . NE.toList)-        , NatTransf (H2 . NE.toList)-        , NatTransf (H2 . NE.toList)-        ]--  flattenf-    = NatTransf $ \case-        NoH1  -> []-        NoH2  -> []-        H1 as -> as-        H2 as -> as-        H3 as -> as--instance ArbitraryF I where-  arbitraryf-    = mkArbitraryf-        [unit NoI1, unit NoI2, unit NoI3]-        [point I1, NatTransf (\(Identity a) -> I2 (a, a))]-        [ NatTransf mkI2 ]-    where-      mkI2 = \case-        a NE.:| []    -> I2 (a, a)-        a NE.:| (b:_) -> I2 (a, b)--  flattenf-    = NatTransf $ \case-        NoI1     -> []-        NoI2     -> []-        NoI3     -> []-        I1 a     -> [a]-        I2 (a,b) -> [a,b]--mkArbitraryf-  :: [NatTransf UnitF f]-  -> [NatTransf Identity f]-  -> [NatTransf NE.NonEmpty f]-  -> Gen (NatTransf [] f)-mkArbitraryf us is ls-  = do let nullary = us-           unary   = is ++ map (. terminal) nullary-           nary    = ls ++ map (. headF) unary-       build <$> elements nullary <*> elements unary <*> elements nary-  where-    build u i l-      = NatTransf $ \case-          []   -> applyNat u UnitF-          [a]  -> applyNat i (Identity a)-          a:as -> applyNat l (a NE.:| as)--newtype FG-  = FG (NatTransf F G)-  deriving (Arbitrary)--newtype GH-  = GH (NatTransf G H)-  deriving (Arbitrary)--newtype HI-  = HI (NatTransf H I)-  deriving (Arbitrary)--instance Show FG-  where show _ = "<natural-transformation :: F -> G>"--instance Show GH-  where show _ = "<natural-transformation :: G -> H>"--instance Show HI-  where show _ = "<natural-transformation :: H -> I>"

@@ -1,204 +0,0 @@-import Test.Tasty (defaultMain, testGroup)-import Test.Tasty.HUnit (testCase, (@?=))--import qualified Legacy.Spec.Bare as Bare-import qualified Legacy.Spec.Constraints as Constraints-import qualified Legacy.Spec.Functor as Functor-import qualified Legacy.Spec.Product as Product-import qualified Legacy.Spec.Traversable as Traversable-import qualified Legacy.Spec.Wrapper as Wrapper--import Legacy.TestBarbies-import Legacy.TestBarbiesW--import Data.Barbie           (bfoldMap, bmapC, btraverseC, buniqC)-import Data.Barbie.Bare      (Covered)-import Data.Functor.Const    (Const (..))-import Data.Functor.Identity (Identity (..))-import Data.Monoid           (Sum (..))--main :: IO ()-main-  = defaultMain $-      testGroup "Tests"-        [ testGroup "Functor Laws"-            [ Functor.laws @Record0-            , Functor.laws @Record1-            , Functor.laws @Record3--            , Functor.laws @Record1S-            , Functor.laws @Record3S--            , Functor.laws @(Record1W Covered)-            , Functor.laws @(Record3W Covered)--            , Functor.laws @(Record1WS Covered)-            , Functor.laws @(Record3WS Covered)--            , Functor.laws @Ignore1--            , Functor.laws @Sum3-            , Functor.laws @SumRec--            , Functor.laws @(Sum3W Covered)-            , Functor.laws @(SumRecW Covered)--            , Functor.laws @CompositeRecord-            , Functor.laws @NestedF--            , Functor.laws @(CompositeRecordW Covered)-            ]--        , testGroup "Traversable Laws"-            [ Traversable.laws @Record0-            , Traversable.laws @Record1-            , Traversable.laws @Record3--            , Traversable.laws @Record1S-            , Traversable.laws @Record3S--            , Traversable.laws @(Record1W Covered)-            , Traversable.laws @(Record3W Covered)--            , Traversable.laws @(Record1WS Covered)-            , Traversable.laws @(Record3WS Covered)--            , Traversable.laws @Ignore1--            , Traversable.laws @Sum3-            , Traversable.laws @SumRec--            , Traversable.laws @(Sum3W Covered)-            , Traversable.laws @(SumRecW Covered)--            , Traversable.laws @CompositeRecord-            , Traversable.laws @NestedF--            , Traversable.laws @(CompositeRecordW Covered)-            ]--        , testGroup "Product Laws"-            [ Product.laws @Record0-            , Product.laws @Record1-            , Product.laws @Record3-            , Product.laws @CompositeRecord--            , Product.laws @Record1S-            , Product.laws @Record3S--            , Product.laws @(Record1W Covered)-            , Product.laws @(Record3W Covered)-            , Product.laws @(CompositeRecordW Covered)--            , Product.laws @(Record1WS Covered)-            , Product.laws @(Record3WS Covered)-            ]--        , testGroup "Uniq Laws"-            [ Product.uniqLaws @Record0-            , Product.uniqLaws @Record1-            , Product.uniqLaws @Record3-            , Product.uniqLaws @CompositeRecord--            , Product.uniqLaws @Record1S-            , Product.uniqLaws @Record3S--            , Product.uniqLaws @(Record1W Covered)-            , Product.uniqLaws @(Record3W Covered)-            , Product.uniqLaws @(CompositeRecordW Covered)--            , Product.uniqLaws @(Record1WS Covered)-            , Product.uniqLaws @(Record3WS Covered)-            ]--        , testGroup "adDict projection"-            [ Constraints.lawAddDictPrj @Record0-            , Constraints.lawAddDictPrj @Record1-            , Constraints.lawAddDictPrj @Record3--            , Constraints.lawAddDictPrj @Record1S-            , Constraints.lawAddDictPrj @Record3S--            , Constraints.lawAddDictPrj @(Record1W Covered)-            , Constraints.lawAddDictPrj @(Record3W Covered)--            , Constraints.lawAddDictPrj @(Record1WS Covered)-            , Constraints.lawAddDictPrj @(Record3WS Covered)--            , Constraints.lawAddDictPrj @Ignore1--            , Constraints.lawAddDictPrj @Sum3-            , Constraints.lawAddDictPrj @SumRec--            , Constraints.lawAddDictPrj @(Sum3W Covered)-            , Constraints.lawAddDictPrj @(SumRecW Covered)--            , Constraints.lawAddDictPrj @CompositeRecord-            , Constraints.lawAddDictPrj @(CompositeRecordW Covered)-            ]--        , testGroup "bdicts projection"-            [ Constraints.lawDictsEquivPrj @Record0-            , Constraints.lawDictsEquivPrj @Record1-            , Constraints.lawDictsEquivPrj @Record3-            , Constraints.lawDictsEquivPrj @CompositeRecord--            , Constraints.lawDictsEquivPrj @Record1S-            , Constraints.lawDictsEquivPrj @Record3S--            , Constraints.lawDictsEquivPrj @(Record1W Covered)-            , Constraints.lawDictsEquivPrj @(Record3W Covered)-            , Constraints.lawDictsEquivPrj @(CompositeRecordW Covered)--            , Constraints.lawDictsEquivPrj @(Record1WS Covered)-            , Constraints.lawDictsEquivPrj @(Record3WS Covered)-            ]--        , testGroup "Bare laws"-            [ Bare.laws @Record1W-            , Bare.laws @Record3W-            , Bare.laws @Record1WS-            , Bare.laws @Record3WS-            , Bare.laws @Sum3W-            , Bare.laws @SumRecW-            , Bare.laws @NestedFW-            ]--        , testGroup "Generic wrapper"-            [ Wrapper.lawsMonoid @Record1-            , Wrapper.lawsMonoid @(Record1W Covered)--            , Wrapper.lawsMonoid @Record1S-            , Wrapper.lawsMonoid @(Record1WS Covered)--            , Wrapper.lawsMonoid @Record3-            , Wrapper.lawsMonoid @(Record3W Covered)--            , Wrapper.lawsMonoid @Record3S-            , Wrapper.lawsMonoid @(Record3WS Covered)-            ]--        , testGroup "bfoldMap"-            [ testCase "Record3" $ do-                let b = Record3 (Const "tic") (Const "tac") (Const "toe")-                bfoldMap getConst b @?= "tictactoe"-            ]-        , testGroup-          "bmapC"-          [ testCase "Record1" $-                bmapC @Num (fmap (+1)) (Record1 (Identity 0))-                    @?= Record1 (Identity 1)-          ]-        , testGroup-          "btraverseC"-          [ testCase "Record1" $-                btraverseC @Num (\inner -> (Sum @Int 1, fmap (+ 1) inner)) (Record1 (Identity 0))-                    @?= (Sum 1, Record1 (Identity 1))-          ]-        , testGroup-          "buniqC"-          [ testCase "Record1" $-                buniqC @Num (Identity (fromIntegral (42 :: Int)))-                    @?= Record1 (Identity 42)-          ]-        ]

@@ -1,30 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-module Legacy.Spec.Bare ( laws )--where--import Data.Barbie.Bare (BareB(..), Covered)-import Data.Functor.Identity--import Data.Typeable (Typeable, typeRep, Proxy(..))--import Test.Tasty(testGroup, TestTree)-import Test.Tasty.QuickCheck(Arbitrary(..), testProperty, (===))--laws-  :: forall b-  . ( BareB b-    , Eq (b Covered Identity) , Show (b Covered Identity) , Arbitrary (b Covered Identity)-    -- , Show (b Bare Identity), Eq (b Bare Identity), Arbitrary (b Bare Identity)-    , Typeable b-    )-  => TestTree-laws-  = testGroup (show (typeRep (Proxy :: Proxy b)))-      [ testProperty "bcover . bstrip = id" $ \b ->-          bcover (bstrip b) === (b :: b Covered Identity)--      -- TODO: FIXME-      -- , testProperty "bstrip . bcover = id" $ \b ->-      --     bstrip (bcover b) === (b :: b Bare)-      ]

@@ -1,49 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-module Legacy.Spec.Constraints-  ( lawAddDictPrj-  , lawDictsEquivPrj-  )--where--import Legacy.Clothes(F)-import Data.Barbie(bmap, ConstraintsB(..), AllBF, ProductBC(..))-import Data.Barbie.Constraints(ClassF, Dict)--import Data.Functor.Product (Product(Pair))-import Data.Typeable(Typeable, Proxy(..), typeRep)--import Test.Tasty(TestTree)-import Test.Tasty.QuickCheck(Arbitrary(..), testProperty, (===))---lawAddDictPrj-  :: forall b-  . ( ConstraintsB b, AllBF Show F b-    , Eq (b F)-    , Show (b F)-    , Arbitrary (b F)-    , Typeable b-    )-  => TestTree-lawAddDictPrj-  = testProperty (show (typeRep (Proxy :: Proxy b))) $ \b ->-      bmap second (baddDicts b :: b (Dict (ClassF Show F) `Product` F)) === b-  where-    second (Pair _ b) = b---lawDictsEquivPrj-  :: forall b-  . ( ProductBC b, AllBF Show F b-    , Eq (b (Dict (ClassF Show F)))-    , Show (b F), Show (b (Dict (ClassF Show F)))-    , Arbitrary (b F)-    , Typeable b-    )-  => TestTree-lawDictsEquivPrj-  = testProperty (show (typeRep (Proxy :: Proxy b))) $ \b ->-      bmap first (baddDicts b :: b (Dict (ClassF Show F) `Product` F)) === bdicts-  where-    first (Pair a _) = a

@@ -1,32 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-module Legacy.Spec.Functor ( laws )--where--import Legacy.Clothes (F, H, FG(..), GH(..), NatTransf(..))--import Data.Barbie (FunctorB(..))--import Data.Typeable (Typeable, typeRep, Proxy(..))--import Test.Tasty(testGroup, TestTree)-import Test.Tasty.QuickCheck(Arbitrary(..), testProperty, (===))--laws-  :: forall b-  . ( FunctorB b-    , Eq (b F), Eq (b H)-    , Show (b F), Show (b H)-    , Arbitrary (b F)-    , Typeable b-    )-  => TestTree-laws-  = testGroup (show (typeRep (Proxy :: Proxy b)))-      [ testProperty "bmap id = id" $ \b ->-          bmap id b === (b :: b F)--      , testProperty "bmap (f . g) = bmap f . bmap g)" $-          \b (GH (NatTransf f)) (FG (NatTransf g)) ->-            bmap (f . g) b === (bmap f . bmap g) (b :: b F)-      ]

@@ -1,45 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-module Legacy.Spec.Product ( laws, uniqLaws )--where--import Legacy.Clothes(F, G)--import Data.Barbie(FunctorB(..), ProductB(..))--import Data.Functor.Product(Product(Pair))-import Data.Typeable(Typeable, Proxy(..), typeRep)--import Test.Tasty(TestTree)-import Test.Tasty.QuickCheck(Arbitrary(..), testProperty, (===))---laws-  :: forall b-  . ( ProductB b-    , Eq (b F), Eq (b G)-    , Show (b F), Show (b G)-    , Arbitrary (b F), Arbitrary (b G)-    , Typeable b-    )-  => TestTree-laws-  = testProperty (show (typeRep (Proxy :: Proxy b))) $ \l r ->-      bmap first  (bprod l r) == (l :: b F) &&-      bmap second (bprod l r) == (r :: b G)-  where-    first  (Pair a _) = a-    second (Pair _ b) = b--uniqLaws-  :: forall b-  . ( ProductB b-    , Eq (b Maybe)-    , Show (b F), Show (b Maybe)-    , Arbitrary (b F)-    , Typeable b-    )-  => TestTree-uniqLaws-  = testProperty (show (typeRep (Proxy :: Proxy b))) $ \b ->-      bmap (const Nothing) (b :: b F) === buniq Nothing

@@ -1,44 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-module Legacy.Spec.Traversable ( laws )--where--import Legacy.Clothes (F, G, H, FG(..), GH(..), NatTransf(..))--import Data.Barbie (TraversableB(..))--import Data.Functor.Compose (Compose(..))-import Data.Functor.Identity (Identity(..))-import Data.Maybe (maybeToList)-import Data.Typeable (Typeable, typeRep, Proxy(..))--import Test.Tasty(testGroup, TestTree)-import Test.Tasty.QuickCheck(Arbitrary(..), testProperty, (===))--laws-  :: forall b-  . ( TraversableB b-    , Eq (b F), Eq (b G), Eq (b H)-    , Show (b F), Show (b G), Show (b H)-    , Arbitrary (b F)-    , Typeable b-    )-  => TestTree-laws-  = testGroup (show (typeRep (Proxy :: Proxy b)))-      [testProperty "naturality" $-        \b (FG (NatTransf fg)) ->-          let f = Just . fg-              t = maybeToList-          in (t . btraverse f) (b :: b F) === btraverse (t . f) (b :: b F)--      , testProperty "identity" $ \b ->-          btraverse Identity b === Identity (b :: b F)--      , testProperty "composition" $-          \b (FG (NatTransf fg)) (GH (NatTransf gh)) ->-            let f x = Just (fg x)-                g x = [gh x]-            in btraverse (Compose . fmap g . f) b ===-                 (Compose . fmap (btraverse g) . btraverse f) (b :: b F)-      ]

@@ -1,37 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-module Legacy.Spec.Wrapper (-    lawsMonoid-  )--where--import Data.Barbie (AllBF, Barbie(..), ProductBC)--import Test.Tasty(testGroup, TestTree)-import Test.Tasty.QuickCheck(Arbitrary(..), testProperty)--lawsMonoid-  :: forall b-  .  ( Arbitrary (b []), Eq (b []), Show (b [])-     , ProductBC b-     , AllBF Semigroup [] b-     , AllBF Monoid [] b-     )-  => TestTree-lawsMonoid-  = testGroup "Monoid laws"-      [ testProperty "neutral element" $ \b ->-          unwrap (Barbie b <> mempty) == b &&-          unwrap (mempty <> Barbie b) == b--      , testProperty "associativity" $ \b1 b2 b3 ->-          unwrap ((Barbie b1 <>  Barbie b2) <> Barbie b3) ==-          unwrap ( Barbie b1 <> (Barbie b2  <> Barbie b3))-      ]-  where-    unwrap = getBarbie :: Barbie b [] -> b []---instance Arbitrary (b f) => Arbitrary (Barbie b f) where-    arbitrary = Barbie <$> arbitrary

@@ -1,306 +0,0 @@-{-# LANGUAGE DeriveAnyClass       #-}-{-# LANGUAGE FlexibleContexts     #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE UndecidableInstances #-}-module Legacy.TestBarbies-  ( Void--  , Record0(..)-  , Record1(..)-  , Record3(..)--  , Record1S(..)-  , Record3S(..)--  , Ignore1(..)--  , Sum3(..)--  , CompositeRecord(..)-  , SumRec(..)-  , InfRec(..)--  , NestedF(..)--  , HKB(..)-  )--where--import Data.Barbie--import Data.Kind(Type)-import Data.Typeable-import GHC.Generics-import Test.Tasty.QuickCheck--------------------------------------------------------- Product Barbies-------------------------------------------------------data Record0 (f :: Type -> Type)-  = Record0-  deriving-    ( Generic, Typeable-    , Eq, Show-    )--instance FunctorB Record0-instance TraversableB Record0-instance ProductB Record0-instance ConstraintsB Record0-instance ProductBC Record0--instance Arbitrary (Record0 f) where arbitrary = pure Record0---data Record1 f-  = Record1 { rec1_f1 :: f Int }-  deriving (Generic, Typeable)---instance FunctorB Record1-instance TraversableB Record1-instance ProductB Record1-instance ConstraintsB Record1-instance ProductBC Record1--deriving instance AllBF Show f Record1 => Show (Record1 f)-deriving instance AllBF Eq   f Record1 => Eq   (Record1 f)--instance AllBF Arbitrary f Record1 => Arbitrary (Record1 f) where-  arbitrary = Record1 <$> arbitrary---data Record1S f-  = Record1S { rec1s_f1 :: !(f Int) }-  deriving (Generic, Typeable)---instance FunctorB Record1S-instance TraversableB Record1S-instance ProductB Record1S-instance ConstraintsB Record1S-instance ProductBC Record1S--deriving instance AllBF Show f Record1S => Show (Record1S f)-deriving instance AllBF Eq   f Record1S => Eq   (Record1S f)--instance AllBF Arbitrary f Record1S => Arbitrary (Record1S f) where-  arbitrary = Record1S <$> arbitrary---data Record3 f-  = Record3-      { rec3_f1 :: f Int-      , rec3_f2 :: f Bool-      , rec3_f3 :: f Char-      }-  deriving (Generic, Typeable)---instance FunctorB Record3-instance TraversableB Record3-instance ProductB Record3-instance ConstraintsB Record3-instance ProductBC Record3--deriving instance AllBF Show f Record3 => Show (Record3 f)-deriving instance AllBF Eq   f Record3 => Eq   (Record3 f)--instance AllBF Arbitrary f Record3 => Arbitrary (Record3 f) where-  arbitrary = Record3 <$> arbitrary <*> arbitrary <*> arbitrary--data Record3S f-  = Record3S-      { rec3s_f1 :: !(f Int)-      , rec3s_f2 :: !(f Bool)-      , rec3s_f3 :: !(f Char)-      }-  deriving (Generic, Typeable)---instance FunctorB Record3S-instance TraversableB Record3S-instance ProductB Record3S-instance ConstraintsB Record3S-instance ProductBC Record3S--deriving instance AllBF Show f Record3S => Show (Record3S f)-deriving instance AllBF Eq   f Record3S => Eq   (Record3S f)--instance AllBF Arbitrary f Record3S => Arbitrary (Record3S f) where-  arbitrary = Record3S <$> arbitrary <*> arbitrary <*> arbitrary---------------------------------------------------------- Bad products--------------------------------------------------------data Ignore1 (f :: Type -> Type)-  = Ignore1 { ign1_f1 :: Int }-  deriving (Generic, Typeable, Eq, Show)--instance FunctorB Ignore1-instance TraversableB Ignore1-instance ConstraintsB Ignore1--instance Arbitrary (Ignore1 f) where arbitrary = Ignore1 <$> arbitrary----------------------------------------------------------- Sums--------------------------------------------------------data Sum3 f-  = Sum3_0-  | Sum3_1 (f Int)-  | Sum3_2 (f Int) (f Bool)-  deriving (Generic, Typeable)--instance FunctorB Sum3-instance TraversableB Sum3-instance ConstraintsB Sum3--deriving instance AllBF Show f Sum3 => Show (Sum3 f)-deriving instance AllBF Eq   f Sum3 => Eq   (Sum3 f)--instance AllBF Arbitrary f Sum3 => Arbitrary (Sum3 f) where-  arbitrary-    = oneof-        [ pure Sum3_0-        , Sum3_1 <$> arbitrary-        , Sum3_2 <$> arbitrary <*> arbitrary-        ]---------------------------------------------------------- Composite and recursive--------------------------------------------------------data CompositeRecord f-  = CompositeRecord-      { crec_f1 :: f Int-      , crec_F2 :: f Bool-      , crec_f3 :: Record3 f-      , crec_f4 :: Record1 f-      }-  deriving (Generic, Typeable)--instance FunctorB CompositeRecord-instance TraversableB CompositeRecord-instance ProductB CompositeRecord-instance ConstraintsB CompositeRecord-instance ProductBC CompositeRecord--deriving instance AllBF Show f CompositeRecord => Show (CompositeRecord f)-deriving instance AllBF Eq   f CompositeRecord => Eq   (CompositeRecord f)--instance AllBF Arbitrary f CompositeRecord => Arbitrary (CompositeRecord f) where-  arbitrary-    = CompositeRecord <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary--data SumRec f-  = SumRec_0-  | SumRec_1 (f Int)-  | SumRec_2 (f Int) (SumRec f)-  deriving (Generic, Typeable)--instance FunctorB SumRec-instance TraversableB SumRec-instance ConstraintsB SumRec--deriving instance AllBF Show f SumRec => Show (SumRec f)-deriving instance AllBF Eq   f SumRec => Eq   (SumRec f)--instance AllBF Arbitrary f SumRec => Arbitrary (SumRec f) where-  arbitrary-    = oneof-        [ pure SumRec_0-        , SumRec_1 <$> arbitrary-        , SumRec_2 <$> arbitrary <*> arbitrary-        ]--data InfRec f-  = InfRec { ir_1 :: f Int, ir_2 :: InfRec f }-  deriving (Generic, Typeable)--instance FunctorB InfRec-instance TraversableB InfRec-instance ProductB InfRec-instance ConstraintsB InfRec-instance ProductBC InfRec--deriving instance AllBF Show f InfRec => Show (InfRec f)-deriving instance AllBF Eq   f InfRec => Eq   (InfRec f)---------------------------------------------------------- Nested under functors--------------------------------------------------------data NestedF f-  = NestedF-      { npf_1 :: f Int-      , npf_2 :: [Record3 f]-      , npf_3 :: Maybe (Sum3 f)-      , npf_4 :: Maybe (NestedF f)-      }-  deriving (Generic, Typeable)--instance FunctorB NestedF-instance TraversableB NestedF--deriving instance (Show (f Int), Show (Record3 f), Show (Sum3 f)) => Show (NestedF f)-deriving instance (Eq   (f Int), Eq   (Record3 f), Eq   (Sum3 f)) => Eq   (NestedF f)--instance (Arbitrary (f Int), AllBF Arbitrary f Record3, AllBF Arbitrary f Sum3) => Arbitrary (NestedF f) where-  arbitrary = NestedF <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary------------------------------------------------------------ Parametric barbies--------------------------------------------------------data ParB b (f :: Type -> Type)-  = ParB (b f)-  deriving (Generic, Typeable)--instance FunctorB b => FunctorB (ParB b)-instance TraversableB b => TraversableB (ParB b)-instance ProductB b => ProductB (ParB b)-instance ConstraintsB b => ConstraintsB (ParB b)-instance ProductBC b => ProductBC (ParB b)--data ParBH h b (f :: Type -> Type)-  = ParBH (h (b f))-  deriving (Generic, Typeable)--instance (Functor h, FunctorB b) => FunctorB (ParBH h b)-instance (Traversable h, TraversableB b) => TraversableB (ParBH h b)--data ParX a f-  = ParX (f a)-  deriving (Generic, Typeable)--instance FunctorB (ParX a)-instance TraversableB (ParX a)-instance ProductB (ParX a)-instance ConstraintsB (ParX a)-instance ProductBC (ParX a)----------------------------------------------------------- Higher-kinded barbies--------------------------------------------------------data HKB b-  = HKB-      { hkb1 :: b Maybe-      , khb2 :: b ([])-      }-  deriving (Generic, Typeable)--instance FunctorB HKB-instance TraversableB HKB-instance ProductB HKB-instance ConstraintsB HKB-instance ProductBC HKB

@@ -1,324 +0,0 @@-{-# OPTIONS_GHC -O0 #-}-{-# LANGUAGE DeriveAnyClass       #-}-{-# LANGUAGE FlexibleContexts     #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE UndecidableInstances #-}-module Legacy.TestBarbiesW-  ( Record1W(..)-  , Record3W(..)--  , Record1WS(..)-  , Record3WS(..)--  , Sum3W(..)--  , CompositeRecordW(..)-  , SumRecW(..)-  , InfRecW(..)--  , NestedFW(..)-  )--where--import Data.Barbie-import Data.Barbie.Bare--import Data.Kind(Type)-import Data.Typeable-import GHC.Generics-import Test.Tasty.QuickCheck--------------------------------------------------------- Product Barbies-------------------------------------------------------data Record1W t f-  = Record1W { rec1w_f1 :: Wear t f Int }-  deriving (Generic, Typeable)---instance FunctorB (Record1W Bare)-instance FunctorB (Record1W Covered)-instance TraversableB (Record1W Covered)-instance ProductB (Record1W Covered)-instance ConstraintsB (Record1W Bare)-instance ConstraintsB (Record1W Covered)-instance ProductBC (Record1W Covered)-instance BareB Record1W---deriving instance AllB  Show   (Record1W Bare)    => Show (Record1W Bare f)-deriving instance AllB  Eq     (Record1W Bare)    => Eq   (Record1W Bare f)-deriving instance AllBF Show f (Record1W Covered) => Show (Record1W Covered f)-deriving instance AllBF Eq   f (Record1W Covered) => Eq   (Record1W Covered f)--instance AllBF Arbitrary f (Record1W Covered) => Arbitrary (Record1W Covered f) where-  arbitrary = Record1W <$> arbitrary---data Record1WS t f-  = Record1WS { rec1ws_f1 :: !(Wear t f Int) }-  deriving (Generic, Typeable)---instance FunctorB (Record1WS Bare)-instance FunctorB (Record1WS Covered)-instance TraversableB (Record1WS Covered)-instance ProductB (Record1WS Covered)-instance ConstraintsB (Record1WS Bare)-instance ConstraintsB (Record1WS Covered)-instance ProductBC (Record1WS Covered)-instance BareB Record1WS---deriving instance AllB  Show   (Record1WS Bare)    => Show (Record1WS Bare f)-deriving instance AllB  Eq     (Record1WS Bare)    => Eq   (Record1WS Bare f)-deriving instance AllBF Show f (Record1WS Covered) => Show (Record1WS Covered f)-deriving instance AllBF Eq   f (Record1WS Covered) => Eq   (Record1WS Covered f)--instance AllBF Arbitrary f (Record1WS Covered) => Arbitrary (Record1WS Covered f) where-  arbitrary = Record1WS <$> arbitrary--data Record3W t f-  = Record3W-      { rec3w_f1 :: Wear t f Int-      , rec3w_f2 :: Wear t f Bool-      , rec3w_f3 :: Wear t f Char-      }-  deriving (Generic, Typeable)---instance FunctorB (Record3W Bare)-instance FunctorB (Record3W Covered)-instance TraversableB (Record3W Covered)-instance ProductB (Record3W Covered)-instance ConstraintsB (Record3W Bare)-instance ConstraintsB (Record3W Covered)-instance ProductBC (Record3W Covered)--instance BareB Record3W--deriving instance AllB  Show   (Record3W Bare)    => Show (Record3W Bare f)-deriving instance AllB  Eq     (Record3W Bare)    => Eq   (Record3W Bare f)-deriving instance AllBF Show f (Record3W Covered) => Show (Record3W Covered f)-deriving instance AllBF Eq   f (Record3W Covered) => Eq   (Record3W Covered f)--instance AllBF Arbitrary f (Record3W Covered) => Arbitrary (Record3W Covered f) where-  arbitrary = Record3W <$> arbitrary <*> arbitrary <*> arbitrary---data Record3WS t f-  = Record3WS-      { rec3ws_f1 :: !(Wear t f Int)-      , rec3ws_f2 :: !(Wear t f Bool)-      , rec3ws_f3 :: !(Wear t f Char)-      }-  deriving (Generic, Typeable)---instance FunctorB (Record3WS Bare)-instance FunctorB (Record3WS Covered)-instance TraversableB (Record3WS Covered)-instance ProductB (Record3WS Covered)-instance ConstraintsB (Record3WS Bare)-instance ConstraintsB (Record3WS Covered)-instance ProductBC (Record3WS Covered)-instance BareB Record3WS--deriving instance AllB  Show   (Record3WS Bare)    => Show (Record3WS Bare f)-deriving instance AllB  Eq     (Record3WS Bare)    => Eq   (Record3WS Bare f)-deriving instance AllBF Show f (Record3WS Covered) => Show (Record3WS Covered f)-deriving instance AllBF Eq   f (Record3WS Covered) => Eq   (Record3WS Covered f)--instance AllBF Arbitrary f (Record3WS Covered) => Arbitrary (Record3WS Covered f) where-  arbitrary = Record3WS <$> arbitrary <*> arbitrary <*> arbitrary---------------------------------------------------------- Sum Barbies-------------------------------------------------------data Sum3W t f-  = Sum3W_0-  | Sum3W_1 (Wear t f Int)-  | Sum3W_2 (Wear t f Int) (Wear t f Bool)-  deriving (Generic, Typeable)--instance FunctorB (Sum3W Bare)-instance FunctorB (Sum3W Covered)-instance TraversableB (Sum3W Covered)-instance ConstraintsB (Sum3W Bare)-instance ConstraintsB (Sum3W Covered)-instance BareB Sum3W--deriving instance AllB  Show   (Sum3W Bare)    => Show (Sum3W Bare f)-deriving instance AllB  Eq     (Sum3W Bare)    => Eq   (Sum3W Bare f)-deriving instance AllBF Show f (Sum3W Covered) => Show (Sum3W Covered f)-deriving instance AllBF Eq   f (Sum3W Covered) => Eq   (Sum3W Covered f)--instance AllBF Arbitrary f (Sum3W Covered) => Arbitrary (Sum3W Covered f) where-  arbitrary-    = oneof-        [ pure Sum3W_0-        , Sum3W_1 <$> arbitrary-        , Sum3W_2 <$> arbitrary <*> arbitrary-        ]----------------------------------------------------------- Composite and recursive---------------------------------------------------------data CompositeRecordW t f-  = CompositeRecordW-      { crecw_f1 :: Wear t f Int-      , crecw_F2 :: Wear t f Bool-      , crecw_f3 :: Record3W t f-      , crecw_f4 :: Record1W t f-      }-  deriving (Generic, Typeable)--instance FunctorB (CompositeRecordW Bare)-instance FunctorB (CompositeRecordW Covered)-instance TraversableB (CompositeRecordW Covered)-instance ProductB (CompositeRecordW Covered)-instance ConstraintsB (CompositeRecordW Bare)-instance ConstraintsB (CompositeRecordW Covered)-instance ProductBC (CompositeRecordW Covered)-instance BareB CompositeRecordW--deriving instance AllB  Show   (CompositeRecordW Bare)    => Show (CompositeRecordW Bare f)-deriving instance AllB  Eq     (CompositeRecordW Bare)    => Eq   (CompositeRecordW Bare f)-deriving instance AllBF Show f (CompositeRecordW Covered) => Show (CompositeRecordW Covered f)-deriving instance AllBF Eq   f (CompositeRecordW Covered) => Eq   (CompositeRecordW Covered f)--instance AllBF Arbitrary f (CompositeRecordW Covered) => Arbitrary (CompositeRecordW Covered f) where-  arbitrary-    = CompositeRecordW <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary---data SumRecW t f-  = SumRecW_0-  | SumRecW_1 (Wear t f Int)-  | SumRecW_2 (Wear t f Int) (SumRecW t f)-  deriving (Generic, Typeable)--instance FunctorB (SumRecW Bare)-instance FunctorB (SumRecW Covered)-instance TraversableB (SumRecW Covered)-instance ConstraintsB (SumRecW Bare)-instance ConstraintsB (SumRecW Covered)-instance BareB SumRecW--deriving instance AllB  Show   (SumRecW Bare)    => Show (SumRecW Bare f)-deriving instance AllB  Eq     (SumRecW Bare)    => Eq   (SumRecW Bare f)-deriving instance AllBF Show f (SumRecW Covered) => Show (SumRecW Covered f)-deriving instance AllBF Eq   f (SumRecW Covered) => Eq   (SumRecW Covered f)--instance AllBF Arbitrary f (SumRecW Covered) => Arbitrary (SumRecW Covered f) where-  arbitrary-    = oneof-        [ pure SumRecW_0-        , SumRecW_1 <$> arbitrary-        , SumRecW_2 <$> arbitrary <*> arbitrary-        ]--data InfRecW t f-  = InfRecW { irw_1 :: Wear t f Int, irw_2 :: InfRecW t f }-  deriving (Generic, Typeable)---instance FunctorB (InfRecW Bare)-instance FunctorB (InfRecW Covered)-instance TraversableB (InfRecW Covered)-instance ProductB (InfRecW Covered)-instance ConstraintsB (InfRecW Bare)-instance ConstraintsB (InfRecW Covered)-instance ProductBC (InfRecW Covered)-instance BareB InfRecW--deriving instance AllB  Show   (InfRecW Bare)    => Show (InfRecW Bare f)-deriving instance AllB  Eq     (InfRecW Bare)    => Eq   (InfRecW Bare f)-deriving instance AllBF Show f (InfRecW Covered) => Show (InfRecW Covered f)-deriving instance AllBF Eq   f (InfRecW Covered) => Eq   (InfRecW Covered f)---------------------------------------------------------- Nested under functors--------------------------------------------------------data NestedFW t f-  = NestedFW-      { npfw_1 :: Wear t f Int-      , npfw_2 :: [Record3W t f]-      , npfw_3 :: Maybe (Sum3W t f)-      , npfw_4 :: Maybe (NestedFW t f)-      }-  deriving (Generic, Typeable)----instance FunctorB (NestedFW Bare)-instance FunctorB (NestedFW Covered)-instance TraversableB (NestedFW Covered)-instance BareB NestedFW--- instance ConstraintsB (NestedFW Bare)--- instance ConstraintsB (NestedFW Covered)--deriving instance Show (NestedFW Bare f)-deriving instance Eq   (NestedFW Bare f)-deriving instance (Show (f Int), Show (Record3W Covered f), Show (Sum3W Covered f)) => Show (NestedFW Covered f)-deriving instance (Eq   (f Int), Eq   (Record3W Covered f), Eq   (Sum3W Covered f)) => Eq   (NestedFW Covered f)--instance (Arbitrary (f Int), Arbitrary (f Bool), Arbitrary (f Char)) => Arbitrary (NestedFW Covered f) where-  arbitrary = NestedFW <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary----------------------------------------------------------- Parametric barbies--------------------------------------------------------data ParBW b t (f :: Type -> Type)-  = ParBW (b t f)-  deriving (Generic, Typeable)--instance FunctorB (b t) => FunctorB (ParBW b t)-instance TraversableB (b t) => TraversableB (ParBW b t)-instance ProductB (b t) => ProductB (ParBW b t)-instance BareB b => BareB (ParBW b)---- XXX GHC currently rejects deriving this one since it--- gets stuck on the TagSelf type family and can't see this--- is an "Other" case. It looks like a bug to me, since it--- seems to have enough information to decide that it is the--- `Other` case that should be picked (or in any case, I don't--- quite see why this is not an issue when `b` doesn't have the--- extra type parameter.-instance ConstraintsB (b t) => ConstraintsB (ParBW b t) where-  type AllB c (ParBW b t) = AllB c (b t)-  baddDicts (ParBW btf) = ParBW (baddDicts btf)---- XXX SEE NOTE ON ConstraintsB-instance ProductBC (b t) => ProductBC (ParBW b t) where-  bdicts = ParBW bdicts--data ParBHW h b t (f :: Type -> Type)-  = ParBHW (h (b t f))-  deriving (Generic, Typeable)--instance (Functor h, FunctorB (b t)) => FunctorB (ParBHW h b t)-instance (Traversable h, TraversableB (b t)) => TraversableB (ParBHW h b t)-instance (Functor h, BareB b) => BareB (ParBHW h b)--data ParXW a t f-  = ParXW (Wear t f a)-  deriving (Generic, Typeable)--instance FunctorB (ParXW a Bare)-instance FunctorB (ParXW a Covered)-instance TraversableB (ParXW a Covered)-instance ProductB (ParXW a Covered)-instance ConstraintsB (ParXW a Covered)-instance ProductBC (ParXW a Covered)