{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module       : Data.Wedge.Lens
-- Copyright 	: (c) 2020 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.Lens
( -- * Traversals
  here
, there
  -- * Prisms
, _Nowhere
, _Here
, _There
) where


import Control.Lens

import Data.Wedge

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

-- | A 'Control.Lens.Traversal' of the 'Here' case of a 'Wedge',
-- suitable for use with "Control.Lens".
--
-- >>> over here show (Here 1)
-- Here "1"
--
-- >>> over here show (There 'a')
-- There 'a'
--
here :: Traversal' (Wedge a b) a
here :: (a -> f a) -> Wedge a b -> f (Wedge a b)
here a -> f a
f = \case
  Wedge a b
Nowhere -> Wedge a b -> f (Wedge a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Wedge a b
forall a b. Wedge a b
Nowhere
  Here a
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
b -> Wedge a b -> f (Wedge a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Wedge a b
forall a b. b -> Wedge a b
There b
b)

-- | A 'Control.Lens.Traversal' of the 'There' case of a 'Wedge',
-- suitable for use with "Control.Lens".
--
-- >>> over there show (Here 1)
-- Here 1
--
-- >>> over there show (There 'a')
-- There "'a'"
--
there :: Traversal' (Wedge a b) b
there :: (b -> f b) -> Wedge a b -> f (Wedge a b)
there b -> f b
f = \case
  Wedge a b
Nowhere -> Wedge a b -> f (Wedge a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Wedge a b
forall a b. Wedge a b
Nowhere
  Here a
a -> Wedge a b -> f (Wedge a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Wedge a b
forall a b. a -> Wedge a b
Here a
a)
  There b
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 'Control.Lens.Prism'' selecting the 'Nowhere' constructor.
--
-- /Note:/ cannot change type.
--
_Nowhere :: Prism' (Wedge a b) ()
_Nowhere :: p () (f ()) -> p (Wedge a b) (f (Wedge a b))
_Nowhere = (() -> Wedge a b)
-> (Wedge a b -> Either (Wedge a b) ())
-> Prism (Wedge a b) (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) () ())
-> (Wedge a b -> Either (Wedge a b) ())
-> Prism (Wedge a b) (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 'Control.Lens.Prism'' selecting the 'Here' constructor.
--
-- /Note:/ cannot change type.
--
_Here :: Prism (Wedge a b) (Wedge c b) a c
_Here :: p a (f c) -> p (Wedge a b) (f (Wedge c b))
_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 'Control.Lens.Prism'' selecting the 'There' constructor.
--
-- /Note:/ cannot change type.
--
_There :: Prism (Wedge a b) (Wedge a d) b d
_There :: p b (f d) -> p (Wedge a b) (f (Wedge a 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 :: p (Wedge b a) (f (Wedge d c)) -> p (Wedge a b) (f (Wedge c d))
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 (Wedge a a') (Wedge b b') a b where
  each :: (a -> f b) -> Wedge a a' -> f (Wedge b b')
each a -> f 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
  each a -> f b
f (Here a
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
<$> a -> f b
f a
a
  each a -> f b
f (There a'
a) = 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
<$> a -> f b
f a
a'
a