summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorphadej <>2019-10-21 10:45:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-10-21 10:45:00 (GMT)
commit6c7daedc58d17c99ec0f4c162f3bfc957f5eb651 (patch)
tree1cf19b53c9d1da4cb35739c9df51c90dbc12624a
parent1b96fad9f1894a65afeeb8b2f5cb7bf5ca4a2274 (diff)
version 1.1HEAD1.1master
-rwxr-xr-xCHANGELOG.md27
-rw-r--r--semialign.cabal17
-rw-r--r--src/Data/Align.hs2
-rw-r--r--src/Data/Semialign.hs6
-rw-r--r--src/Data/Semialign/Internal.hs298
-rw-r--r--src/Data/Zip.hs15
6 files changed, 237 insertions, 128 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index a2aecd0..28f6092 100755
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -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.
diff --git a/semialign.cabal b/semialign.cabal
index 8e4807d..60cdc78 100644
--- a/semialign.cabal
+++ b/semialign.cabal
@@ -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 @@ description:
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 @@ library
-- 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 @@ library
-- 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
diff --git a/src/Data/Align.hs b/src/Data/Align.hs
index dc4f81f..70a64b2 100644
--- a/src/Data/Align.hs
+++ b/src/Data/Align.hs
@@ -9,7 +9,7 @@ module Data.Align (
Align (..),
Unalign (..),
-- * Specialized aligns
- malign, salign, padZip, padZipWith,
+ salign, padZip, padZipWith,
lpadZip, lpadZipWith,
rpadZip, rpadZipWith,
alignVectorWith,
diff --git a/src/Data/Semialign.hs b/src/Data/Semialign.hs
index 419c454..a70f83c 100644
--- a/src/Data/Semialign.hs
+++ b/src/Data/Semialign.hs
@@ -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,
diff --git a/src/Data/Semialign/Internal.hs b/src/Data/Semialign/Internal.hs
index 281edd1..24c2e6f 100644
--- a/src/Data/Semialign/Internal.hs
+++ b/src/Data/Semialign/Internal.hs
@@ -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.HashMap.Strict (HashMap)
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 :: String -> a
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,54 +89,30 @@ oops = error . ("Data.Align: internal error: " ++)
--
-- @
-- 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 @@ oops = error . ("Data.Align: internal error: " ++)
-- ≡ 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 @@ class Functor f => Semialign f where
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,16 +194,105 @@ class Semialign f => Unalign f where
#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/
+--
+-- @
+-- 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)
-- @
--- fst \<$> zip xs (full y) ≡ xs
--- snd \<$> zip (full x) ys ≡ ys
+--
+-- /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'.
--
@@ -265,17 +313,17 @@ class Semialign f => Zip f where
--
-- 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 @@ 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 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 @@ instance Semialign Maybe where
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,14 +373,15 @@ instance Semialign [] where
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,13 +390,15 @@ instance Unzip [] where
-- | @'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
@@ -358,15 +411,23 @@ instance Unzip ZipList where
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 @@ instance Semialign Seq where
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 @@ instance Unzip Seq where
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 @@ instance Ord k => Semialign (Map k) where
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 @@ instance Semialign IntMap where
merge _ _ = oops "Align IntMap: merge"
#endif
- zipWith = IntMap.intersectionWith
-
instance Align IntMap where
nil = IntMap.empty
@@ -472,6 +534,9 @@ instance Unalign IntMap where
instance Unzip IntMap where unzip = unzipDefault
+instance Zip IntMap where
+ zipWith = IntMap.intersectionWith
+
-------------------------------------------------------------------------------
-- transformers
-------------------------------------------------------------------------------
@@ -479,10 +544,11 @@ instance Unzip IntMap where unzip = unzipDefault
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 @@ instance (Semialign f, Semialign g) => Semialign (Product f g) where
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,7 +567,11 @@ instance (Align f, Align g) => Align (Product f g) where
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
@@ -518,13 +585,14 @@ instance (Semialign f, Semialign g) => Semialign (Compose f g) where
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
@@ -571,6 +639,7 @@ instance Monad m => Semialign (Stream m) where
(_, 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,13 +649,16 @@ instance Monad m => Align (Bundle m v) where
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 @@ alignVectorWith f x y = unstream $ alignWith f (stream x) (stream y)
-------------------------------------------------------------------------------
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 (Eq k, Hashable k) => Unalign (HashMap k) where
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 @@ instance Semialign Proxy where
alignWith _ _ _ = Proxy
align _ _ = Proxy
- zipWith _ _ _ = Proxy
- zip _ _ = Proxy
-
instance Align Proxy where
nil = Proxy
@@ -647,7 +718,11 @@ instance Unalign Proxy where
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)
@@ -656,13 +731,6 @@ instance Unzip Proxy where
-- 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
salign = alignWith (mergeThese (<>))
diff --git a/src/Data/Zip.hs b/src/Data/Zip.hs
index 3032ab1..9c83d90 100644
--- a/src/Data/Zip.hs
+++ b/src/Data/Zip.hs
@@ -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 @@ import Data.Functor.Apply (Apply (..))
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