{-# LANGUAGE CPP         #-}
{-# LANGUAGE Trustworthy #-}
-- | This module provides
--
-- * specialised versions of class members e.g. 'bitraverseThese'
-- * non-lens variants of "Data.These.Lens" things, e.g 'justHere'
module Data.These.Combinators (
    -- * Specialised combinators
    -- ** Bifunctor
    bimapThese,
    mapHere,
    mapThere,
    -- ** Bitraversable
    bitraverseThese,
    -- ** Associativity and commutativity
    swapThese,
    assocThese,
    unassocThese,

    -- * Other operations
    -- ** preview
    --
    -- |
    -- @
    -- 'justThis'  = 'Control.Lens.preview' '_This'
    -- 'justThat'  = 'Control.Lens.preview' '_That'
    -- 'justThese' = 'Control.Lens.preview' '_These'
    -- 'justHere'  = 'Control.Lens.preview' 'here'
    -- 'justThere' = 'Control.Lens.preview' 'there'
    -- @
    justThis,
    justThat,
    justThese,
    justHere,
    justThere,

    -- ** toListOf
    --
    -- |
    -- @
    -- 'catThis'  = 'Control.Lens.toListOf' ('Control.Lens.folded' . '_This')
    -- 'catThat'  = 'Control.Lens.toListOf' ('Control.Lens.folded' . '_That')
    -- 'catThese' = 'Control.Lens.toListOf' ('Control.Lens.folded' . '_These')
    -- 'catHere'  = 'Control.Lens.toListOf' ('Control.Lens.folded' . 'here')
    -- 'catThere' = 'Control.Lens.toListOf' ('Control.Lens.folded' . 'there')
    -- @
    catThis,
    catThat,
    catThese,
    catHere,
    catThere,

    -- * is / has
    --
    -- |
    -- @
    -- 'isThis'   = 'Control.Lens.Extra.is' '_This'
    -- 'isThat'   = 'Control.Lens.Extra.is' '_That'
    -- 'isThese'  = 'Control.Lens.Extra.is' '_These'
    -- 'hasHere'  = 'Control.Lens.has' 'here'
    -- 'hasThere' = 'Control.Lens.has' 'there'
    -- @
    isThis,
    isThat,
    isThese,
    hasHere,
    hasThere,

    -- * over / map
    --
    -- @
    -- 'mapThis'  = 'Control.Lens.over' '_This'
    -- 'mapThat'  = 'Control.Lens.over' '_That'
    -- 'mapThese' = 'Control.Lens.over' '_These'
    -- 'mapHere'  = 'Control.Lens.over' 'here'
    -- 'mapThere' = 'Control.Lens.over' 'there'
    -- @
    mapThis,
    mapThat,
    mapThese,
    ) where

import Control.Applicative (Applicative (..))
import Data.Bifunctor      (bimap, first, second)
import Data.Bitraversable  (bitraverse)
import Data.Maybe          (isJust, mapMaybe)
import Data.These
import Prelude             (Bool (..), Maybe (..), curry, uncurry, (.))

#ifdef MIN_VERSION_assoc
import Data.Bifunctor.Assoc (assoc, unassoc)
import Data.Bifunctor.Swap  (swap)
#endif

-------------------------------------------------------------------------------
-- bifunctors
-------------------------------------------------------------------------------

-- | 'Bifunctor' 'bimap'.
bimapThese :: (a -> c) -> (b -> d) -> These a b -> These c d
bimapThese :: (a -> c) -> (b -> d) -> These a b -> These c d
bimapThese = (a -> c) -> (b -> d) -> These a b -> These c d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap

-- | @'mapHere' = 'Control.Lens.over' 'here'@
mapHere :: (a -> c) -> These a b -> These c b
mapHere :: (a -> c) -> These a b -> These c b
mapHere = (a -> c) -> These a b -> These c b
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first

-- | @'mapThere' = 'Control.Lens.over' 'there'@
mapThere :: (b -> d) -> These a b -> These a d
mapThere :: (b -> d) -> These a b -> These a d
mapThere = (b -> d) -> These a b -> These a d
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second

-- | 'Bitraversable' 'bitraverse'.
bitraverseThese :: Applicative f => (a -> f c) -> (b -> f d) -> These a b -> f (These c d)
bitraverseThese :: (a -> f c) -> (b -> f d) -> These a b -> f (These c d)
bitraverseThese = (a -> f c) -> (b -> f d) -> These a b -> f (These c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse

-------------------------------------------------------------------------------
-- assoc
-------------------------------------------------------------------------------

-- | 'These' is commutative.
--
-- @
-- 'swapThese' . 'swapThese' = 'id'
-- @
--
-- @since 0.8
swapThese :: These a b -> These b a
#ifdef MIN_VERSION_assoc
swapThese :: These a b -> These b a
swapThese = These a b -> These b a
forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
swap
#else
swapThese (This a)    = That a
swapThese (That b)    = This b
swapThese (These a b) = These b a
#endif

-- | 'These' is associative.
--
-- @
-- 'assocThese' . 'unassocThese' = 'id'
-- 'unassocThese' . 'assocThese' = 'id'
-- @
--
-- @since 0.8
assocThese :: These (These a b) c -> These a (These b c)
#ifdef MIN_VERSION_assoc
assocThese :: These (These a b) c -> These a (These b c)
assocThese = These (These a b) c -> These a (These b c)
forall (p :: * -> * -> *) a b c.
Assoc p =>
p (p a b) c -> p a (p b c)
assoc
#else
assocThese (This (This a))       = This a
assocThese (This (That b))       = That (This b)
assocThese (That c)              = That (That c)
assocThese (These (That b) c)    = That (These b c)
assocThese (This (These a b))    = These a (This b)
assocThese (These (This a) c)    = These a (That c)
assocThese (These (These a b) c) = These a (These b c)
#endif

-- | 'These' is associative. See 'assocThese'.
--
-- @since 0.8
unassocThese :: These a (These b c) -> These (These a b) c
#ifdef MIN_VERSION_assoc
unassocThese :: These a (These b c) -> These (These a b) c
unassocThese = These a (These b c) -> These (These a b) c
forall (p :: * -> * -> *) a b c.
Assoc p =>
p a (p b c) -> p (p a b) c
unassoc
#else
unassocThese (This a)              = This (This a)
unassocThese (That (This b))       = This (That b)
unassocThese (That (That c))       = That c
unassocThese (That (These b c))    = These (That b) c
unassocThese (These a (This b))    = This (These a b)
unassocThese (These a (That c))    = These (This a) c
unassocThese (These a (These b c)) = These (These a b) c
#endif

-------------------------------------------------------------------------------
-- preview
-------------------------------------------------------------------------------

-- |
--
-- >>> justHere (This 'x')
-- Just 'x'
--
-- >>> justHere (That 'y')
-- Nothing
--
-- >>> justHere (These 'x' 'y')
-- Just 'x'
--
justHere :: These a b -> Maybe a
justHere :: These a b -> Maybe a
justHere (This a
a)    = a -> Maybe a
forall a. a -> Maybe a
Just a
a
justHere (That b
_)    = Maybe a
forall a. Maybe a
Nothing
justHere (These a
a b
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
a

-- |
--
-- >>> justThere (This 'x')
-- Nothing
--
-- >>> justThere (That 'y')
-- Just 'y'
--
-- >>> justThere (These 'x' 'y')
-- Just 'y'
--
justThere :: These a b -> Maybe b
justThere :: These a b -> Maybe b
justThere (This a
_)    = Maybe b
forall a. Maybe a
Nothing
justThere (That b
b)    = b -> Maybe b
forall a. a -> Maybe a
Just b
b
justThere (These a
_ b
b) = b -> Maybe b
forall a. a -> Maybe a
Just b
b

justThis :: These a b -> Maybe a
justThis :: These a b -> Maybe a
justThis (This a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
justThis These a b
_        = Maybe a
forall a. Maybe a
Nothing

justThat :: These a b -> Maybe b
justThat :: These a b -> Maybe b
justThat (That b
x) = b -> Maybe b
forall a. a -> Maybe a
Just b
x
justThat These a b
_        = Maybe b
forall a. Maybe a
Nothing

justThese :: These a b -> Maybe (a, b)
justThese :: These a b -> Maybe (a, b)
justThese (These a
a b
x) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a, b
x)
justThese These a b
_           = Maybe (a, b)
forall a. Maybe a
Nothing

-------------------------------------------------------------------------------
-- toListOf
-------------------------------------------------------------------------------

-- | Select all 'This' constructors from a list.
catThis :: [These a b] -> [a]
catThis :: [These a b] -> [a]
catThis = (These a b -> Maybe a) -> [These a b] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe These a b -> Maybe a
forall a b. These a b -> Maybe a
justThis

-- | Select all 'That' constructors from a list.
catThat :: [These a b] -> [b]
catThat :: [These a b] -> [b]
catThat = (These a b -> Maybe b) -> [These a b] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe These a b -> Maybe b
forall a b. These a b -> Maybe b
justThat

-- | Select all 'These' constructors from a list.
catThese :: [These a b] -> [(a, b)]
catThese :: [These a b] -> [(a, b)]
catThese = (These a b -> Maybe (a, b)) -> [These a b] -> [(a, b)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe These a b -> Maybe (a, b)
forall a b. These a b -> Maybe (a, b)
justThese

catHere :: [These a b] -> [a]
catHere :: [These a b] -> [a]
catHere = (These a b -> Maybe a) -> [These a b] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe These a b -> Maybe a
forall a b. These a b -> Maybe a
justHere

catThere :: [These a b] -> [b]
catThere :: [These a b] -> [b]
catThere = (These a b -> Maybe b) -> [These a b] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe These a b -> Maybe b
forall a b. These a b -> Maybe b
justThere

-------------------------------------------------------------------------------
-- is
-------------------------------------------------------------------------------

isThis, isThat, isThese :: These a b -> Bool
-- | @'isThis' = 'isJust' . 'justThis'@
isThis :: These a b -> Bool
isThis  = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> (These a b -> Maybe a) -> These a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These a b -> Maybe a
forall a b. These a b -> Maybe a
justThis

-- | @'isThat' = 'isJust' . 'justThat'@
isThat :: These a b -> Bool
isThat  = Maybe b -> Bool
forall a. Maybe a -> Bool
isJust (Maybe b -> Bool) -> (These a b -> Maybe b) -> These a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These a b -> Maybe b
forall a b. These a b -> Maybe b
justThat

-- | @'isThese' = 'isJust' . 'justThese'@
isThese :: These a b -> Bool
isThese = Maybe (a, b) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (a, b) -> Bool)
-> (These a b -> Maybe (a, b)) -> These a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These a b -> Maybe (a, b)
forall a b. These a b -> Maybe (a, b)
justThese

hasHere, hasThere :: These a b -> Bool
-- | @'hasHere' = 'isJust' . 'justHere'@
hasHere :: These a b -> Bool
hasHere = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> (These a b -> Maybe a) -> These a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These a b -> Maybe a
forall a b. These a b -> Maybe a
justHere

-- | @'hasThere' = 'isJust' . 'justThere'@
hasThere :: These a b -> Bool
hasThere = Maybe b -> Bool
forall a. Maybe a -> Bool
isJust (Maybe b -> Bool) -> (These a b -> Maybe b) -> These a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These a b -> Maybe b
forall a b. These a b -> Maybe b
justThere

-------------------------------------------------------------------------------
-- over / map
-------------------------------------------------------------------------------

mapThis :: (a -> a) -> These a b -> These a b
mapThis :: (a -> a) -> These a b -> These a b
mapThis a -> a
f (This a
x) = a -> These a b
forall a b. a -> These a b
This (a -> a
f a
x)
mapThis a -> a
_ These a b
y        = These a b
y

mapThat :: (b -> b) -> These a b -> These a b
mapThat :: (b -> b) -> These a b -> These a b
mapThat b -> b
f (That b
x) = b -> These a b
forall a b. b -> These a b
That (b -> b
f b
x)
mapThat b -> b
_ These a b
y        = These a b
y

mapThese :: ((a, b) -> (a, b)) -> These a b -> These a b
mapThese :: ((a, b) -> (a, b)) -> These a b -> These a b
mapThese (a, b) -> (a, b)
f (These a
x b
y) = (a -> b -> These a b) -> (a, b) -> These a b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> These a b
forall a b. a -> b -> These a b
These (((a, b) -> (a, b)) -> a -> b -> (a, b)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, b) -> (a, b)
f a
x b
y)
mapThese (a, b) -> (a, b)
_ These a b
z           = These a b
z