{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module       : Data.Wedge.Optics
-- Copyright 	: (c) 2020-2022 Emily Pillmore
-- License	: BSD-style
--
-- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>
-- Stability	: Experimental
-- Portability	: FlexibleInstances, MPTC, Type Families, UndecideableInstances
--
-- 'Prism's and 'Traversal's for the 'Wedge' datatype.
--
module Data.Wedge.Optics
( -- * Isos
  _WedgeIso
  -- * Traversals
, here
, there
  -- * Prisms
, _Nowhere
, _Here
, _There
) where


import Data.Wedge

import Optics.AffineTraversal
import Optics.Each.Core
import Optics.Iso
import Optics.IxTraversal
import Optics.Prism


-- ------------------------------------------------------------------- --
-- Isos

-- | A 'Control.Lens.Iso' between a wedge sum and pointed coproduct.
--
_WedgeIso :: Iso (Wedge a b) (Wedge c d) (Maybe (Either a b)) (Maybe (Either c d))
_WedgeIso :: Iso
  (Wedge a b) (Wedge c d) (Maybe (Either a b)) (Maybe (Either c d))
_WedgeIso = (Wedge a b -> Maybe (Either a b))
-> (Maybe (Either c d) -> Wedge c d)
-> Iso
     (Wedge a b) (Wedge c d) (Maybe (Either a b)) (Maybe (Either c d))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Wedge a b -> Maybe (Either a b)
forall a b. Wedge a b -> Maybe (Either a b)
f Maybe (Either c d) -> Wedge c d
forall a b. Maybe (Either a b) -> Wedge a b
g
  where
    f :: Wedge a b -> Maybe (Either a b)
f Wedge a b
Nowhere = Maybe (Either a b)
forall a. Maybe a
Nothing
    f (Here a
a) = Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (a -> Either a b
forall a b. a -> Either a b
Left a
a)
    f (There b
b) = Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (b -> Either a b
forall a b. b -> Either a b
Right b
b)

    g :: Maybe (Either a b) -> Wedge a b
g Maybe (Either a b)
Nothing = Wedge a b
forall a b. Wedge a b
Nowhere
    g (Just (Left a
a)) = a -> Wedge a b
forall a b. a -> Wedge a b
Here a
a
    g (Just (Right b
b)) = b -> Wedge a b
forall a b. b -> Wedge a b
There b
b

-- ------------------------------------------------------------------- --
-- Traversals

-- | An 'AffineTraversal' of the 'Here' case of a 'Wedge',
-- suitable for use with "Optics".
--
-- >>> over here show (Here 1)
-- Here "1"
--
-- >>> over here show (There 'a')
-- There 'a'
--
here :: AffineTraversal (Wedge a b) (Wedge a' b) a a'
here :: AffineTraversal (Wedge a b) (Wedge a' b) a a'
here = AffineTraversalVL (Wedge a b) (Wedge a' b) a a'
-> AffineTraversal (Wedge a b) (Wedge a' b) a a'
forall s t a b.
AffineTraversalVL s t a b -> AffineTraversal s t a b
atraversalVL (AffineTraversalVL (Wedge a b) (Wedge a' b) a a'
 -> AffineTraversal (Wedge a b) (Wedge a' b) a a')
-> AffineTraversalVL (Wedge a b) (Wedge a' b) a a'
-> AffineTraversal (Wedge a b) (Wedge a' b) a a'
forall a b. (a -> b) -> a -> b
$ \forall r. r -> f r
point a -> f a'
f -> \case
  Wedge a b
Nowhere -> Wedge a' b -> f (Wedge a' b)
forall r. r -> f r
point Wedge a' b
forall a b. Wedge a b
Nowhere
  Here a -> a' -> Wedge a' b
forall a b. a -> Wedge a b
Here (a' -> Wedge a' b) -> f a' -> f (Wedge a' b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a'
f a
a
  There b -> Wedge a' b -> f (Wedge a' b)
forall r. r -> f r
point (b -> Wedge a' b
forall a b. b -> Wedge a b
There b
b)

-- | An 'AffineTraversal' of the 'There' case of a 'Wedge',
-- suitable for use with "Optics".
--
-- >>> over there show (Here 1)
-- Here 1
--
-- >>> over there show (There 'a')
-- There "'a'"
--
there :: AffineTraversal (Wedge a b) (Wedge a b') b b'
there :: AffineTraversal (Wedge a b) (Wedge a b') b b'
there = AffineTraversalVL (Wedge a b) (Wedge a b') b b'
-> AffineTraversal (Wedge a b) (Wedge a b') b b'
forall s t a b.
AffineTraversalVL s t a b -> AffineTraversal s t a b
atraversalVL (AffineTraversalVL (Wedge a b) (Wedge a b') b b'
 -> AffineTraversal (Wedge a b) (Wedge a b') b b')
-> AffineTraversalVL (Wedge a b) (Wedge a b') b b'
-> AffineTraversal (Wedge a b) (Wedge a b') b b'
forall a b. (a -> b) -> a -> b
$ \forall r. r -> f r
point b -> f b'
f -> \case
  Wedge a b
Nowhere -> Wedge a b' -> f (Wedge a b')
forall r. r -> f r
point Wedge a b'
forall a b. Wedge a b
Nowhere
  Here a -> Wedge a b' -> f (Wedge a b')
forall r. r -> f r
point (a -> Wedge a b'
forall a b. a -> Wedge a b
Here a
a)
  There b -> b' -> Wedge a b'
forall a b. b -> Wedge a b
There (b' -> Wedge a b') -> f b' -> f (Wedge a b')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f b'
f b
b

-- ------------------------------------------------------------------- --
-- Prisms

-- | A 'Prism'' selecting the 'Nowhere' constructor.
--
-- /Note:/ this optic cannot change type.
--
_Nowhere :: Prism' (Wedge a b) ()
_Nowhere :: Prism' (Wedge a b) ()
_Nowhere = (() -> Wedge a b)
-> (Wedge a b -> Either (Wedge a b) ()) -> Prism' (Wedge a b) ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Wedge a b -> () -> Wedge a b
forall a b. a -> b -> a
const Wedge a b
forall a b. Wedge a b
Nowhere) ((Wedge a b -> Either (Wedge a b) ()) -> Prism' (Wedge a b) ())
-> (Wedge a b -> Either (Wedge a b) ()) -> Prism' (Wedge a b) ()
forall a b. (a -> b) -> a -> b
$ \case
  Wedge a b
Nowhere -> () -> Either (Wedge a b) ()
forall a b. b -> Either a b
Right ()
  Here a
a -> Wedge a b -> Either (Wedge a b) ()
forall a b. a -> Either a b
Left (a -> Wedge a b
forall a b. a -> Wedge a b
Here a
a)
  There b
b -> Wedge a b -> Either (Wedge a b) ()
forall a b. a -> Either a b
Left (b -> Wedge a b
forall a b. b -> Wedge a b
There b
b)

-- | A 'Prism'' selecting the 'Here' constructor.
--
_Here :: Prism (Wedge a b) (Wedge c b) a c
_Here :: Prism (Wedge a b) (Wedge c b) a c
_Here = (c -> Wedge c b)
-> (Wedge a b -> Either (Wedge c b) a)
-> Prism (Wedge a b) (Wedge c b) a c
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism c -> Wedge c b
forall a b. a -> Wedge a b
Here ((Wedge a b -> Either (Wedge c b) a)
 -> Prism (Wedge a b) (Wedge c b) a c)
-> (Wedge a b -> Either (Wedge c b) a)
-> Prism (Wedge a b) (Wedge c b) a c
forall a b. (a -> b) -> a -> b
$ \case
  Here a
a -> a -> Either (Wedge c b) a
forall a b. b -> Either a b
Right a
a
  There b
b -> Wedge c b -> Either (Wedge c b) a
forall a b. a -> Either a b
Left (b -> Wedge c b
forall a b. b -> Wedge a b
There b
b)
  Wedge a b
Nowhere -> Wedge c b -> Either (Wedge c b) a
forall a b. a -> Either a b
Left Wedge c b
forall a b. Wedge a b
Nowhere

-- | A 'Prism'' selecting the 'There' constructor.
--
_There :: Prism (Wedge a b) (Wedge a d) b d
_There :: Prism (Wedge a b) (Wedge a d) b d
_There = (d -> Wedge a d)
-> (Wedge a b -> Either (Wedge a d) b)
-> Prism (Wedge a b) (Wedge a d) b d
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism d -> Wedge a d
forall a b. b -> Wedge a b
There ((Wedge a b -> Either (Wedge a d) b)
 -> Prism (Wedge a b) (Wedge a d) b d)
-> (Wedge a b -> Either (Wedge a d) b)
-> Prism (Wedge a b) (Wedge a d) b d
forall a b. (a -> b) -> a -> b
$ \case
  There b
b -> b -> Either (Wedge a d) b
forall a b. b -> Either a b
Right b
b
  Here a
a -> Wedge a d -> Either (Wedge a d) b
forall a b. a -> Either a b
Left (a -> Wedge a d
forall a b. a -> Wedge a b
Here a
a)
  Wedge a b
Nowhere -> Wedge a d -> Either (Wedge a d) b
forall a b. a -> Either a b
Left (Wedge a d
forall a b. Wedge a b
Nowhere)

-- ------------------------------------------------------------------- --
-- Orphans

instance Swapped Wedge where
  swapped :: Iso (Wedge a b) (Wedge c d) (Wedge b a) (Wedge d c)
swapped = (Wedge a b -> Wedge b a)
-> (Wedge d c -> Wedge c d)
-> Iso (Wedge a b) (Wedge c d) (Wedge b a) (Wedge d c)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Wedge a b -> Wedge b a
forall a b. Wedge a b -> Wedge b a
swapWedge Wedge d c -> Wedge c d
forall a b. Wedge a b -> Wedge b a
swapWedge

instance (a ~ a', b ~ b') => Each Bool (Wedge a a') (Wedge b b') a b where
  each :: IxTraversal Bool (Wedge a a') (Wedge b b') a b
each = IxTraversalVL Bool (Wedge a a') (Wedge b b') a b
-> IxTraversal Bool (Wedge a a') (Wedge b b') a b
forall i s t a b. IxTraversalVL i s t a b -> IxTraversal i s t a b
itraversalVL (IxTraversalVL Bool (Wedge a a') (Wedge b b') a b
 -> IxTraversal Bool (Wedge a a') (Wedge b b') a b)
-> IxTraversalVL Bool (Wedge a a') (Wedge b b') a b
-> IxTraversal Bool (Wedge a a') (Wedge b b') a b
forall a b. (a -> b) -> a -> b
$ \Bool -> a -> f b
f -> \case
    Here a -> b -> Wedge b b'
forall a b. a -> Wedge a b
Here (b -> Wedge b b') -> f b -> f (Wedge b b')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> a -> f b
f Bool
True a
a
    There b -> b -> Wedge b' b
forall a b. b -> Wedge a b
There (b -> Wedge b' b) -> f b -> f (Wedge b' b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> a -> f b
f Bool
False a
b
    Wedge a a'
Nowhere -> Wedge b' b' -> f (Wedge b' b')
forall (f :: * -> *) a. Applicative f => a -> f a
pure Wedge b' b'
forall a b. Wedge a b
Nowhere