these 0.8 → 0.8.1
raw patch · 5 files changed
+114/−49 lines, 5 filesdep +taggeddep ~hashabledep ~semigroups
Dependencies added: tagged
Dependency ranges changed: hashable, semigroups
Files
- CHANGELOG.md +5/−0
- Data/Align.hs +33/−0
- Data/These/Combinators.hs +3/−3
- test/Tests.hs +67/−41
- these.cabal +6/−5
CHANGELOG.md view
@@ -1,3 +1,8 @@+# 0.8.1++- Add `Semialign` `Tree`, `Tagged`, `(->) e`; `Align` `Compose` and `Proxy` instances+- Allow `semigroups-0.19` and `hashable-1.3`+ # 0.8.0 - Split `align` and `alignWith` into own class: `Semialign`.
Data/Align.hs view
@@ -39,13 +39,16 @@ import Data.HashMap.Strict (HashMap) import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (catMaybes)+import Data.Proxy (Proxy (..)) import Data.Semigroup (Semigroup (..)) import Data.Sequence (Seq)+import Data.Tagged (Tagged (..)) import Data.Vector.Fusion.Stream.Monadic (Step (..), Stream (..)) import Data.Vector.Generic (Vector, empty, stream, unstream) import qualified Data.HashMap.Strict as HashMap import qualified Data.Sequence as Seq+import qualified Data.Tree as T import qualified Data.Vector as V import qualified Data.Vector.Fusion.Stream.Monadic as Stream import qualified Data.Vector.Generic as VG (foldr, fromList)@@ -161,6 +164,11 @@ -- Instances ------------------------------------------------------------------------------- +-- | @since 0.8.1+instance Semialign ((->) e) where+ align f g x = These (f x) (g x)+ alignWith h f g x = h (These (f x) (g x))+ instance Align Maybe where nil = Nothing @@ -214,6 +222,10 @@ yn = Seq.length ys fc x y = f (These x y) +-- | @since 0.8.1+instance Semialign T.Tree where+ align (T.Node x xs) (T.Node y ys) = T.Node (These x y) (alignWith (these (fmap This) (fmap That) align) xs ys)+ instance (Ord k) => Align (Map k) where nil = Map.empty @@ -257,6 +269,14 @@ align (Pair a b) (Pair c d) = Pair (align a c) (align b d) alignWith f (Pair a b) (Pair c d) = Pair (alignWith f a c) (alignWith f b d) +-- | @since 0.8.1+instance (Align f, Semialign g) => Align (Compose f g) where+ nil = Compose nil++-- | @since 0.8.1+instance (Semialign f, Semialign g) => Semialign (Compose f g) where+ align (Compose x) (Compose y) = Compose (alignWith (these (fmap This) (fmap That) align) x y)+ -- Based on the Data.Vector.Fusion.Stream.Monadic zipWith implementation instance Monad m => Align (Stream m) where nil = Stream.empty@@ -314,6 +334,19 @@ align m n = HashMap.unionWith merge (HashMap.map This m) (HashMap.map That n) where merge (This a) (That b) = These a b merge _ _ = oops "Align HashMap: merge"++-- | @since 0.8.1+instance Semialign (Tagged b) where+ alignWith f (Tagged x) (Tagged y) = Tagged (f (These x y))++-- | @since 0.8.1+instance Semialign Proxy where+ alignWith _ _ _ = Proxy+ align _ _ = Proxy++-- | @since 0.8.1+instance Align Proxy where+ nil = Proxy -- | Align two structures and combine with 'mappend'. --
Data/These/Combinators.hs view
@@ -96,7 +96,7 @@ bimapThese :: (a -> c) -> (b -> d) -> These a b -> These c d bimapThese = bimap --- | @'mapThis' = 'Control.Lens.over' 'here'@+-- | @'mapHere' = 'Control.Lens.over' 'here'@ mapHere :: (a -> c) -> These a b -> These c b mapHere = first @@ -133,7 +133,7 @@ assocThese :: These (These a b) c -> These a (These b c) assocThese = assoc --- | 'These is associative. See 'assocThese'.+-- | 'These' is associative. See 'assocThese'. -- -- @since 0.8 unassocThese :: These a (These b c) -> These (These a b) c@@ -227,7 +227,7 @@ -- | @'hasHere' = 'isJust' . 'justHere'@ hasHere = isJust . justHere --- | @'hasThere' = 'isJust' . 'jusThere'@+-- | @'hasThere' = 'isJust' . 'justThere'@ hasThere = isJust . justThere -------------------------------------------------------------------------------
test/Tests.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MonoLocalBinds #-}@@ -21,6 +22,7 @@ import Data.HashMap.Strict (HashMap) import Data.IntMap (IntMap) import Data.List (nub)+import Data.List.NonEmpty (NonEmpty) import Data.Map (Map) import Data.Maybe (mapMaybe) import Data.Semigroup (Semigroup (..))@@ -39,6 +41,7 @@ import qualified Data.Functor.Product as P import qualified Data.IntMap as IntMap import qualified Data.Map as Map+import qualified Data.Tree as T import qualified Data.Vector as V import qualified Test.Tasty.QuickCheck as QC @@ -92,20 +95,24 @@ alignProps :: TestTree alignProps = testGroup "Align"- [ dataAlignLaws "[]" (Proxy :: Proxy [])- , dataAlignLaws "HashMap String" (Proxy :: Proxy (HashMap String))- , dataAlignLaws "IntMap" (Proxy :: Proxy IntMap)- , dataAlignLaws "Map Char" (Proxy :: Proxy (Map Char))- , dataAlignLaws "Maybe" (Proxy :: Proxy Maybe)- , dataAlignLaws "Product [] Maybe" (Proxy :: Proxy (P.Product [] Maybe))- , dataAlignLaws "Seq" (Proxy :: Proxy Seq)- , dataAlignLaws "Vector" (Proxy :: Proxy V.Vector)- , dataAlignLaws "ZipList" (Proxy :: Proxy ZipList)- -- , dataAlignLaws "WrongMap" (Proxy :: Proxy (WrongMap Char))+ [ dataAlignLaws "[]" (CAlign :: C [])+ , dataAlignLaws "HashMap String" (CAlign :: C (HashMap String))+ , dataAlignLaws "IntMap" (CAlign :: C IntMap)+ , dataAlignLaws "Map Char" (CAlign :: C (Map Char))+ , dataAlignLaws "Maybe" (CAlign :: C Maybe)+ , dataAlignLaws "Product [] Maybe" (CAlign :: C (P.Product [] Maybe))+ , dataAlignLaws "Compose [] Maybe" (CAlign :: C (Compose [] Maybe))+ , dataAlignLaws "Seq" (CAlign :: C Seq)+ , dataAlignLaws "Vector" (CAlign :: C V.Vector)+ , dataAlignLaws "ZipList" (CAlign :: C ZipList)+ , dataAlignLaws "Tree" (CSemialign :: C T.Tree)+ , dataAlignLaws "NonEmpty" (CSemialign :: C NonEmpty)++ -- , dataAlignLaws "WrongMap" (CAlign :: C (WrongMap Char)) -- weird objects:- -- , dataAlignLaws "Const String" (Proxy :: Proxy (Const String))- , dataAlignLaws "R" (Proxy :: Proxy R)- -- , dataAlignLaws "Weirdmap" (Proxy :: Proxy (WeirdMap Char))+ -- , dataAlignLaws "Const String" (CAlign :: C (Const String))+ , dataAlignLaws "R" (CAlign :: C R)+ -- , dataAlignLaws "Weirdmap" (CAlign :: C (WeirdMap Char)) ] alignWithKeyProps :: TestTree@@ -180,6 +187,10 @@ -- Data.Align +data C f where+ CSemialign :: Semialign f => C f+ CAlign :: Align f => C f+ -- (\`align` nil) = fmap This -- (nil \`align`) = fmap That -- join align = fmap (join These)@@ -187,52 +198,67 @@ -- alignWith f a b = f \<$> align a b -- -- We also require a sixth property, when f is Foldable.-dataAlignLaws :: forall (f :: * -> *). ( Align f, Foldable f- , Eq (f (These Int Int))- , Show (f (These Int Int))- , Eq (f (These Int (These Int Int)))- , Show (f (These Int (These Int Int)))- , CoArbitrary (These Int Int)- , Arbitrary (f Int)- , Eq (f Int)- , Show (f Int))- => String- -> Proxy f- -> TestTree-dataAlignLaws name _ = testGroup ("Data.Align laws: " <> name)- [ QC.testProperty "right identity" rightIdentityProp- , QC.testProperty "left identity" leftIdentityProp- , QC.testProperty "join" joinProp- , QC.testProperty "bimap" bimapProp- , QC.testProperty "alignWith" alignWithProp- , QC.testProperty "assoc" assocProp- , QC.testProperty "alignToList" alignToListProp- ]+dataAlignLaws+ :: forall (f :: * -> *).+ ( Foldable f+ , Eq (f (These Int Int))+ , Show (f (These Int Int))+ , Eq (f (These Int (These Int Int)))+ , Show (f (These Int (These Int Int)))+ , CoArbitrary (These Int Int)+ , Arbitrary (f Int)+ , Eq (f Int)+ , Show (f Int)+ )+ => String+ -> C f+ -> TestTree+dataAlignLaws name p =+ testGroup ("Data.Align laws: " <> name) props where- rightIdentityProp :: f Int -> Property+ props = case p of+ CSemialign -> semialignProps+ CAlign -> semialignProps ++ alignLaws++ semialignProps :: Semialign f => [TestTree]+ semialignProps =+ [ QC.testProperty "join" joinProp+ , QC.testProperty "bimap" bimapProp+ , QC.testProperty "alignWith" alignWithProp+ , QC.testProperty "assoc" assocProp+ , QC.testProperty "alignToList" alignToListProp+ ]++ alignLaws :: Align f => [TestTree]+ alignLaws =+ [ QC.testProperty "right identity" rightIdentityProp+ , QC.testProperty "left identity" leftIdentityProp+ ]++ rightIdentityProp :: Align f => f Int -> Property rightIdentityProp xs = (xs `align` (nil :: f Int)) === fmap This xs - leftIdentityProp :: f Int -> Property+ leftIdentityProp :: Align f => f Int -> Property leftIdentityProp xs = ((nil :: f Int) `align` xs) === fmap That xs - joinProp :: f Int -> Property+ joinProp :: Semialign f => f Int -> Property joinProp xs = join align xs === fmap (join These) xs - bimapProp :: f Int -> f Int -> Fun Int Int -> Fun Int Int -> Property+ bimapProp :: Semialign f => f Int -> f Int -> Fun Int Int -> Fun Int Int -> Property bimapProp xs ys (Fun _ f) (Fun _ g) = align (f <$> xs) (g <$> ys) === (bimap f g <$> align xs ys) - alignWithProp :: f Int -> f Int -> Fun (These Int Int) Int -> Property+ alignWithProp :: Semialign f => f Int -> f Int -> Fun (These Int Int) Int -> Property alignWithProp xs ys (Fun _ f) = alignWith f xs ys === (f <$> align xs ys) - assocProp :: f Int -> f Int -> f Int -> Property+ assocProp :: Semialign f => f Int -> f Int -> f Int -> Property assocProp xs ys zs = lhs === fmap assocThese rhs where rhs = (xs `align` ys) `align` zs lhs = xs `align` (ys `align` zs) - alignToListProp :: f Int -> f Int -> Property+ alignToListProp :: Semialign f => f Int -> f Int -> Property alignToListProp xs ys = toList xs === toListOf (folded . here) xys .&&.
these.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: these-version: 0.8+version: 0.8.1 synopsis: An either-or-both data type & a generalized 'zip with padding' typeclass @@ -31,7 +31,7 @@ For a dependency light version, check <https://hackage.haskell.org/package/data-or> package. tested-with:- ghc ==7.4.2 || ==7.6.3 || ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.3+ ghc ==7.4.2 || ==7.6.3 || ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.4 source-repository head type: git@@ -68,10 +68,11 @@ , base-compat >=0.10.5 && <0.11 , bifunctors >=5.5.3 && <5.6 , data-default-class >=0.1.2.0 && <0.2- , hashable >=1.2.7.0 && <1.3+ , hashable >=1.2.7.0 && <1.4 , keys >=3.12.1 && <3.13 , lens >=4.17 && <4.18- , QuickCheck >=2.12.6.1 && <2.13+ , tagged >=0.8.6 && <0.9+ , QuickCheck >=2.12.6.1 && <2.14 , semigroupoids >=5.3.1 && <5.4 , transformers-compat >=0.6.2 && <0.7 , unordered-containers >=0.2.8.0 && <0.3@@ -82,7 +83,7 @@ build-depends: ghc-prim if !impl(ghc >=8.0)- build-depends: semigroups >=0.18.5 && <0.19+ build-depends: semigroups >=0.18.5 && <0.20 -- Ensure Data.Functor.Classes is always available if impl(ghc >=7.10)