semialign 1 → 1.1
raw patch · 6 files changed
+237/−128 lines, 6 filesdep ~basedep ~these
Dependency ranges changed: base, these
Files
- CHANGELOG.md +27/−0
- semialign.cabal +13/−4
- src/Data/Align.hs +1/−1
- src/Data/Semialign.hs +5/−1
- src/Data/Semialign/Internal.hs +183/−115
- src/Data/Zip.hs +8/−7
CHANGELOG.md view
@@ -1,3 +1,30 @@+# 1.1++- Split `Semialign` into `Semialign` and `Zip`.+- Rename old `Zip` into `Repeat`+- i.e. current main hierarchy is+- Remove `malign`, use `salign` or `alignWith mappend` where `Monoid` is necessary.+- Add `Option` instances++```haskell+instance Functor f => Semialign f where+ alignWith :: (These a b -> c) -> f a -> f b -> f c++instance Semialign f => Align f where+ nil :: f a++instance Semialign f => Zip f where+ zipWith :: (a -> b -> c) -> f a -> f b -> f c++instance Zip f => Repeat f where+ repeat :: a -> f a+```++This biased choice, that `Semialign` is a super-class of `Zip` is motivated by the fact that+- There's no `Semialign`-like class anywhere else, yet+- `Zip` and `Repeat` are `Apply` (from `semigroupoids`) and `Applicative` with slightly more laws. I+ If you need only `Repeat` class, and your type isn't `Aling`able, maybe using `Applicative` is enough?+ # 1 Split out of `these` package.
semialign.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: semialign-version: 1+version: 1.1 synopsis: Align and Zip type-classes from the common Semialign ancestor. @@ -21,7 +21,16 @@ forming lattice-like structure. 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.5 || ==8.8.1+ GHC ==7.4.2+ || ==7.6.3+ || ==7.8.4+ || ==7.10.3+ || ==8.0.2+ || ==8.2.2+ || ==8.4.4+ || ==8.6.5+ || ==8.8.1+ , GHCJS ==8.4 source-repository head type: git@@ -50,7 +59,7 @@ -- ghc boot libs build-depends:- base >=4.5.1.0 && <4.13+ base >=4.5.1.0 && <4.14 , containers >=0.4.2.1 && <0.7 , transformers >=0.3.0.0 && <0.6 @@ -59,7 +68,7 @@ -- other dependencies build-depends:- base-compat >=0.10.5 && <0.11+ base-compat >=0.10.5 && <0.12 , hashable >=1.2.7.0 && <1.4 , tagged >=0.8.6 && <0.9 , unordered-containers >=0.2.8.0 && <0.3
src/Data/Align.hs view
@@ -9,7 +9,7 @@ Align (..), Unalign (..), -- * Specialized aligns- malign, salign, padZip, padZipWith,+ salign, padZip, padZipWith, lpadZip, lpadZipWith, rpadZip, rpadZipWith, alignVectorWith,
src/Data/Semialign.hs view
@@ -1,14 +1,18 @@ {-# LANGUAGE Trustworthy #-} -- | Zipping and aligning of functors with non-uniform shapes.+--+-- module Data.Semialign (+ -- * Classes Semialign (..), Align (..), Unalign (..), Zip (..),+ Repeat (..), Unzip (..), unzipDefault, -- * Specialized aligns- malign, salign, padZip, padZipWith,+ salign, padZip, padZipWith, lpadZip, lpadZipWith, rpadZip, rpadZipWith, alignVectorWith,
src/Data/Semialign/Internal.hs view
@@ -1,9 +1,11 @@-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE Trustworthy #-} module Data.Semialign.Internal where import Prelude ()-import Prelude.Compat hiding (unzip, zip, zipWith)+import Prelude.Compat hiding (repeat, unzip, zip, zipWith) import qualified Prelude.Compat as Prelude @@ -17,13 +19,13 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (catMaybes) import Data.Proxy (Proxy (..))-import Data.Semigroup (Semigroup (..))+import Data.Semigroup (Option (..), 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.HashMap.Strict as HM import qualified Data.List.NonEmpty as NE import qualified Data.Sequence as Seq import qualified Data.Tree as T@@ -66,10 +68,10 @@ oops = error . ("Data.Align: internal error: " ++) -- ----------------------------------------------------------------------------- | Functors supporting a 'zip' and 'align' operations that takes the--- intersection and union of non-uniform shapes.+-- | Functors supporting an 'align' operation that takes the union of+-- non-uniform shapes. ----- Minimal definition: either 'align' or 'alignWith' and either 'zip' or 'zipWith'.+-- Minimal definition: either 'align' or 'alignWith'. -- -- == Laws --@@ -87,56 +89,32 @@ -- -- @ -- join align ≡ fmap (join These)--- join zip ≡ fmap (join (,)) -- @ -- -- /Commutativity/ -- -- @ -- align x y ≡ swap \<$> align y x--- zip x y ≡ swap \<$> zip y x -- @ -- -- /Associativity/ -- -- @ -- align x (align y z) ≡ assoc \<$> align (align x y) z--- zip x (zip y z) ≡ assoc \<$> zip (zip x y) z -- @ ----- /Absorption/------ @--- fst \<$> zip xs (align xs ys) ≡ xs--- toThis \<$> align xs (zip xs ys) ≡ This \<$> xs--- where--- toThis (This a) = This a--- toThis (These a _) = This a--- toThis (That b) = That b--- @--- -- /With/ -- -- @ -- alignWith f a b ≡ f \<$> align a b--- zipWith f a b ≡ f \<$> zip a b -- @ -- -- /Functoriality/ -- -- @ -- align (f \<$> x) (g \<$> y) ≡ bimap f g \<$> align x y--- zip (f \<$> x) (g \<$> y) ≡ bimap f g \<$> zip x y -- @ ----- /Zippyness/------ @--- fmap fst (zip x x) ≡ x--- fmap snd (zip x x) ≡ x--- zip (fmap fst x) (fmap snd x) ≡ x--- @--- -- /Alignedness/, if @f@ is 'Foldable' -- -- @@@ -144,25 +122,16 @@ -- ≡ mapMaybe justHere (toList (align x y)) -- @ ----- /Distributivity/ ----- @--- align (zip xs ys) zs ≡ undistrThesePair \<$> zip (align xs zs) (align ys zs)--- distrPairThese \<$> zip (align xs ys) zs ≡ align (zip xs zs) (zip ys zs)--- zip (align xs ys) zs ≡ undistrPairThese \<$> align (zip xs zs) (zip ys zs)--- @------ /Note/, the following doesn't hold:+-- And an addition property if @f@ is 'Foldable',+-- which tries to enforce 'align'-feel:+-- neither values are duplicated nor lost. -- -- @--- distrThesePair \<$> align (zip xs ys) zs ≢ zip (align xs zs) (align ys zs)+-- toList x = toListOf (folded . here) (align x y)+-- = mapMaybe justHere (toList (align x y)) -- @ ----- when @xs = []@ and @ys = zs = [0]@, then--- the left hand side is "only" @[('That' 0, 'That' 0)]@,--- but the right hand side is @[('That' 0, 'These' 0 0)]@.------ class Functor f => Semialign f where -- | Analogous to @'zip'@, combines two structures by taking the union of -- their shapes and using @'These'@ to hold the elements.@@ -174,18 +143,8 @@ alignWith :: (These a b -> c) -> f a -> f b -> f c alignWith f a b = f <$> align a b - -- | Combines to structures by taking the intersection of their shapes- -- and using pair to hold the elements.- zip :: f a -> f b -> f (a, b)- zip = zipWith (,)- --- -- | Combines to structures by taking the intersection of their shapes- -- and combining the elements with the given function.- zipWith :: (a -> b -> c) -> f a -> f b -> f c- zipWith f a b = uncurry f <$> zip a b- #if __GLASGOW_HASKELL__ >= 707- {-# MINIMAL (align | alignWith), (zip | zipWith) #-}+ {-# MINIMAL (align | alignWith) #-} #endif -- | A unit of 'align'.@@ -235,17 +194,106 @@ #endif --- | A unit of 'zip'.+-- | Functors supporting a 'zip' operation that takes the intersection of+-- non-uniform shapes. --+-- Minimal definition: either 'zip' or 'zipWith'.+--+-- /Idempotency/+-- -- @--- fst \<$> zip xs (full y) ≡ xs--- snd \<$> zip (full x) ys ≡ ys+-- join zip ≡ fmap (join (,)) -- @ --+-- /Commutativity/+--+-- @+-- zip x y ≡ swap \<$> zip y x+-- @+--+-- /Associativity/+--+-- @+-- zip x (zip y z) ≡ assoc \<$> zip (zip x y) z+-- @+--+-- /Absorption/+--+-- @+-- fst \<$> zip xs (align xs ys) ≡ xs+-- toThis \<$> align xs (zip xs ys) ≡ This \<$> xs+-- where+-- toThis (This a) = This a+-- toThis (These a _) = This a+-- toThis (That b) = That b+-- @+--+-- /With/+--+-- @+-- zipWith f a b ≡ f \<$> zip a b+-- @+--+-- /Functoriality/+--+-- @+-- zip (f \<$> x) (g \<$> y) ≡ bimap f g \<$> zip x y+-- @+--+-- /Zippyness/+--+-- @+-- fmap fst (zip x x) ≡ x+-- fmap snd (zip x x) ≡ x+-- zip (fmap fst x) (fmap snd x) ≡ x+-- @+--+-- /Distributivity/+--+-- @+-- align (zip xs ys) zs ≡ undistrThesePair \<$> zip (align xs zs) (align ys zs)+-- distrPairThese \<$> zip (align xs ys) zs ≡ align (zip xs zs) (zip ys zs)+-- zip (align xs ys) zs ≡ undistrPairThese \<$> align (zip xs zs) (zip ys zs)+-- @+--+-- /Note/, the following doesn't hold:+--+-- @+-- distrThesePair \<$> align (zip xs ys) zs ≢ zip (align xs zs) (align ys zs)+-- @+--+-- when @xs = []@ and @ys = zs = [0]@, then+-- the left hand side is "only" @[('That' 0, 'That' 0)]@,+-- but the right hand side is @[('That' 0, 'These' 0 0)]@.+-- class Semialign f => Zip f where- -- | A /full/ strucutre.- full :: a -> f a+ -- | Combines to structures by taking the intersection of their shapes+ -- and using pair to hold the elements.+ zip :: f a -> f b -> f (a, b)+ zip = zipWith (,)+ --+ -- | Combines to structures by taking the intersection of their shapes+ -- and combining the elements with the given function.+ zipWith :: (a -> b -> c) -> f a -> f b -> f c+ zipWith f a b = uncurry f <$> zip a b +#if __GLASGOW_HASKELL__ >= 707+ {-# MINIMAL (zip | zipWith) #-}+#endif++-- | Zippable functors supporting left and right units+--+-- /Unit/+--+-- @+-- fst \<$> zip xs (repeat y) ≡ xs+-- snd \<$> zip (repeat x) ys ≡ ys+-- @+--+class Zip f => Repeat f where+ -- | A /repeat/ structure.+ repeat :: a -> f a+ -- | Right inverse of 'zip'. -- -- This class is definable for every 'Functor'. See 'unzipDefault'.@@ -265,17 +313,17 @@ -- -- For sequence-like types this holds, but for Map-like it doesn't. ---class Semialign f => Unzip f where+class Zip f => Unzip f where unzipWith :: (c -> (a, b)) -> f c -> (f a, f b) unzipWith f = unzip . fmap f- + unzip :: f (a, b) -> (f a, f b) unzip = unzipWith id #if __GLASGOW_HASKELL__ >= 707 {-# MINIMAL unzipWith | unzip #-} #endif- + unzipDefault :: Functor f => f (a, b) -> (f a, f b) unzipDefault x = (fst <$> x, snd <$> x) @@ -287,10 +335,11 @@ align f g x = These (f x) (g x) alignWith h f g x = h (These (f x) (g x)) +instance Zip ((->) e) where zip f g x = (f x, g x) -instance Zip ((->) e) where- full = pure+instance Repeat ((->) e) where+ repeat = pure instance Semialign Maybe where align Nothing Nothing = Nothing@@ -298,12 +347,13 @@ align Nothing (Just b) = Just (That b) align (Just a) (Just b) = Just (These a b) +instance Zip Maybe where zip Nothing _ = Nothing zip (Just _) Nothing = Nothing zip (Just a) (Just b) = Just (a, b) -instance Zip Maybe where- full = Just+instance Repeat Maybe where+ repeat = Just instance Unalign Maybe where unalign Nothing = (Nothing, Nothing)@@ -323,15 +373,16 @@ align [] ys = That <$> ys align (x:xs) (y:ys) = These x y : align xs ys - zip = Prelude.zip- zipWith = Prelude.zipWith- instance Align [] where nil = [] instance Zip [] where- full = repeat+ zip = Prelude.zip+ zipWith = Prelude.zipWith +instance Repeat [] where+ repeat = Prelude.repeat+ instance Unzip [] where unzip = Prelude.unzip @@ -339,14 +390,16 @@ -- | @'zipWith' = 'liftA2'@ . instance Semialign ZipList where alignWith f (ZipList xs) (ZipList ys) = ZipList (alignWith f xs ys)- zipWith f (ZipList xs) (ZipList ys) = ZipList (zipWith f xs ys) instance Align ZipList where nil = ZipList [] instance Zip ZipList where- full = pure+ zipWith f (ZipList xs) (ZipList ys) = ZipList (zipWith f xs ys) +instance Repeat ZipList where+ repeat = pure+ instance Unzip ZipList where unzip (ZipList xs) = (ZipList ys, ZipList zs) where (ys, zs) = unzip xs@@ -358,15 +411,23 @@ instance Semialign NonEmpty where align (x :| xs) (y :| ys) = These x y :| align xs ys +instance Zip NonEmpty where zip = NE.zip zipWith = NE.zipWith -instance Zip NonEmpty where- full = NE.repeat+instance Repeat NonEmpty where+ repeat = NE.repeat instance Unzip NonEmpty where unzip = NE.unzip +deriving instance Semialign Option+deriving instance Align Option+deriving instance Unalign Option+deriving instance Zip Option+deriving instance Repeat Option+deriving instance Unzip Option+ ------------------------------------------------------------------------------- -- containers: ListLike -------------------------------------------------------------------------------@@ -394,9 +455,6 @@ yn = Seq.length ys fc x y = f (These x y) - zip = Seq.zip- zipWith = Seq.zipWith- instance Align Seq where nil = Seq.empty @@ -408,13 +466,18 @@ unzip = unzipDefault #endif +instance Zip Seq where+ zip = Seq.zip+ zipWith = Seq.zipWith+ 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 Zip T.Tree where zipWith f (T.Node x xs) (T.Node y ys) = T.Node (f x y) (zipWith (zipWith f) xs ys) -instance Zip T.Tree where- full x = n where n = T.Node x (repeat n)+instance Repeat T.Tree where+ repeat x = n where n = T.Node x (repeat n) instance Unzip T.Tree where unzipWith f = go where@@ -439,16 +502,17 @@ merge _ _ = oops "Align Map: merge" #endif - zipWith = Map.intersectionWith- instance (Ord k) => Align (Map k) where nil = Map.empty instance Ord k => Unalign (Map k) where unalign xs = (Map.mapMaybe justHere xs, Map.mapMaybe justThere xs)- + instance Ord k => Unzip (Map k) where unzip = unzipDefault +instance Ord k => Zip (Map k) where+ zipWith = Map.intersectionWith+ instance Semialign IntMap where #if MIN_VERSION_containers(0,5,9) alignWith f = IntMap.merge (IntMap.mapMissing (\_ x -> f (This x)))@@ -462,8 +526,6 @@ merge _ _ = oops "Align IntMap: merge" #endif - zipWith = IntMap.intersectionWith- instance Align IntMap where nil = IntMap.empty @@ -472,6 +534,9 @@ instance Unzip IntMap where unzip = unzipDefault +instance Zip IntMap where+ zipWith = IntMap.intersectionWith+ ------------------------------------------------------------------------------- -- transformers -------------------------------------------------------------------------------@@ -479,10 +544,11 @@ instance Semialign Identity where alignWith f (Identity a) (Identity b) = Identity (f (These a b)) +instance Zip Identity where zipWith f (Identity a) (Identity b) = Identity (f a b) -instance Zip Identity where- full = pure+instance Repeat Identity where+ repeat = pure instance Unzip Identity where unzip (Identity ~(a, b)) = (Identity a, Identity b)@@ -492,9 +558,6 @@ 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) - zip (Pair a b) (Pair c d) = Pair (zip a c) (zip b d)- zipWith f (Pair a b) (Pair c d) = Pair (zipWith f a c) (zipWith f b d)- instance (Unalign f, Unalign g) => Unalign (Product f g) where unalign (Pair a b) = (Pair al bl, Pair ar br) where ~(al, ar) = unalign a@@ -504,8 +567,12 @@ nil = Pair nil nil instance (Zip f, Zip g) => Zip (Product f g) where- full x = Pair (full x) (full x)+ zip (Pair a b) (Pair c d) = Pair (zip a c) (zip b d)+ zipWith f (Pair a b) (Pair c d) = Pair (zipWith f a c) (zipWith f b d) +instance (Repeat f, Repeat g) => Repeat (Product f g) where+ repeat x = Pair (repeat x) (repeat x)+ instance (Unzip f, Unzip g) => Unzip (Product f g) where unzip (Pair a b) = (Pair al bl, Pair ar br) where ~(al, ar) = unzip a@@ -518,14 +585,15 @@ g (That gb) = fmap (f . That) gb g (These ga gb) = alignWith f ga gb - zipWith f (Compose x) (Compose y) = Compose (zipWith (zipWith f) x y)- instance (Align f, Semialign g) => Align (Compose f g) where nil = Compose nil instance (Zip f, Zip g) => Zip (Compose f g) where- full x = Compose (full (full x))+ zipWith f (Compose x) (Compose y) = Compose (zipWith (zipWith f) x y) +instance (Repeat f, Repeat g) => Repeat (Compose f g) where+ repeat x = Compose (repeat (repeat x))+ instance (Unzip f, Unzip g) => Unzip (Compose f g) where unzipWith f (Compose x) = (Compose y, Compose z) where ~(y, z) = unzipWith (unzipWith f) x@@ -571,6 +639,7 @@ (_, True) -> Done _ -> Skip (sa, sb, Nothing, False) +instance Monad m => Zip (Stream m) where zipWith = Stream.zipWith #if MIN_VERSION_vector(0,11,0)@@ -580,14 +649,17 @@ instance Monad m => Semialign (Bundle m v) where alignWith f Bundle{sElems = sa, sSize = na} Bundle{sElems = sb, sSize = nb} = Bundle.fromStream (alignWith f sa sb) (Bundle.larger na nb)+#endif +instance Monad m => Zip (Bundle m v) where zipWith = Bundle.zipWith-#endif instance Semialign V.Vector where alignWith = alignVectorWith- zipWith = V.zipWith +instance Zip V.Vector where+ zipWith = V.zipWith+ instance Align V.Vector where nil = Data.Vector.Generic.empty @@ -603,19 +675,20 @@ ------------------------------------------------------------------------------- instance (Eq k, Hashable k) => Align (HashMap k) where- nil = HashMap.empty+ nil = HM.empty instance (Eq k, Hashable k) => Semialign (HashMap k) where- align m n = HashMap.unionWith merge (HashMap.map This m) (HashMap.map That n)+ align m n = HM.unionWith merge (HM.map This m) (HM.map That n) where merge (This a) (That b) = These a b merge _ _ = oops "Align HashMap: merge" - zipWith = HashMap.intersectionWith+instance (Eq k, Hashable k) => Zip (HashMap k) where+ zipWith = HM.intersectionWith instance (Eq k, Hashable k) => Unzip (HashMap k) where unzip = unzipDefault instance (Eq k, Hashable k) => Unalign (HashMap k) where- unalign xs = (HashMap.mapMaybe justHere xs, HashMap.mapMaybe justThere xs)+ unalign xs = (HM.mapMaybe justHere xs, HM.mapMaybe justThere xs) ------------------------------------------------------------------------------- -- tagged@@ -624,10 +697,11 @@ instance Semialign (Tagged b) where alignWith f (Tagged x) (Tagged y) = Tagged (f (These x y)) +instance Zip (Tagged b) where zipWith f (Tagged x) (Tagged y) = Tagged (f x y) -instance Zip (Tagged b) where- full = Tagged+instance Repeat (Tagged b) where+ repeat = Tagged instance Unzip (Tagged b) where unzip (Tagged ~(a, b)) = (Tagged a, Tagged b)@@ -637,9 +711,6 @@ alignWith _ _ _ = Proxy align _ _ = Proxy - zipWith _ _ _ = Proxy- zip _ _ = Proxy- instance Align Proxy where nil = Proxy @@ -647,21 +718,18 @@ unalign _ = (Proxy, Proxy) instance Zip Proxy where- full _ = Proxy+ zipWith _ _ _ = Proxy+ zip _ _ = Proxy +instance Repeat Proxy where+ repeat _ = Proxy+ instance Unzip Proxy where unzip _ = (Proxy, Proxy) ------------------------------------------------------------------------------- -- combinators ----------------------------------------------------------------------------------- | Align two structures and combine with 'mappend'.------ See `salign`. `malign` will be deprecated after `Semigroup` becomes a super--- class of `Monoid`-malign :: (Semialign f, Monoid a) => f a -> f a -> f a-malign = alignWith (mergeThese mappend) -- | Align two structures and combine with '<>'. salign :: (Semialign f, Semigroup a) => f a -> f a -> f a
src/Data/Zip.hs view
@@ -6,13 +6,14 @@ module Data.Zip ( Semialign (..), Zip (..),+ Repeat (..), Unzip (..), unzipDefault, Zippy (..), ) where import Prelude ()-import Prelude.Compat hiding (zipWith)+import Prelude.Compat hiding (repeat, zipWith) import Data.Semigroup (Semigroup (..)) @@ -29,20 +30,20 @@ newtype Zippy f a = Zippy { getZippy :: f a } deriving (Eq, Ord, Show, Read, Functor) -instance (Semialign f, Semigroup a) => Semigroup (Zippy f a) where+instance (Zip f, Semigroup a) => Semigroup (Zippy f a) where Zippy x <> Zippy y = Zippy $ zipWith (<>) x y -instance (Zip f, Monoid a) => Monoid (Zippy f a) where- mempty = Zippy $ full mempty+instance (Repeat f, Monoid a) => Monoid (Zippy f a) where+ mempty = Zippy $ repeat mempty mappend (Zippy x) (Zippy y) = Zippy $ zipWith mappend x y #ifdef MIN_VERSION_semigroupoids-instance Semialign f => Apply (Zippy f) where+instance Zip f => Apply (Zippy f) where Zippy f <.> Zippy x = Zippy $ zipWith ($) f x #endif -instance Zip f => Applicative (Zippy f) where- pure = Zippy . full+instance Repeat f => Applicative (Zippy f) where+ pure = Zippy . repeat #ifdef MIN_VERSION_semigroupoids (<*>) = (<.>) #else