1{-# LANGUAGE CPP         #-}
2{-# LANGUAGE Trustworthy #-}
3-- | This module provides
4--
5-- * specialised versions of class members e.g. 'bitraverseThese'
6-- * non-lens variants of "Data.These.Lens" things, e.g 'justHere'
7module Data.These.Combinators (
8    -- * Specialised combinators
9    -- ** Bifunctor
10    bimapThese,
11    mapHere,
12    mapThere,
13    -- ** Bitraversable
14    bitraverseThese,
15    -- ** Associativity and commutativity
16    swapThese,
17    assocThese,
18    unassocThese,
19
20    -- * Other operations
21    -- ** preview
22    --
23    -- |
24    -- @
25    -- 'justThis'  = 'Control.Lens.preview' '_This'
26    -- 'justThat'  = 'Control.Lens.preview' '_That'
27    -- 'justThese' = 'Control.Lens.preview' '_These'
28    -- 'justHere'  = 'Control.Lens.preview' 'here'
29    -- 'justThere' = 'Control.Lens.preview' 'there'
30    -- @
31    justThis,
32    justThat,
33    justThese,
34    justHere,
35    justThere,
36
37    -- ** toListOf
38    --
39    -- |
40    -- @
41    -- 'catThis'  = 'Control.Lens.toListOf' ('Control.Lens.folded' . '_This')
42    -- 'catThat'  = 'Control.Lens.toListOf' ('Control.Lens.folded' . '_That')
43    -- 'catThese' = 'Control.Lens.toListOf' ('Control.Lens.folded' . '_These')
44    -- 'catHere'  = 'Control.Lens.toListOf' ('Control.Lens.folded' . 'here')
45    -- 'catThere' = 'Control.Lens.toListOf' ('Control.Lens.folded' . 'there')
46    -- @
47    catThis,
48    catThat,
49    catThese,
50    catHere,
51    catThere,
52
53    -- * is / has
54    --
55    -- |
56    -- @
57    -- 'isThis'   = 'Control.Lens.Extra.is' '_This'
58    -- 'isThat'   = 'Control.Lens.Extra.is' '_That'
59    -- 'isThese'  = 'Control.Lens.Extra.is' '_These'
60    -- 'hasHere'  = 'Control.Lens.has' 'here'
61    -- 'hasThere' = 'Control.Lens.has' 'there'
62    -- @
63    isThis,
64    isThat,
65    isThese,
66    hasHere,
67    hasThere,
68
69    -- * over / map
70    --
71    -- @
72    -- 'mapThis'  = 'Control.Lens.over' '_This'
73    -- 'mapThat'  = 'Control.Lens.over' '_That'
74    -- 'mapThese' = 'Control.Lens.over' '_These'
75    -- 'mapHere'  = 'Control.Lens.over' 'here'
76    -- 'mapThere' = 'Control.Lens.over' 'there'
77    -- @
78    mapThis,
79    mapThat,
80    mapThese,
81    ) where
82
83import Control.Applicative (Applicative (..))
84import Data.Bifunctor      (bimap, first, second)
85import Data.Bitraversable  (bitraverse)
86import Data.Maybe          (isJust, mapMaybe)
87import Data.These
88import Prelude             (Bool (..), Maybe (..), curry, uncurry, (.))
89
90#ifdef MIN_VERSION_assoc
91import Data.Bifunctor.Assoc (assoc, unassoc)
92import Data.Bifunctor.Swap  (swap)
93#endif
94
95-------------------------------------------------------------------------------
96-- bifunctors
97-------------------------------------------------------------------------------
98
99-- | 'Bifunctor' 'bimap'.
100bimapThese :: (a -> c) -> (b -> d) -> These a b -> These c d
101bimapThese = bimap
102
103-- | @'mapHere' = 'Control.Lens.over' 'here'@
104mapHere :: (a -> c) -> These a b -> These c b
105mapHere = first
106
107-- | @'mapThere' = 'Control.Lens.over' 'there'@
108mapThere :: (b -> d) -> These a b -> These a d
109mapThere = second
110
111-- | 'Bitraversable' 'bitraverse'.
112bitraverseThese :: Applicative f => (a -> f c) -> (b -> f d) -> These a b -> f (These c d)
113bitraverseThese = bitraverse
114
115-------------------------------------------------------------------------------
116-- assoc
117-------------------------------------------------------------------------------
118
119-- | 'These' is commutative.
120--
121-- @
122-- 'swapThese' . 'swapThese' = 'id'
123-- @
124--
125-- @since 0.8
126swapThese :: These a b -> These b a
127#ifdef MIN_VERSION_assoc
128swapThese = swap
129#else
130swapThese (This a)    = That a
131swapThese (That b)    = This b
132swapThese (These a b) = These b a
133#endif
134
135-- | 'These' is associative.
136--
137-- @
138-- 'assocThese' . 'unassocThese' = 'id'
139-- 'unassocThese' . 'assocThese' = 'id'
140-- @
141--
142-- @since 0.8
143assocThese :: These (These a b) c -> These a (These b c)
144#ifdef MIN_VERSION_assoc
145assocThese = assoc
146#else
147assocThese (This (This a))       = This a
148assocThese (This (That b))       = That (This b)
149assocThese (That c)              = That (That c)
150assocThese (These (That b) c)    = That (These b c)
151assocThese (This (These a b))    = These a (This b)
152assocThese (These (This a) c)    = These a (That c)
153assocThese (These (These a b) c) = These a (These b c)
154#endif
155
156-- | 'These' is associative. See 'assocThese'.
157--
158-- @since 0.8
159unassocThese :: These a (These b c) -> These (These a b) c
160#ifdef MIN_VERSION_assoc
161unassocThese = unassoc
162#else
163unassocThese (This a)              = This (This a)
164unassocThese (That (This b))       = This (That b)
165unassocThese (That (That c))       = That c
166unassocThese (That (These b c))    = These (That b) c
167unassocThese (These a (This b))    = This (These a b)
168unassocThese (These a (That c))    = These (This a) c
169unassocThese (These a (These b c)) = These (These a b) c
170#endif
171
172-------------------------------------------------------------------------------
173-- preview
174-------------------------------------------------------------------------------
175
176-- |
177--
178-- >>> justHere (This 'x')
179-- Just 'x'
180--
181-- >>> justHere (That 'y')
182-- Nothing
183--
184-- >>> justHere (These 'x' 'y')
185-- Just 'x'
186--
187justHere :: These a b -> Maybe a
188justHere (This a)    = Just a
189justHere (That _)    = Nothing
190justHere (These a _) = Just a
191
192-- |
193--
194-- >>> justThere (This 'x')
195-- Nothing
196--
197-- >>> justThere (That 'y')
198-- Just 'y'
199--
200-- >>> justThere (These 'x' 'y')
201-- Just 'y'
202--
203justThere :: These a b -> Maybe b
204justThere (This _)    = Nothing
205justThere (That b)    = Just b
206justThere (These _ b) = Just b
207
208justThis :: These a b -> Maybe a
209justThis (This a) = Just a
210justThis _        = Nothing
211
212justThat :: These a b -> Maybe b
213justThat (That x) = Just x
214justThat _        = Nothing
215
216justThese :: These a b -> Maybe (a, b)
217justThese (These a x) = Just (a, x)
218justThese _           = Nothing
219
220-------------------------------------------------------------------------------
221-- toListOf
222-------------------------------------------------------------------------------
223
224-- | Select all 'This' constructors from a list.
225catThis :: [These a b] -> [a]
226catThis = mapMaybe justThis
227
228-- | Select all 'That' constructors from a list.
229catThat :: [These a b] -> [b]
230catThat = mapMaybe justThat
231
232-- | Select all 'These' constructors from a list.
233catThese :: [These a b] -> [(a, b)]
234catThese = mapMaybe justThese
235
236catHere :: [These a b] -> [a]
237catHere = mapMaybe justHere
238
239catThere :: [These a b] -> [b]
240catThere = mapMaybe justThere
241
242-------------------------------------------------------------------------------
243-- is
244-------------------------------------------------------------------------------
245
246isThis, isThat, isThese :: These a b -> Bool
247-- | @'isThis' = 'isJust' . 'justThis'@
248isThis  = isJust . justThis
249
250-- | @'isThat' = 'isJust' . 'justThat'@
251isThat  = isJust . justThat
252
253-- | @'isThese' = 'isJust' . 'justThese'@
254isThese = isJust . justThese
255
256hasHere, hasThere :: These a b -> Bool
257-- | @'hasHere' = 'isJust' . 'justHere'@
258hasHere = isJust . justHere
259
260-- | @'hasThere' = 'isJust' . 'justThere'@
261hasThere = isJust . justThere
262
263-------------------------------------------------------------------------------
264-- over / map
265-------------------------------------------------------------------------------
266
267mapThis :: (a -> a) -> These a b -> These a b
268mapThis f (This x) = This (f x)
269mapThis _ y        = y
270
271mapThat :: (b -> b) -> These a b -> These a b
272mapThat f (That x) = That (f x)
273mapThat _ y        = y
274
275mapThese :: ((a, b) -> (a, b)) -> These a b -> These a b
276mapThese f (These x y) = uncurry These (curry f x y)
277mapThese _ z           = z
278