{-# 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, (.))

import Data.Bifunctor.Assoc (assoc, unassoc)
import Data.Bifunctor.Swap  (swap)

-- $setup
-- >>> import Data.These

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

-- | 'Bifunctor' 'bimap'.
bimapThese :: (a -> c) -> (b -> d) -> These a b -> These c d
bimapThese :: forall a c b d. (a -> c) -> (b -> d) -> These a b -> These c d
bimapThese = (a -> c) -> (b -> d) -> These a b -> These c d
forall a c b d. (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 :: forall a c b. (a -> c) -> These a b -> These c b
mapHere = (a -> c) -> These a b -> These c b
forall a c b. (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 :: forall b d a. (b -> d) -> These a b -> These a d
mapThere = (b -> d) -> These a b -> These a d
forall b d a. (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 :: forall (f :: * -> *) a c b d.
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)
forall (f :: * -> *) a c b d.
Applicative f =>
(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
swapThese :: forall a b. These a b -> These b a
swapThese = These a b -> These b a
forall a b. These a b -> These b a
forall (p :: * -> * -> *) a b. Swap p => p a b -> p b a
swap

-- | 'These' is associative.
--
-- @
-- 'assocThese' . 'unassocThese' = 'id'
-- 'unassocThese' . 'assocThese' = 'id'
-- @
--
-- @since 0.8
assocThese :: These (These a b) c -> These a (These b c)
assocThese :: forall a b c. These (These a b) c -> These a (These b c)
assocThese = These (These a b) c -> These a (These b c)
forall a b c. 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

-- | 'These' is associative. See 'assocThese'.
--
-- @since 0.8
unassocThese :: These a (These b c) -> These (These a b) c
unassocThese :: forall a b c. These a (These b c) -> These (These a b) c
unassocThese = These a (These b c) -> These (These a b) c
forall a b c. 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

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

-- |
--
-- >>> justHere (This 'x')
-- Just 'x'
--
-- >>> justHere (That 'y')
-- Nothing
--
-- >>> justHere (These 'x' 'y')
-- Just 'x'
--
justHere :: These a b -> Maybe a
justHere :: forall a b. 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 :: forall a b. 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 :: forall a b. 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 :: forall a b. 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 :: forall a b. 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 :: forall a b. [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 :: forall a b. [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 :: forall a b. [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 :: forall a b. [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 :: forall a b. [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 :: forall a b. 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 :: forall a b. 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 :: forall a b. 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 :: forall a b. 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 :: forall a b. 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 :: forall a b. (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 :: forall b a. (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 :: forall a b. ((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