{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Strict.Optics (
_Left, _Right,
_Just, _Nothing,
here, there,
_This, _That, _These,
strict, lazy,
) where
import Control.Applicative (pure, (<$>), (<*>))
import Prelude (Int, flip, ($), (.))
import qualified Prelude as L
import Optics.Core (Each (..), Field1 (..), Field2 (..),
Index, Iso', Prism, Prism', Swapped (..),
Traversal, iso, itraversalVL, lensVL,
prism, prism', traversalVL, (<&>))
import Data.Strict (Either (..), Maybe (..), Pair (..),
Strict (..), These (..), either, maybe,
swap, these)
instance Field1 (Pair a b) (Pair a' b) a a' where
_1 :: Lens (Pair a b) (Pair a' b) a a'
_1 = LensVL (Pair a b) (Pair a' b) a a'
-> Lens (Pair a b) (Pair a' b) a a'
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL (Pair a b) (Pair a' b) a a'
-> Lens (Pair a b) (Pair a' b) a a')
-> LensVL (Pair a b) (Pair a' b) a a'
-> Lens (Pair a b) (Pair a' b) a a'
forall a b. (a -> b) -> a -> b
$ \a -> f a'
k (a
a :!: b
b) -> a -> f a'
k a
a f a' -> (a' -> Pair a' b) -> f (Pair a' b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a'
a' -> (a'
a' a' -> b -> Pair a' b
forall a b. a -> b -> Pair a b
:!: b
b)
instance Field2 (Pair a b) (Pair a b') b b' where
_2 :: Lens (Pair a b) (Pair a b') b b'
_2 = LensVL (Pair a b) (Pair a b') b b'
-> Lens (Pair a b) (Pair a b') b b'
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL (Pair a b) (Pair a b') b b'
-> Lens (Pair a b) (Pair a b') b b')
-> LensVL (Pair a b) (Pair a b') b b'
-> Lens (Pair a b) (Pair a b') b b'
forall a b. (a -> b) -> a -> b
$ \b -> f b'
k (a
a :!: b
b) -> b -> f b'
k b
b f b' -> (b' -> Pair a b') -> f (Pair a b')
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \b'
b' -> (a
a a -> b' -> Pair a b'
forall a b. a -> b -> Pair a b
:!: b'
b')
instance Swapped Pair where
swapped :: forall a b c d. Iso (Pair a b) (Pair c d) (Pair b a) (Pair d c)
swapped = (Pair a b -> Pair b a)
-> (Pair d c -> Pair c d)
-> Iso (Pair a b) (Pair c d) (Pair b a) (Pair d c)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Pair a b -> Pair b a
forall a b. Pair a b -> Pair b a
swap Pair d c -> Pair c d
forall a b. Pair a b -> Pair b a
swap
type instance Index (Pair a b) = Int
instance (a~a', b~b') => Each Int (Pair a a') (Pair b b') a b where
each :: IxTraversal Int (Pair a a') (Pair b b') a b
each = IxTraversalVL Int (Pair a a') (Pair b b') a b
-> IxTraversal Int (Pair a a') (Pair b b') a b
forall i s t a b. IxTraversalVL i s t a b -> IxTraversal i s t a b
itraversalVL (IxTraversalVL Int (Pair a a') (Pair b b') a b
-> IxTraversal Int (Pair a a') (Pair b b') a b)
-> IxTraversalVL Int (Pair a a') (Pair b b') a b
-> IxTraversal Int (Pair a a') (Pair b b') a b
forall a b. (a -> b) -> a -> b
$ \Int -> a -> f b
f ~(a
a :!: a'
b) -> b -> b' -> Pair b b'
forall a b. a -> b -> Pair a b
(:!:) (b -> b' -> Pair b b') -> f b -> f (b' -> Pair b b')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> f b
f Int
0 a
a f (b' -> Pair b b') -> f b' -> f (Pair b b')
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> a -> f b
f Int
1 a
a'
b
{-# INLINE each #-}
instance Swapped Either where
swapped :: forall a b c d.
Iso (Either a b) (Either c d) (Either b a) (Either d c)
swapped = (a -> Either b a) -> (b -> Either b a) -> Either a b -> Either b a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Either b a
forall a b. b -> Either a b
Right b -> Either b a
forall a b. a -> Either a b
Left (Either a b -> Either b a)
-> (Either d c -> Either c d)
-> Iso (Either a b) (Either c d) (Either b a) (Either d c)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
`iso` (d -> Either c d) -> (c -> Either c d) -> Either d c -> Either c d
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either d -> Either c d
forall a b. b -> Either a b
Right c -> Either c d
forall a b. a -> Either a b
Left
instance (a ~ a', b ~ b') => Each (Either () ()) (Either a a') (Either b b') a b where
each :: IxTraversal (Either () ()) (Either a a') (Either b b') a b
each = IxTraversalVL (Either () ()) (Either a a') (Either b b') a b
-> IxTraversal (Either () ()) (Either a a') (Either b b') a b
forall i s t a b. IxTraversalVL i s t a b -> IxTraversal i s t a b
itraversalVL (Either () () -> a -> f b) -> Either a a -> f (Either b b)
(Either () () -> a -> f b) -> Either a a' -> f (Either b b')
IxTraversalVL (Either () ()) (Either a a') (Either b b') a b
forall {f :: * -> *} {t} {b}.
Functor f =>
(Either () () -> t -> f b) -> Either t t -> f (Either b b)
aux where
aux :: (Either () () -> t -> f b) -> Either t t -> f (Either b b)
aux Either () () -> t -> f b
f (Left t
x) = b -> Either b b
forall a b. a -> Either a b
Left (b -> Either b b) -> f b -> f (Either b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either () () -> t -> f b
f (() -> Either () ()
forall a b. a -> Either a b
Left ()) t
x
aux Either () () -> t -> f b
f (Right t
x) = b -> Either b b
forall a b. b -> Either a b
Right (b -> Either b b) -> f b -> f (Either b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either () () -> t -> f b
f (() -> Either () ()
forall a b. b -> Either a b
Right ()) t
x
_Left :: Prism (Either a c) (Either b c) a b
_Left :: forall a c b. Prism (Either a c) (Either b c) a b
_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)
_Right :: Prism (Either c a) (Either c b) a b
_Right :: forall c a b. Prism (Either c a) (Either c b) a 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
instance Each () (Maybe a) (Maybe b) a b where
each :: IxTraversal () (Maybe a) (Maybe b) a b
each = IxTraversalVL () (Maybe a) (Maybe b) a b
-> IxTraversal () (Maybe a) (Maybe b) a b
forall i s t a b. IxTraversalVL i s t a b -> IxTraversal i s t a b
itraversalVL (() -> a -> f b) -> Maybe a -> f (Maybe b)
IxTraversalVL () (Maybe a) (Maybe b) a b
forall {f :: * -> *} {t} {a}.
Applicative f =>
(() -> t -> f a) -> Maybe t -> f (Maybe a)
aux where
aux :: (() -> t -> f a) -> Maybe t -> f (Maybe a)
aux () -> t -> f a
_ Maybe t
Nothing = Maybe a -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
aux () -> t -> f a
f (Just t
x) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> f a -> f (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> () -> t -> f a
f () t
x
_Just :: Prism (Maybe a) (Maybe b) a b
_Just :: forall a b. Prism (Maybe a) (Maybe b) a 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
_Nothing :: Prism' (Maybe a) ()
_Nothing :: forall a. Prism' (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)
instance Swapped These where
swapped :: forall a b c d. Iso (These a b) (These c d) (These b a) (These d c)
swapped = (These a b -> These b a)
-> (These d c -> These c d)
-> Iso (These a b) (These c d) (These b a) (These d c)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso These a b -> These b a
forall a b. These a b -> These b a
swapThese These d c -> These c d
forall a b. These a b -> These b a
swapThese
instance (a ~ a', b ~ b') => Each (Either () ()) (These a a') (These b b') a b where
each :: IxTraversal (Either () ()) (These a a') (These b b') a b
each = IxTraversalVL (Either () ()) (These a a') (These b b') a b
-> IxTraversal (Either () ()) (These a a') (These b b') a b
forall i s t a b. IxTraversalVL i s t a b -> IxTraversal i s t a b
itraversalVL (Either () () -> a -> f b) -> These a a -> f (These b b)
(Either () () -> a -> f b) -> These a a' -> f (These b b')
IxTraversalVL (Either () ()) (These a a') (These b b') a b
forall {f :: * -> *} {t} {b}.
Applicative f =>
(Either () () -> t -> f b) -> These t t -> f (These b b)
aux where
aux :: (Either () () -> t -> f b) -> These t t -> f (These b b)
aux Either () () -> t -> f b
f (This t
a) = b -> These b b
forall a b. a -> These a b
This (b -> These b b) -> f b -> f (These b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either () () -> t -> f b
f (() -> Either () ()
forall a b. a -> Either a b
Left ()) t
a
aux Either () () -> t -> f b
f (That t
b) = b -> These b b
forall a b. b -> These a b
That (b -> These b b) -> f b -> f (These b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either () () -> t -> f b
f (() -> Either () ()
forall a b. b -> Either a b
Right ()) t
b
aux Either () () -> t -> f b
f (These t
a t
b) = b -> b -> These b b
forall a b. a -> b -> These a b
These (b -> b -> These b b) -> f b -> f (b -> These b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either () () -> t -> f b
f (() -> Either () ()
forall a b. a -> Either a b
Left ()) t
a f (b -> These b b) -> f b -> f (These b b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either () () -> t -> f b
f (() -> Either () ()
forall a b. b -> Either a b
Right ()) t
b
here :: Traversal (These a c) (These b c) a b
here :: forall a c b. Traversal (These a c) (These b c) a b
here = TraversalVL (These a c) (These b c) a b
-> Traversal (These a c) (These b c) a b
forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL (a -> f b) -> These a c -> f (These b c)
TraversalVL (These a c) (These b c) a b
forall {f :: * -> *} {t} {a} {b}.
Applicative f =>
(t -> f a) -> These t b -> f (These a b)
aux where
aux :: (t -> f a) -> These t b -> f (These a b)
aux t -> f a
f (This t
x) = a -> These a b
forall a b. a -> These a b
This (a -> These a b) -> f a -> f (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> f a
f t
x
aux t -> f a
f (These t
x b
y) = (a -> b -> These a b) -> b -> a -> These a b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> These a b
forall a b. a -> b -> These a b
These b
y (a -> These a b) -> f a -> f (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> f a
f t
x
aux t -> f a
_ (That b
x) = These a b -> f (These a b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> These a b
forall a b. b -> These a b
That b
x)
there :: Traversal (These c a) (These c b) a b
there :: forall c a b. Traversal (These c a) (These c b) a b
there = TraversalVL (These c a) (These c b) a b
-> Traversal (These c a) (These c b) a b
forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL (a -> f b) -> These c a -> f (These c b)
TraversalVL (These c a) (These c b) a b
forall {f :: * -> *} {t} {b} {a}.
Applicative f =>
(t -> f b) -> These a t -> f (These a b)
aux where
aux :: (t -> f b) -> These a t -> f (These a b)
aux t -> f b
_ (This a
x) = These a b -> f (These a b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> These a b
forall a b. a -> These a b
This a
x)
aux t -> f b
f (These a
x t
y) = a -> b -> These a b
forall a b. a -> b -> These a b
These a
x (b -> These a b) -> f b -> f (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> f b
f t
y
aux t -> f b
f (That t
x) = b -> These a b
forall a b. b -> These a b
That (b -> These a b) -> f b -> f (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> f b
f t
x
_This :: Prism' (These a b) a
_This :: forall a b. Prism' (These a b) a
_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))
_That :: Prism' (These a b) b
_That :: forall a b. Prism' (These a b) 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))
_These :: Prism' (These a b) (a, b)
_These :: forall a b. Prism' (These a b) (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)))
swapThese :: These a b -> These b a
swapThese :: forall a b. These a b -> These b a
swapThese (This a
a) = a -> These b a
forall a b. b -> These a b
That a
a
swapThese (That b
b) = b -> These b a
forall a b. a -> These a b
This b
b
swapThese (These a
a b
b) = b -> a -> These b a
forall a b. a -> b -> These a b
These b
b a
a
strict :: Strict lazy strict => Iso' lazy strict
strict :: forall lazy strict. Strict lazy strict => Iso' lazy strict
strict = (lazy -> strict) -> (strict -> lazy) -> Iso lazy lazy strict strict
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso lazy -> strict
forall lazy strict. Strict lazy strict => lazy -> strict
toStrict strict -> lazy
forall lazy strict. Strict lazy strict => strict -> lazy
toLazy
lazy :: Strict lazy strict => Iso' strict lazy
lazy :: forall lazy strict. Strict lazy strict => Iso' strict lazy
lazy = (strict -> lazy) -> (lazy -> strict) -> Iso strict strict lazy lazy
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso strict -> lazy
forall lazy strict. Strict lazy strict => strict -> lazy
toLazy lazy -> strict
forall lazy strict. Strict lazy strict => lazy -> strict
toStrict