{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
module Optics.Cons.Core
(
Cons(..)
, (<|)
, cons
, uncons
, _head, _tail
, pattern (:<)
, Snoc(..)
, (|>)
, snoc
, unsnoc
, _init, _last
, pattern (:>)
) where
import Control.Applicative (ZipList(..))
import Data.Coerce
import Data.Sequence hiding ((<|), (|>), (:<), (:>))
import qualified Data.Sequence as Seq
import Data.Tuple.Optics
import Optics.AffineFold
import Optics.AffineTraversal
import Optics.Coerce
import Optics.Internal.Utils
import Optics.Optic
import Optics.Prism
import Optics.Review
infixr 5 <|, `cons`
infixl 5 |>, `snoc`
pattern (:<) :: forall s a. Cons s s a a => a -> s -> s
pattern $b:< :: a -> s -> s
$m:< :: forall r s a.
Cons s s a a =>
s -> (a -> s -> r) -> (Void# -> r) -> r
(:<) a s <- (preview _Cons -> Just (a, s)) where
(:<) a
a s
s = Optic' A_Prism NoIx s (a, s) -> (a, s) -> s
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Prism NoIx s (a, s)
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons (a
a, s
s)
infixr 5 :<
infixl 5 :>
pattern (:>) :: forall s a. Snoc s s a a => s -> a -> s
pattern $b:> :: s -> a -> s
$m:> :: forall r s a.
Snoc s s a a =>
s -> (s -> a -> r) -> (Void# -> r) -> r
(:>) s a <- (preview _Snoc -> Just (s, a)) where
(:>) s
a a
s = Optic' A_Prism NoIx s (s, a) -> (s, a) -> s
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Prism NoIx s (s, a)
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc (s
a, a
s)
class Cons s t a b | s -> a, t -> b, s b -> t, t a -> s where
_Cons :: Prism s t (a, s) (b, t)
instance Cons [a] [b] a b where
_Cons :: Prism [a] [b] (a, [a]) (b, [b])
_Cons = ((b, [b]) -> [b])
-> ([a] -> Either [b] (a, [a])) -> Prism [a] [b] (a, [a]) (b, [b])
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((b -> [b] -> [b]) -> (b, [b]) -> [b]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry' (:)) (([a] -> Either [b] (a, [a])) -> Prism [a] [b] (a, [a]) (b, [b]))
-> ([a] -> Either [b] (a, [a])) -> Prism [a] [b] (a, [a]) (b, [b])
forall a b. (a -> b) -> a -> b
$ \[a]
aas -> case [a]
aas of
(a
a:[a]
as) -> (a, [a]) -> Either [b] (a, [a])
forall a b. b -> Either a b
Right (a
a, [a]
as)
[] -> [b] -> Either [b] (a, [a])
forall a b. a -> Either a b
Left []
{-# INLINE _Cons #-}
instance Cons (ZipList a) (ZipList b) a b where
_Cons :: Prism (ZipList a) (ZipList b) (a, ZipList a) (b, ZipList b)
_Cons = Optic A_Prism NoIx [a] (ZipList b) (a, ZipList a) (b, ZipList b)
-> Prism (ZipList a) (ZipList b) (a, ZipList a) (b, ZipList b)
forall s s' k (is :: IxList) t a b.
Coercible s s' =>
Optic k is s t a b -> Optic k is s' t a b
coerceS (Optic A_Prism NoIx [a] (ZipList b) (a, ZipList a) (b, ZipList b)
-> Prism (ZipList a) (ZipList b) (a, ZipList a) (b, ZipList b))
-> (Optic A_Prism NoIx [a] [b] (a, [a]) (b, [b])
-> Optic
A_Prism NoIx [a] (ZipList b) (a, ZipList a) (b, ZipList b))
-> Optic A_Prism NoIx [a] [b] (a, [a]) (b, [b])
-> Prism (ZipList a) (ZipList b) (a, ZipList a) (b, ZipList b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic A_Prism NoIx [a] [b] (a, ZipList a) (b, ZipList b)
-> Optic A_Prism NoIx [a] (ZipList b) (a, ZipList a) (b, ZipList b)
forall t t' k (is :: IxList) s a b.
Coercible t t' =>
Optic k is s t a b -> Optic k is s t' a b
coerceT (Optic A_Prism NoIx [a] [b] (a, ZipList a) (b, ZipList b)
-> Optic
A_Prism NoIx [a] (ZipList b) (a, ZipList a) (b, ZipList b))
-> (Optic A_Prism NoIx [a] [b] (a, [a]) (b, [b])
-> Optic A_Prism NoIx [a] [b] (a, ZipList a) (b, ZipList b))
-> Optic A_Prism NoIx [a] [b] (a, [a]) (b, [b])
-> Optic A_Prism NoIx [a] (ZipList b) (a, ZipList a) (b, ZipList b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic A_Prism NoIx [a] [b] (a, [a]) (b, ZipList b)
-> Optic A_Prism NoIx [a] [b] (a, ZipList a) (b, ZipList b)
forall a a' k (is :: IxList) s t b.
Coercible a a' =>
Optic k is s t a b -> Optic k is s t a' b
coerceA (Optic A_Prism NoIx [a] [b] (a, [a]) (b, ZipList b)
-> Optic A_Prism NoIx [a] [b] (a, ZipList a) (b, ZipList b))
-> (Optic A_Prism NoIx [a] [b] (a, [a]) (b, [b])
-> Optic A_Prism NoIx [a] [b] (a, [a]) (b, ZipList b))
-> Optic A_Prism NoIx [a] [b] (a, [a]) (b, [b])
-> Optic A_Prism NoIx [a] [b] (a, ZipList a) (b, ZipList b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic A_Prism NoIx [a] [b] (a, [a]) (b, [b])
-> Optic A_Prism NoIx [a] [b] (a, [a]) (b, ZipList b)
forall b b' k (is :: IxList) s t a.
Coercible b b' =>
Optic k is s t a b -> Optic k is s t a b'
coerceB (Optic A_Prism NoIx [a] [b] (a, [a]) (b, [b])
-> Prism (ZipList a) (ZipList b) (a, ZipList a) (b, ZipList b))
-> Optic A_Prism NoIx [a] [b] (a, [a]) (b, [b])
-> Prism (ZipList a) (ZipList b) (a, ZipList a) (b, ZipList b)
forall a b. (a -> b) -> a -> b
$ Optic A_Prism NoIx [a] [b] (a, [a]) (b, [b])
listCons
where
listCons :: Prism [a] [b] (a, [a]) (b, [b])
listCons :: Optic A_Prism NoIx [a] [b] (a, [a]) (b, [b])
listCons = Optic A_Prism NoIx [a] [b] (a, [a]) (b, [b])
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons
{-# INLINE _Cons #-}
instance Cons (Seq a) (Seq b) a b where
_Cons :: Prism (Seq a) (Seq b) (a, Seq a) (b, Seq b)
_Cons = ((b, Seq b) -> Seq b)
-> (Seq a -> Either (Seq b) (a, Seq a))
-> Prism (Seq a) (Seq b) (a, Seq a) (b, Seq b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((b -> Seq b -> Seq b) -> (b, Seq b) -> Seq b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry' b -> Seq b -> Seq b
forall a. a -> Seq a -> Seq a
(Seq.<|)) ((Seq a -> Either (Seq b) (a, Seq a))
-> Prism (Seq a) (Seq b) (a, Seq a) (b, Seq b))
-> (Seq a -> Either (Seq b) (a, Seq a))
-> Prism (Seq a) (Seq b) (a, Seq a) (b, Seq b)
forall a b. (a -> b) -> a -> b
$ \Seq a
aas -> case Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
aas of
a
a Seq.:< Seq a
as -> (a, Seq a) -> Either (Seq b) (a, Seq a)
forall a b. b -> Either a b
Right (a
a, Seq a
as)
ViewL a
EmptyL -> Seq b -> Either (Seq b) (a, Seq a)
forall a b. a -> Either a b
Left Seq b
forall a. Monoid a => a
mempty
{-# INLINE _Cons #-}
(<|) :: Cons s s a a => a -> s -> s
<| :: a -> s -> s
(<|) = ((a, s) -> s) -> a -> s -> s
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Optic' A_Prism NoIx s (a, s) -> (a, s) -> s
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Prism NoIx s (a, s)
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons)
{-# INLINE (<|) #-}
cons :: Cons s s a a => a -> s -> s
cons :: a -> s -> s
cons = ((a, s) -> s) -> a -> s -> s
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Optic' A_Prism NoIx s (a, s) -> (a, s) -> s
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Prism NoIx s (a, s)
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons)
{-# INLINE cons #-}
uncons :: Cons s s a a => s -> Maybe (a, s)
uncons :: s -> Maybe (a, s)
uncons = Optic' A_Prism NoIx s (a, s) -> s -> Maybe (a, s)
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic' A_Prism NoIx s (a, s)
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons
{-# INLINE uncons #-}
_head :: Cons s s a a => AffineTraversal' s a
_head :: AffineTraversal' s a
_head = Prism s s (a, s) (a, s)
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons Prism s s (a, s) (a, s)
-> Optic A_Lens NoIx (a, s) (a, s) a a -> AffineTraversal' s a
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx (a, s) (a, s) a a
forall s t a b. Field1 s t a b => Lens s t a b
_1
{-# INLINE _head #-}
_tail :: Cons s s a a => AffineTraversal' s s
_tail :: AffineTraversal' s s
_tail = Prism s s (a, s) (a, s)
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons Prism s s (a, s) (a, s)
-> Optic A_Lens NoIx (a, s) (a, s) s s -> AffineTraversal' s s
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx (a, s) (a, s) s s
forall s t a b. Field2 s t a b => Lens s t a b
_2
{-# INLINE _tail #-}
class Snoc s t a b | s -> a, t -> b, s b -> t, t a -> s where
_Snoc :: Prism s t (s, a) (t, b)
instance Snoc [a] [b] a b where
_Snoc :: Prism [a] [b] ([a], a) ([b], b)
_Snoc = (([b], b) -> [b])
-> ([a] -> Either [b] ([a], a)) -> Prism [a] [b] ([a], a) ([b], b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (\([b]
as,b
a) -> [b]
as [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
Prelude.++ [b
a]) (([a] -> Either [b] ([a], a)) -> Prism [a] [b] ([a], a) ([b], b))
-> ([a] -> Either [b] ([a], a)) -> Prism [a] [b] ([a], a) ([b], b)
forall a b. (a -> b) -> a -> b
$ \[a]
aas -> if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [a]
aas
then [b] -> Either [b] ([a], a)
forall a b. a -> Either a b
Left []
else ([a], a) -> Either [b] ([a], a)
forall a b. b -> Either a b
Right ([a] -> [a]
forall a. [a] -> [a]
Prelude.init [a]
aas, [a] -> a
forall a. [a] -> a
Prelude.last [a]
aas)
{-# INLINE _Snoc #-}
instance Snoc (ZipList a) (ZipList b) a b where
_Snoc :: Prism (ZipList a) (ZipList b) (ZipList a, a) (ZipList b, b)
_Snoc = Optic A_Prism NoIx [a] [b] ([a], a) ([b], b)
-> ((([b], b) -> [b])
-> ([a] -> Either [b] ([a], a))
-> Prism (ZipList a) (ZipList b) (ZipList a, a) (ZipList b, b))
-> Prism (ZipList a) (ZipList b) (ZipList a, a) (ZipList b, b)
forall k (is :: IxList) s t a b r.
Is k A_Prism =>
Optic k is s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism Optic A_Prism NoIx [a] [b] ([a], a) ([b], b)
listSnoc (((([b], b) -> [b])
-> ([a] -> Either [b] ([a], a))
-> Prism (ZipList a) (ZipList b) (ZipList a, a) (ZipList b, b))
-> Prism (ZipList a) (ZipList b) (ZipList a, a) (ZipList b, b))
-> ((([b], b) -> [b])
-> ([a] -> Either [b] ([a], a))
-> Prism (ZipList a) (ZipList b) (ZipList a, a) (ZipList b, b))
-> Prism (ZipList a) (ZipList b) (ZipList a, a) (ZipList b, b)
forall a b. (a -> b) -> a -> b
$ \([b], b) -> [b]
listReview [a] -> Either [b] ([a], a)
listPreview ->
((ZipList b, b) -> ZipList b)
-> (ZipList a -> Either (ZipList b) (ZipList a, a))
-> Prism (ZipList a) (ZipList b) (ZipList a, a) (ZipList b, b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((([b], b) -> [b]) -> (ZipList b, b) -> ZipList b
coerce ([b], b) -> [b]
listReview) (([a] -> Either [b] ([a], a))
-> ZipList a -> Either (ZipList b) (ZipList a, a)
coerce [a] -> Either [b] ([a], a)
listPreview) where
listSnoc :: Prism [a] [b] ([a], a) ([b], b)
listSnoc :: Optic A_Prism NoIx [a] [b] ([a], a) ([b], b)
listSnoc = Optic A_Prism NoIx [a] [b] ([a], a) ([b], b)
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc
{-# INLINE _Snoc #-}
instance Snoc (Seq a) (Seq b) a b where
_Snoc :: Prism (Seq a) (Seq b) (Seq a, a) (Seq b, b)
_Snoc = ((Seq b, b) -> Seq b)
-> (Seq a -> Either (Seq b) (Seq a, a))
-> Prism (Seq a) (Seq b) (Seq a, a) (Seq b, b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((Seq b -> b -> Seq b) -> (Seq b, b) -> Seq b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry' Seq b -> b -> Seq b
forall a. Seq a -> a -> Seq a
(Seq.|>)) ((Seq a -> Either (Seq b) (Seq a, a))
-> Prism (Seq a) (Seq b) (Seq a, a) (Seq b, b))
-> (Seq a -> Either (Seq b) (Seq a, a))
-> Prism (Seq a) (Seq b) (Seq a, a) (Seq b, b)
forall a b. (a -> b) -> a -> b
$ \Seq a
aas -> case Seq a -> ViewR a
forall a. Seq a -> ViewR a
viewr Seq a
aas of
Seq a
as Seq.:> a
a -> (Seq a, a) -> Either (Seq b) (Seq a, a)
forall a b. b -> Either a b
Right (Seq a
as, a
a)
ViewR a
EmptyR -> Seq b -> Either (Seq b) (Seq a, a)
forall a b. a -> Either a b
Left Seq b
forall a. Monoid a => a
mempty
{-# INLINE _Snoc #-}
_init :: Snoc s s a a => AffineTraversal' s s
_init :: AffineTraversal' s s
_init = Prism s s (s, a) (s, a)
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc Prism s s (s, a) (s, a)
-> Optic A_Lens NoIx (s, a) (s, a) s s -> AffineTraversal' s s
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx (s, a) (s, a) s s
forall s t a b. Field1 s t a b => Lens s t a b
_1
{-# INLINE _init #-}
_last :: Snoc s s a a => AffineTraversal' s a
_last :: AffineTraversal' s a
_last = Prism s s (s, a) (s, a)
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc Prism s s (s, a) (s, a)
-> Optic A_Lens NoIx (s, a) (s, a) a a -> AffineTraversal' s a
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx (s, a) (s, a) a a
forall s t a b. Field2 s t a b => Lens s t a b
_2
{-# INLINE _last #-}
(|>) :: Snoc s s a a => s -> a -> s
|> :: s -> a -> s
(|>) = ((s, a) -> s) -> s -> a -> s
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Optic' A_Prism NoIx s (s, a) -> (s, a) -> s
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Prism NoIx s (s, a)
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc)
{-# INLINE (|>) #-}
snoc :: Snoc s s a a => s -> a -> s
snoc :: s -> a -> s
snoc = ((s, a) -> s) -> s -> a -> s
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Optic' A_Prism NoIx s (s, a) -> (s, a) -> s
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Prism NoIx s (s, a)
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc)
{-# INLINE snoc #-}
unsnoc :: Snoc s s a a => s -> Maybe (s, a)
unsnoc :: s -> Maybe (s, a)
unsnoc s
s = Optic' A_Prism NoIx s (s, a) -> s -> Maybe (s, a)
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview Optic' A_Prism NoIx s (s, a)
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc s
s
{-# INLINE unsnoc #-}