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