diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,7 +1,11 @@ # Changelog for barbies +## 0.1.3.1 + - Fix issue on Barbie-types with strictness annotations. + ## 0.1.3.0 - - Use both `Monoid` and `Semigroup` as constraints for the `Monoid` instance, so that this works with ghc 8.0 to 8.4 (Fraser Murray) + - Use both `Monoid` and `Semigroup` as constraints for the `Monoid` instance, + so that this works with ghc 8.0 to 8.4 (Fraser Murray) ## 0.1.2.0 - Use `Monoid` and not `Semigroup` as constraints for the `Monoid` instance diff --git a/barbies.cabal b/barbies.cabal --- a/barbies.cabal +++ b/barbies.cabal @@ -1,5 +1,5 @@ name: barbies -version: 0.1.3.0 +version: 0.1.3.1 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 diff --git a/src/Data/Barbie/Internal/Generics.hs b/src/Data/Barbie/Internal/Generics.hs --- a/src/Data/Barbie/Internal/Generics.hs +++ b/src/Data/Barbie/Internal/Generics.hs @@ -12,7 +12,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module Data.Barbie.Internal.Generics - ( Target + ( Target (..) , unsafeTargetBarbie , unsafeUntarget , unsafeTarget @@ -42,6 +42,7 @@ -- if 'f' is applied in 'T', which are all the interesting -- cases! data Target (f :: * -> *) a + = Target (f a) unsafeTargetBarbie :: forall t b f . b f -> b (Target t) unsafeTargetBarbie = unsafeCoerce diff --git a/test/Barbies.hs b/test/Barbies.hs --- a/test/Barbies.hs +++ b/test/Barbies.hs @@ -13,9 +13,15 @@ , Record1(..) , Record3(..) + , Record1S(..) + , Record3S(..) + , Record1W(..) , Record3W(..) + , Record1WS(..) + , Record3WS(..) + , Ignore1(..) , Sum3(..) @@ -94,6 +100,24 @@ 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 ProofB Record1S + +deriving instance ConstraintsOf Show f Record1S => Show (Record1S f) +deriving instance ConstraintsOf Eq f Record1S => Eq (Record1S f) + +instance ConstraintsOf Arbitrary f Record1S => Arbitrary (Record1S f) where + arbitrary = Record1S <$> arbitrary + + data Record1W f = Record1W { rec1w_f1 :: Wear f Int } deriving (Generic, Typeable) @@ -114,7 +138,26 @@ arbitrary = Record1W <$> arbitrary +data Record1WS f + = Record1WS { rec1ws_f1 :: !(Wear f Int) } + deriving (Generic, Typeable) + +instance FunctorB Record1WS +instance TraversableB Record1WS +instance ProductB Record1WS +instance ConstraintsB Record1WS +instance ProofB Record1WS +instance BareB Record1WS + + +deriving instance ConstraintsOf Show f Record1WS => Show (Record1WS f) +deriving instance ConstraintsOf Eq f Record1WS => Eq (Record1WS f) + +instance ConstraintsOf Arbitrary f Record1WS => Arbitrary (Record1WS f) where + arbitrary = Record1WS <$> arbitrary + + data Record3 f = Record3 { rec3_f1 :: f Int @@ -136,7 +179,28 @@ instance ConstraintsOf 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 ProofB Record3S + +deriving instance ConstraintsOf Show f Record3S => Show (Record3S f) +deriving instance ConstraintsOf Eq f Record3S => Eq (Record3S f) + +instance ConstraintsOf Arbitrary f Record3S => Arbitrary (Record3S f) where + arbitrary = Record3S <$> arbitrary <*> arbitrary <*> arbitrary + + data Record3W f = Record3W { rec3w_f1 :: Wear f Int @@ -159,6 +223,31 @@ instance ConstraintsOf Arbitrary f Record3W => Arbitrary (Record3W f) where arbitrary = Record3W <$> arbitrary <*> arbitrary <*> arbitrary + + +data Record3WS f + = Record3WS + { rec3ws_f1 :: !(Wear f Int) + , rec3ws_f2 :: !(Wear f Bool) + , rec3ws_f3 :: !(Wear f Char) + } + deriving (Generic, Typeable) + + +instance FunctorB Record3WS +instance TraversableB Record3WS +instance ProductB Record3WS +instance ConstraintsB Record3WS +instance ProofB Record3WS + +instance BareB Record3WS + +deriving instance ConstraintsOf Show f Record3WS => Show (Record3WS f) +deriving instance ConstraintsOf Eq f Record3WS => Eq (Record3WS f) + +instance ConstraintsOf Arbitrary f Record3WS => Arbitrary (Record3WS f) where + arbitrary = Record3WS <$> arbitrary <*> arbitrary <*> arbitrary + ----------------------------------------------------- diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -20,9 +20,15 @@ , Functor.laws @Record1 , Functor.laws @Record3 + , Functor.laws @Record1S + , Functor.laws @Record3S + , Functor.laws @Record1W , Functor.laws @Record3W + , Functor.laws @Record1WS + , Functor.laws @Record3WS + , Functor.laws @Ignore1 , Functor.laws @Sum3 @@ -42,9 +48,15 @@ , Traversable.laws @Record1 , Traversable.laws @Record3 + , Traversable.laws @Record1S + , Traversable.laws @Record3S + , Traversable.laws @Record1W , Traversable.laws @Record3W + , Traversable.laws @Record1WS + , Traversable.laws @Record3WS + , Traversable.laws @Ignore1 , Traversable.laws @Sum3 @@ -65,9 +77,15 @@ , Product.laws @Record3 , Product.laws @CompositeRecord + , Product.laws @Record1S + , Product.laws @Record3S + , Product.laws @Record1W , Product.laws @Record3W , Product.laws @CompositeRecordW + + , Product.laws @Record1WS + , Product.laws @Record3WS ] , testGroup "Uniq Laws" @@ -76,9 +94,15 @@ , Product.uniqLaws @Record3 , Product.uniqLaws @CompositeRecord + , Product.uniqLaws @Record1S + , Product.uniqLaws @Record3S + , Product.uniqLaws @Record1W , Product.uniqLaws @Record3W , Product.uniqLaws @CompositeRecordW + + , Product.uniqLaws @Record1WS + , Product.uniqLaws @Record3WS ] , testGroup "adjProof projection" @@ -86,9 +110,14 @@ , Constraints.lawAdjProofPrj @Record1 , Constraints.lawAdjProofPrj @Record3 + , Constraints.lawAdjProofPrj @Record1S + , Constraints.lawAdjProofPrj @Record3S + , Constraints.lawAdjProofPrj @Record1W , Constraints.lawAdjProofPrj @Record3W + , Constraints.lawAdjProofPrj @Record1WS + , Constraints.lawAdjProofPrj @Record3WS , Constraints.lawAdjProofPrj @Ignore1 @@ -108,21 +137,38 @@ , Constraints.lawProofEquivPrj @Record3 , Constraints.lawProofEquivPrj @CompositeRecord + , Constraints.lawProofEquivPrj @Record1S + , Constraints.lawProofEquivPrj @Record3S + , Constraints.lawProofEquivPrj @Record1W , Constraints.lawProofEquivPrj @Record3W , Constraints.lawProofEquivPrj @CompositeRecordW + + , Constraints.lawProofEquivPrj @Record1WS + , Constraints.lawProofEquivPrj @Record3WS ] , 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 @Record3 + [ Wrapper.lawsMonoid @Record1 + , Wrapper.lawsMonoid @Record1W + + , Wrapper.lawsMonoid @Record1S + , Wrapper.lawsMonoid @Record1WS + + , Wrapper.lawsMonoid @Record3 , Wrapper.lawsMonoid @Record3W + + , Wrapper.lawsMonoid @Record3S + , Wrapper.lawsMonoid @Record3WS ] ]