summaryrefslogtreecommitdiff
path: root/libraries/base/Control/Monad/Zip.hs
blob: 9e9cbcb73140a66a52fc247da1af26a8c274b560 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeOperators #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Monad.Zip
-- Copyright   :  (c) Nils Schweinsberg 2011,
--                (c) George Giorgidze 2011
--                (c) University Tuebingen 2011
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- Maintainer  :  libraries@haskell.org
-- Stability   :  stable
-- Portability :  portable
--
-- Monadic zipping (used for monad comprehensions)
--
-----------------------------------------------------------------------------

module Control.Monad.Zip where

import Control.Monad (liftM, liftM2)
import Data.Functor.Identity
import Data.Monoid
import Data.Ord ( Down(..) )
import Data.Proxy
import qualified Data.List.NonEmpty as NE
import GHC.Generics
import GHC.Tuple (Solo (..))

-- | Instances should satisfy the laws:
--
-- [Naturality]
--
--     @'liftM' (f 'Control.Arrow.***' g) ('mzip' ma mb)
--         = 'mzip' ('liftM' f ma) ('liftM' g mb)@
--
-- [Information Preservation]
--
--     @'liftM' ('Prelude.const' ()) ma = 'liftM' ('Prelude.const' ()) mb@
--         implies
--     @'munzip' ('mzip' ma mb) = (ma, mb)@
--
class Monad m => MonadZip m where
    {-# MINIMAL mzip | mzipWith #-}

    mzip :: m a -> m b -> m (a,b)
    mzip = mzipWith (,)

    mzipWith :: (a -> b -> c) -> m a -> m b -> m c
    mzipWith f ma mb = liftM (uncurry f) (mzip ma mb)

    munzip :: m (a,b) -> (m a, m b)
    munzip mab = (liftM fst mab, liftM snd mab)
    -- munzip is a member of the class because sometimes
    -- you can implement it more efficiently than the
    -- above default code.  See #4370 comment by giorgidze

-- | @since 4.3.1.0
instance MonadZip [] where
    mzip     = zip
    mzipWith = zipWith
    munzip   = unzip

-- | @since 4.9.0.0
instance MonadZip NE.NonEmpty where
  mzip     = NE.zip
  mzipWith = NE.zipWith
  munzip   = NE.unzip

-- | @since 4.8.0.0
instance MonadZip Identity where
    mzipWith                 = liftM2
    munzip (Identity (a, b)) = (Identity a, Identity b)

-- | @since 4.15.0.0
instance MonadZip Solo where
    mzipWith = liftM2
    munzip (MkSolo (a, b)) = (MkSolo a, MkSolo b)

-- | @since 4.8.0.0
instance MonadZip Dual where
    -- Cannot use coerce, it's unsafe
    mzipWith = liftM2

-- | @since 4.8.0.0
instance MonadZip Sum where
    mzipWith = liftM2

-- | @since 4.8.0.0
instance MonadZip Product where
    mzipWith = liftM2

-- | @since 4.8.0.0
instance MonadZip Maybe where
    mzipWith = liftM2

-- | @since 4.8.0.0
instance MonadZip First where
    mzipWith = liftM2

-- | @since 4.8.0.0
instance MonadZip Last where
    mzipWith = liftM2

-- | @since 4.8.0.0
instance MonadZip f => MonadZip (Alt f) where
    mzipWith f (Alt ma) (Alt mb) = Alt (mzipWith f ma mb)

-- | @since 4.9.0.0
instance MonadZip Proxy where
    mzipWith _ _ _ = Proxy

-- Instances for GHC.Generics
-- | @since 4.9.0.0
instance MonadZip U1 where
    mzipWith _ _ _ = U1

-- | @since 4.9.0.0
instance MonadZip Par1 where
    mzipWith = liftM2

-- | @since 4.9.0.0
instance MonadZip f => MonadZip (Rec1 f) where
    mzipWith f (Rec1 fa) (Rec1 fb) = Rec1 (mzipWith f fa fb)

-- | @since 4.9.0.0
instance MonadZip f => MonadZip (M1 i c f) where
    mzipWith f (M1 fa) (M1 fb) = M1 (mzipWith f fa fb)

-- | @since 4.9.0.0
instance (MonadZip f, MonadZip g) => MonadZip (f :*: g) where
    mzipWith f (x1 :*: y1) (x2 :*: y2) = mzipWith f x1 x2 :*: mzipWith f y1 y2

-- instances for Data.Ord

-- | @since 4.12.0.0
instance MonadZip Down where
    mzipWith = liftM2