1{-# LANGUAGE CPP #-}
2{-# LANGUAGE GADTs #-}
3{-# LANGUAGE TypeFamilies #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE DefaultSignatures #-}
7{-# LANGUAGE UndecidableInstances #-}
8{-# LANGUAGE FunctionalDependencies #-}
9#ifdef TRUSTWORTHY
10{-# LANGUAGE Trustworthy #-}
11#endif
12
13#include "lens-common.h"
14
15-----------------------------------------------------------------------------
16-- |
17-- Module      :  Control.Lens.Each
18-- Copyright   :  (C) 2012-16 Edward Kmett
19-- License     :  BSD-style (see the file LICENSE)
20-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
21-- Stability   :  experimental
22-- Portability :  non-portable
23--
24-----------------------------------------------------------------------------
25module Control.Lens.Each
26  (
27  -- * Each
28    Each(..)
29  ) where
30
31import Prelude ()
32
33import Control.Lens.Traversal
34import Control.Lens.Internal.ByteString
35import Control.Lens.Internal.Prelude
36import Data.Array.Unboxed as Unboxed
37import Data.Array.IArray as IArray
38import Data.ByteString as StrictB
39import Data.ByteString.Lazy as LazyB
40import Data.Complex
41import Data.HashMap.Lazy as HashMap
42import Data.IntMap as IntMap
43import Data.Map as Map
44import Data.Sequence as Seq
45import Data.Text.Lens (text)
46import Data.Text as StrictT
47import Data.Text.Lazy as LazyT
48import Data.Tree as Tree
49import Data.Vector.Generic.Lens (vectorTraverse)
50import qualified Data.Vector as Vector
51import qualified Data.Vector.Primitive as Prim
52import Data.Vector.Primitive (Prim)
53import qualified Data.Vector.Storable as Storable
54import Data.Vector.Storable (Storable)
55import qualified Data.Vector.Unboxed as Unboxed
56import Data.Vector.Unboxed (Unbox)
57import Data.Word
58
59-- $setup
60-- >>> :set -XNoOverloadedStrings
61-- >>> import Control.Lens
62-- >>> import Data.Text.Strict.Lens as Text
63-- >>> import Data.Char as Char
64
65-- | Extract 'each' element of a (potentially monomorphic) container.
66--
67-- Notably, when applied to a tuple, this generalizes 'Control.Lens.Traversal.both' to arbitrary homogeneous tuples.
68--
69-- >>> (1,2,3) & each *~ 10
70-- (10,20,30)
71--
72-- It can also be used on monomorphic containers like 'StrictT.Text' or 'StrictB.ByteString'.
73--
74-- >>> over each Char.toUpper ("hello"^.Text.packed)
75-- "HELLO"
76--
77-- >>> ("hello","world") & each.each %~ Char.toUpper
78-- ("HELLO","WORLD")
79class Each s t a b | s -> a, t -> b, s b -> t, t a -> s where
80  each :: Traversal s t a b
81  default each :: (Traversable g, s ~ g a, t ~ g b) => Traversal s t a b
82  each = traverse
83  {-# INLINE each #-}
84
85-- | @'each' :: 'Traversal' (a,a) (b,b) a b@
86instance (a~a', b~b') => Each (a,a') (b,b') a b where
87  each f ~(a,b) = (,) <$> f a <*> f b
88  {-# INLINE each #-}
89
90-- | @'each' :: 'Traversal' (a,a,a) (b,b,b) a b@
91instance (a~a2, a~a3, b~b2, b~b3) => Each (a,a2,a3) (b,b2,b3) a b where
92  each f ~(a,b,c) = (,,) <$> f a <*> f b <*> f c
93  {-# INLINE each #-}
94
95-- | @'each' :: 'Traversal' (a,a,a,a) (b,b,b,b) a b@
96instance (a~a2, a~a3, a~a4, b~b2, b~b3, b~b4) => Each (a,a2,a3,a4) (b,b2,b3,b4) a b where
97  each f ~(a,b,c,d) = (,,,) <$> f a <*> f b <*> f c <*> f d
98  {-# INLINE each #-}
99
100-- | @'each' :: 'Traversal' (a,a,a,a,a) (b,b,b,b,b) a b@
101instance (a~a2, a~a3, a~a4, a~a5, b~b2, b~b3, b~b4, b~b5) => Each (a,a2,a3,a4,a5) (b,b2,b3,b4,b5) a b where
102  each f ~(a,b,c,d,e) = (,,,,) <$> f a <*> f b <*> f c <*> f d <*> f e
103  {-# INLINE each #-}
104
105-- | @'each' :: 'Traversal' (a,a,a,a,a,a) (b,b,b,b,b,b) a b@
106instance (a~a2, a~a3, a~a4, a~a5, a~a6, b~b2, b~b3, b~b4, b~b5, b~b6) => Each (a,a2,a3,a4,a5,a6) (b,b2,b3,b4,b5,b6) a b where
107  each f ~(a,b,c,d,e,g) = (,,,,,) <$> f a <*> f b <*> f c <*> f d <*> f e <*> f g
108  {-# INLINE each #-}
109
110-- | @'each' :: 'Traversal' (a,a,a,a,a,a,a) (b,b,b,b,b,b,b) a b@
111instance (a~a2, a~a3, a~a4, a~a5, a~a6, a~a7, b~b2, b~b3, b~b4, b~b5, b~b6, b~b7) => Each (a,a2,a3,a4,a5,a6,a7) (b,b2,b3,b4,b5,b6,b7) a b where
112  each f ~(a,b,c,d,e,g,h) = (,,,,,,) <$> f a <*> f b <*> f c <*> f d <*> f e <*> f g <*> f h
113  {-# INLINE each #-}
114
115-- | @'each' :: 'Traversal' (a,a,a,a,a,a,a,a) (b,b,b,b,b,b,b,b) a b@
116instance (a~a2, a~a3, a~a4, a~a5, a~a6, a~a7, a~a8, b~b2, b~b3, b~b4, b~b5, b~b6, b~b7, b~b8) => Each (a,a2,a3,a4,a5,a6,a7,a8) (b,b2,b3,b4,b5,b6,b7,b8) a b where
117  each f ~(a,b,c,d,e,g,h,i) = (,,,,,,,) <$> f a <*> f b <*> f c <*> f d <*> f e <*> f g <*> f h <*> f i
118  {-# INLINE each #-}
119
120-- | @'each' :: 'Traversal' (a,a,a,a,a,a,a,a,a) (b,b,b,b,b,b,b,b,b) a b@
121instance (a~a2, a~a3, a~a4, a~a5, a~a6, a~a7, a~a8, a~a9, b~b2, b~b3, b~b4, b~b5, b~b6, b~b7, b~b8, b~b9) => Each (a,a2,a3,a4,a5,a6,a7,a8,a9) (b,b2,b3,b4,b5,b6,b7,b8,b9) a b where
122  each f ~(a,b,c,d,e,g,h,i,j) = (,,,,,,,,) <$> f a <*> f b <*> f c <*> f d <*> f e <*> f g <*> f h <*> f i <*> f j
123  {-# INLINE each #-}
124
125-- | @'each' :: ('RealFloat' a, 'RealFloat' b) => 'Traversal' ('Complex' a) ('Complex' b) a b@
126instance Each (Complex a) (Complex b) a b where
127  each f (a :+ b) = (:+) <$> f a <*> f b
128  {-# INLINE each #-}
129
130-- | @'each' :: 'Traversal' ('Map' c a) ('Map' c b) a b@
131instance (c ~ d) => Each (Map c a) (Map d b) a b where
132  each = traversed
133  {-# INLINE each #-}
134
135-- | @'each' :: 'Traversal' ('Map' c a) ('Map' c b) a b@
136instance Each (IntMap a) (IntMap b) a b where
137  each = traversed
138  {-# INLINE each #-}
139
140-- | @'each' :: 'Traversal' ('HashMap' c a) ('HashMap' c b) a b@
141instance (c ~ d) => Each (HashMap c a) (HashMap d b) a b where
142  each = traversed
143  {-# INLINE each #-}
144
145-- | @'each' :: 'Traversal' [a] [b] a b@
146instance Each [a] [b] a b where
147  each = traversed
148  {-# INLINE each #-}
149
150-- | @'each' :: 'Traversal' (NonEmpty a) (NonEmpty b) a b@
151instance Each (NonEmpty a) (NonEmpty b) a b
152
153-- | @'each' :: 'Traversal' ('Identity' a) ('Identity' b) a b@
154instance Each (Identity a) (Identity b) a b
155
156-- | @'each' :: 'Traversal' ('Maybe' a) ('Maybe' b) a b@
157instance Each (Maybe a) (Maybe b) a b
158
159-- | @'each' :: 'Traversal' ('Either' a a) ('Either' b b) a b@
160--
161-- @since 4.18
162instance (a~a', b~b') => Each (Either a a') (Either b b') a b where
163  each f (Left a)   = Left <$> f a
164  each f (Right a ) = Right <$> f a
165  {-# INLINE each #-}
166
167-- | @'each' :: 'Traversal' ('Seq' a) ('Seq' b) a b@
168instance Each (Seq a) (Seq b) a b where
169  each = traversed
170  {-# INLINE each #-}
171
172-- | @'each' :: 'Traversal' ('Tree' a) ('Tree' b) a b@
173instance Each (Tree a) (Tree b) a b
174
175-- | @'each' :: 'Traversal' ('Vector.Vector' a) ('Vector.Vector' b) a b@
176instance Each (Vector.Vector a) (Vector.Vector b) a b where
177  each = vectorTraverse
178  {-# INLINE each #-}
179
180-- | @'each' :: ('Prim' a, 'Prim' b) => 'Traversal' ('Prim.Vector' a) ('Prim.Vector' b) a b@
181instance (Prim a, Prim b) => Each (Prim.Vector a) (Prim.Vector b) a b where
182  each = vectorTraverse
183  {-# INLINE each #-}
184
185-- | @'each' :: ('Storable' a, 'Storable' b) => 'Traversal' ('Storable.Vector' a) ('Storable.Vector' b) a b@
186instance (Storable a, Storable b) => Each (Storable.Vector a) (Storable.Vector b) a b where
187  each = vectorTraverse
188  {-# INLINE each #-}
189
190-- | @'each' :: ('Unbox' a, 'Unbox' b) => 'Traversal' ('Unboxed.Vector' a) ('Unboxed.Vector' b) a b@
191instance (Unbox a, Unbox b) => Each (Unboxed.Vector a) (Unboxed.Vector b) a b where
192  each = vectorTraverse
193  {-# INLINE each #-}
194
195-- | @'each' :: 'Traversal' 'StrictT.Text' 'StrictT.Text' 'Char' 'Char'@
196instance (a ~ Char, b ~ Char) => Each StrictT.Text StrictT.Text a b where
197  each = text
198  {-# INLINE each #-}
199
200-- | @'each' :: 'Traversal' 'LazyT.Text' 'LazyT.Text' 'Char' 'Char'@
201instance (a ~ Char, b ~ Char) => Each LazyT.Text LazyT.Text a b where
202  each = text
203  {-# INLINE each #-}
204
205-- | @'each' :: 'Traversal' 'StrictB.ByteString' 'StrictB.ByteString' 'Word8' 'Word8'@
206instance (a ~ Word8, b ~ Word8) => Each StrictB.ByteString StrictB.ByteString a b where
207  each = traversedStrictTree
208  {-# INLINE each #-}
209
210-- | @'each' :: 'Traversal' 'LazyB.ByteString' 'LazyB.ByteString' 'Word8' 'Word8'@
211instance (a ~ Word8, b ~ Word8) => Each LazyB.ByteString LazyB.ByteString a b where
212  each = traversedLazy
213  {-# INLINE each #-}
214
215-- | @'each' :: 'Ix' i => 'Traversal' ('Array' i a) ('Array' i b) a b@
216instance (Ix i, i ~ j) => Each (Array i a) (Array j b) a b where
217  each f arr = array (bounds arr) <$> traverse (\(i,a) -> (,) i <$> f a) (IArray.assocs arr)
218  {-# INLINE each #-}
219
220-- | @'each' :: ('Ix' i, 'IArray' 'UArray' a, 'IArray' 'UArray' b) => 'Traversal' ('Array' i a) ('Array' i b) a b@
221instance (Ix i, IArray UArray a, IArray UArray b, i ~ j) => Each (UArray i a) (UArray j b) a b where
222  each f arr = array (bounds arr) <$> traverse (\(i,a) -> (,) i <$> f a) (IArray.assocs arr)
223  {-# INLINE each #-}
224