{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Strict.Lens (
    -- * Tuple
    -- | See instances, in particular for 'Field1' and 'Field2' type classes.
    -- * Either
    _Left, _Right,
    -- * Maybe
    _Just, _Nothing,
    -- * These
    here, there,
    _This, _That, _These,
    ) where


import           Control.Applicative (pure, (<$>))
import           Prelude             (Int, flip, ($), (.))

-- Lazy variants
import qualified Prelude             as L

import           Control.Lens        (Index, Prism, Prism', Traversal, prism,
                                      prism')

import           Data.Strict         (Either (..), Maybe (..), Pair (..),
                                      These (..), either, maybe, these)

#if !MIN_VERSION_lens(5,0,0)
import           Control.Applicative ((<*>))
import           Control.Lens        (Each (..), Field1 (..), Field2 (..),
                                      Swapped (..), indexed, iso, (<&>))
import qualified Control.Lens        as L
import           Data.Strict         (Strict (..), swap)
#endif

-------------------------------------------------------------------------------
-- Tuple
-------------------------------------------------------------------------------

#if !MIN_VERSION_lens(5,0,0)
instance Field1 (Pair a b) (Pair a' b) a a' where
  _1 k (a :!: b) = indexed k (0 :: Int) a <&> \a' -> (a' :!: b)

instance Field2 (Pair a b) (Pair a b') b b' where
  _2 k (a :!: b) = indexed k (1 :: Int) b <&> \b' -> (a :!: b')

instance L.Strict (a, b) (Pair a b) where
  strict = iso toStrict toLazy

instance Swapped Pair where
  swapped = iso swap swap

instance (a~a', b~b') => Each (Pair a a') (Pair b b') a b where
  each f ~(a :!: b) = (:!:) <$> f a <*> f b
  {-# INLINE each #-}
#endif

-- TODO: this should be removed. Probably.
type instance Index (Pair a b) = Int

-------------------------------------------------------------------------------
-- Either
-------------------------------------------------------------------------------

#if !MIN_VERSION_lens(5,0,0)
instance L.Strict (L.Either a b) (Either a b) where
  strict = iso toStrict toLazy

instance Swapped Either where
  swapped = either Right Left `iso` either Right Left

instance (a ~ a', b ~ b') => Each (Either a a') (Either b b') a b where
  each f (Left x)  = Left <$> f x
  each f (Right x) = Right <$> f x
#endif

-- | Analogous to 'Control.Lens.Prism._Left' in "Control.Lens.Prism".
_Left :: Prism (Either a c) (Either b c) a b
_Left :: p a (f b) -> p (Either a c) (f (Either b c))
_Left = (b -> Either b c)
-> (Either a c -> Either (Either b c) a)
-> Prism (Either a c) (Either b c) a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> Either b c
forall a b. a -> Either a b
Left ((Either a c -> Either (Either b c) a)
 -> Prism (Either a c) (Either b c) a b)
-> (Either a c -> Either (Either b c) a)
-> Prism (Either a c) (Either b c) a b
forall a b. (a -> b) -> a -> b
$ (a -> Either (Either b c) a)
-> (c -> Either (Either b c) a)
-> Either a c
-> Either (Either b c) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Either (Either b c) a
forall a b. b -> Either a b
L.Right (Either b c -> Either (Either b c) a
forall a b. a -> Either a b
L.Left (Either b c -> Either (Either b c) a)
-> (c -> Either b c) -> c -> Either (Either b c) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either b c
forall a b. b -> Either a b
Right)

-- | Analogous to 'Control.Lens.Prism._Right' in "Control.Lens.Prism".
_Right :: Prism (Either c a) (Either c b) a b
_Right :: p a (f b) -> p (Either c a) (f (Either c b))
_Right = (b -> Either c b)
-> (Either c a -> Either (Either c b) a)
-> Prism (Either c a) (Either c b) a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> Either c b
forall a b. b -> Either a b
Right ((Either c a -> Either (Either c b) a)
 -> Prism (Either c a) (Either c b) a b)
-> (Either c a -> Either (Either c b) a)
-> Prism (Either c a) (Either c b) a b
forall a b. (a -> b) -> a -> b
$ (c -> Either (Either c b) a)
-> (a -> Either (Either c b) a)
-> Either c a
-> Either (Either c b) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either c b -> Either (Either c b) a
forall a b. a -> Either a b
L.Left (Either c b -> Either (Either c b) a)
-> (c -> Either c b) -> c -> Either (Either c b) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either c b
forall a b. a -> Either a b
Left) a -> Either (Either c b) a
forall a b. b -> Either a b
L.Right

-------------------------------------------------------------------------------
-- Maybe
-------------------------------------------------------------------------------

#if !MIN_VERSION_lens(5,0,0)
instance L.Strict (L.Maybe a) (Maybe a) where
  strict = iso toStrict toLazy

instance Each (Maybe a) (Maybe b) a b
#endif

-- | Analogous to 'Control.Lens.Prism._Just' in "Control.Lens.Prism"
_Just :: Prism (Maybe a) (Maybe b) a b
_Just :: p a (f b) -> p (Maybe a) (f (Maybe b))
_Just = (b -> Maybe b)
-> (Maybe a -> Either (Maybe b) a) -> Prism (Maybe a) (Maybe b) a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> Maybe b
forall a. a -> Maybe a
Just ((Maybe a -> Either (Maybe b) a) -> Prism (Maybe a) (Maybe b) a b)
-> (Maybe a -> Either (Maybe b) a) -> Prism (Maybe a) (Maybe b) a b
forall a b. (a -> b) -> a -> b
$ Either (Maybe b) a
-> (a -> Either (Maybe b) a) -> Maybe a -> Either (Maybe b) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe b -> Either (Maybe b) a
forall a b. a -> Either a b
L.Left Maybe b
forall a. Maybe a
Nothing) a -> Either (Maybe b) a
forall a b. b -> Either a b
L.Right

-- | Analogous to 'Control.Lens.Prism._Nothing' in "Control.Lens.Prism"
_Nothing :: Prism' (Maybe a) ()
_Nothing :: p () (f ()) -> p (Maybe a) (f (Maybe a))
_Nothing = (() -> Maybe a)
-> (Maybe a -> Maybe ()) -> Prism (Maybe a) (Maybe a) () ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (Maybe a -> () -> Maybe a
forall a b. a -> b -> a
L.const Maybe a
forall a. Maybe a
Nothing) ((Maybe a -> Maybe ()) -> Prism (Maybe a) (Maybe a) () ())
-> (Maybe a -> Maybe ()) -> Prism (Maybe a) (Maybe a) () ()
forall a b. (a -> b) -> a -> b
$ Maybe () -> (a -> Maybe ()) -> Maybe a -> Maybe ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Maybe ()
forall a. a -> Maybe a
L.Just ()) (Maybe () -> a -> Maybe ()
forall a b. a -> b -> a
L.const Maybe ()
forall a. Maybe a
L.Nothing)

-------------------------------------------------------------------------------
-- These
-------------------------------------------------------------------------------

#if !MIN_VERSION_lens(5,0,0)
instance Swapped These where
    swapped = iso swapThese swapThese

swapThese :: These a b -> These b a
swapThese (This a)    = That a
swapThese (That b)    = This b
swapThese (These a b) = These b a

instance (a ~ a', b ~ b') => Each (These a a') (These b b') a b where
    each f (This a)    = This <$> f a
    each f (That b)    = That <$> f b
    each f (These a b) = These <$> f a <*> f b
#endif

-- | A 'Control.Lens.Traversal' of the first half of a 'These', suitable for use with "Control.Lens".
--
-- >>> over here show (That 1)
-- That 1
--
-- >>> over here show (These 'a' 2)
-- These "'a'" 2
--
here :: Traversal (These a c) (These b c) a b
here :: (a -> f b) -> These a c -> f (These b c)
here a -> f b
f (This a
x)    = b -> These b c
forall a b. a -> These a b
This (b -> These b c) -> f b -> f (These b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
here a -> f b
f (These a
x c
y) = (b -> c -> These b c) -> c -> b -> These b c
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> c -> These b c
forall a b. a -> b -> These a b
These c
y (b -> These b c) -> f b -> f (These b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
here a -> f b
_ (That c
x)    = These b c -> f (These b c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c -> These b c
forall a b. b -> These a b
That c
x)

-- | A 'Control.Lens.Traversal' of the second half of a 'These', suitable for use with "Control.Lens".
--
-- @
-- 'there' :: 'Control.Lens.Traversal' ('These' t b) ('These' t b) a b
-- @
--
-- >>> over there show (That 1)
-- That "1"
--
-- >>> over there show (These 'a' 2)
-- These 'a' "2"
--
there :: Traversal (These c a) (These c b) a b
there :: (a -> f b) -> These c a -> f (These c b)
there a -> f b
_ (This c
x)    = These c b -> f (These c b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c -> These c b
forall a b. a -> These a b
This c
x)
there a -> f b
f (These c
x a
y) = c -> b -> These c b
forall a b. a -> b -> These a b
These c
x (b -> These c b) -> f b -> f (These c b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
y
there a -> f b
f (That a
x)    = b -> These c b
forall a b. b -> These a b
That (b -> These c b) -> f b -> f (These c b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

-- | A 'Control.Lens.Prism'' selecting the 'This' constructor.
--
-- /Note:/ cannot change type.
_This :: Prism' (These a b) a
_This :: p a (f a) -> p (These a b) (f (These a b))
_This = (a -> These a b)
-> (These a b -> Either (These a b) a)
-> Prism (These a b) (These a b) a a
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism a -> These a b
forall a b. a -> These a b
This ((a -> Either (These a b) a)
-> (b -> Either (These a b) a)
-> (a -> b -> Either (These a b) a)
-> These a b
-> Either (These a b) a
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these a -> Either (These a b) a
forall a b. b -> Either a b
L.Right (These a b -> Either (These a b) a
forall a b. a -> Either a b
L.Left (These a b -> Either (These a b) a)
-> (b -> These a b) -> b -> Either (These a b) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> These a b
forall a b. b -> These a b
That) (\a
x b
y -> These a b -> Either (These a b) a
forall a b. a -> Either a b
L.Left (These a b -> Either (These a b) a)
-> These a b -> Either (These a b) a
forall a b. (a -> b) -> a -> b
$ a -> b -> These a b
forall a b. a -> b -> These a b
These a
x b
y))

-- | A 'Control.Lens.Prism'' selecting the 'That' constructor.
--
-- /Note:/ cannot change type.
_That :: Prism' (These a b) b
_That :: p b (f b) -> p (These a b) (f (These a b))
_That = (b -> These a b)
-> (These a b -> Either (These a b) b)
-> Prism (These a b) (These a b) b b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> These a b
forall a b. b -> These a b
That ((a -> Either (These a b) b)
-> (b -> Either (These a b) b)
-> (a -> b -> Either (These a b) b)
-> These a b
-> Either (These a b) b
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these (These a b -> Either (These a b) b
forall a b. a -> Either a b
L.Left (These a b -> Either (These a b) b)
-> (a -> These a b) -> a -> Either (These a b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> These a b
forall a b. a -> These a b
This) b -> Either (These a b) b
forall a b. b -> Either a b
L.Right (\a
x b
y -> These a b -> Either (These a b) b
forall a b. a -> Either a b
L.Left (These a b -> Either (These a b) b)
-> These a b -> Either (These a b) b
forall a b. (a -> b) -> a -> b
$ a -> b -> These a b
forall a b. a -> b -> These a b
These a
x b
y))

-- | A 'Control.Lens.Prism'' selecting the 'These' constructor. 'These' names are ridiculous!
--
-- /Note:/ cannot change type.
_These :: Prism' (These a b) (a, b)
_These :: p (a, b) (f (a, b)) -> p (These a b) (f (These a b))
_These = ((a, b) -> These a b)
-> (These a b -> Either (These a b) (a, b))
-> Prism (These a b) (These a b) (a, b) (a, b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (\(a
a,b
b) -> a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b) ((a -> Either (These a b) (a, b))
-> (b -> Either (These a b) (a, b))
-> (a -> b -> Either (These a b) (a, b))
-> These a b
-> Either (These a b) (a, b)
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these (These a b -> Either (These a b) (a, b)
forall a b. a -> Either a b
L.Left (These a b -> Either (These a b) (a, b))
-> (a -> These a b) -> a -> Either (These a b) (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> These a b
forall a b. a -> These a b
This) (These a b -> Either (These a b) (a, b)
forall a b. a -> Either a b
L.Left (These a b -> Either (These a b) (a, b))
-> (b -> These a b) -> b -> Either (These a b) (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> These a b
forall a b. b -> These a b
That) (\a
x b
y -> (a, b) -> Either (These a b) (a, b)
forall a b. b -> Either a b
L.Right (a
x, b
y)))