{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-}
#endif
module Control.Lens.Cons
(
Cons(..)
, (<|)
, cons
, uncons
, _head, _tail
, pattern (:<)
, Snoc(..)
, (|>)
, snoc
, unsnoc
, _init, _last
, pattern (:>)
) where
import Control.Lens.Equality (simply)
import Control.Lens.Fold
import Control.Lens.Prism
import Control.Lens.Review
import Control.Lens.Tuple
import Control.Lens.Type
import qualified Data.ByteString as StrictB
import qualified Data.ByteString.Lazy as LazyB
import Data.Coerce
import Data.Monoid
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, ViewL(EmptyL), ViewR(EmptyR), viewl, viewr)
import qualified Data.Text as StrictT
import qualified Data.Text.Lazy as LazyT
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Data.Vector.Storable (Storable)
import qualified Data.Vector.Storable as Storable
import Data.Vector.Primitive (Prim)
import qualified Data.Vector.Primitive as Prim
import Data.Vector.Unboxed (Unbox)
import qualified Data.Vector.Unboxed as Unbox
import Data.Word
import Control.Applicative (ZipList(..))
import Prelude
infixr 5 <|, `cons`
infixl 5 |>, `snoc`
pattern (:<) :: Cons b b a a => a -> b -> b
pattern $b:< :: a -> b -> b
$m:< :: forall r b a.
Cons b b a a =>
b -> (a -> b -> r) -> (Void# -> r) -> r
(:<) a s <- (preview _Cons -> Just (a,s)) where
(:<) a
a b
s = Tagged (a, b) (Identity (a, b)) -> Tagged b (Identity b)
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons (Tagged (a, b) (Identity (a, b)) -> Tagged b (Identity b))
-> (a, b) -> b
forall t b. AReview t b -> b -> t
# (a
a,b
s)
infixr 5 :<
infixl 5 :>
pattern (:>) :: Snoc a a b b => a -> b -> a
pattern $b:> :: a -> b -> a
$m:> :: forall r a b.
Snoc a a b b =>
a -> (a -> b -> r) -> (Void# -> r) -> r
(:>) s a <- (preview _Snoc -> Just (s,a)) where
(:>) a
a b
s = Tagged (a, b) (Identity (a, b)) -> Tagged a (Identity a)
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc (Tagged (a, b) (Identity (a, b)) -> Tagged a (Identity a))
-> (a, b) -> a
forall t b. AReview t b -> b -> t
# (a
a,b
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 :: p (a, [a]) (f (b, [b])) -> p [a] (f [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 :: p (a, ZipList a) (f (b, ZipList b))
-> p (ZipList a) (f (ZipList b))
_Cons = APrism [a] [b] (a, [a]) (b, [b])
-> (((b, [b]) -> [b])
-> ([a] -> Either [b] (a, [a]))
-> p (a, ZipList a) (f (b, ZipList b))
-> p (ZipList a) (f (ZipList b)))
-> p (a, ZipList a) (f (b, ZipList b))
-> p (ZipList a) (f (ZipList b))
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism [a] [b] (a, [a]) (b, [b])
Prism [a] [b] (a, [a]) (b, [b])
listCons ((((b, [b]) -> [b])
-> ([a] -> Either [b] (a, [a]))
-> p (a, ZipList a) (f (b, ZipList b))
-> p (ZipList a) (f (ZipList b)))
-> p (a, ZipList a) (f (b, ZipList b))
-> p (ZipList a) (f (ZipList b)))
-> (((b, [b]) -> [b])
-> ([a] -> Either [b] (a, [a]))
-> p (a, ZipList a) (f (b, ZipList b))
-> p (ZipList a) (f (ZipList b)))
-> p (a, ZipList a) (f (b, ZipList b))
-> p (ZipList a) (f (ZipList b))
forall a b. (a -> b) -> a -> b
$ \(b, [b]) -> [b]
listReview [a] -> Either [b] (a, [a])
listPreview ->
((b, ZipList b) -> ZipList b)
-> (ZipList a -> Either (ZipList b) (a, ZipList a))
-> Prism (ZipList a) (ZipList b) (a, ZipList a) (b, ZipList b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (((b, [b]) -> [b]) -> (b, ZipList b) -> ZipList b
coerce (b, [b]) -> [b]
listReview) (([a] -> Either [b] (a, [a]))
-> ZipList a -> Either (ZipList b) (a, ZipList a)
coerce [a] -> Either [b] (a, [a])
listPreview) where
listCons :: Prism [a] [b] (a, [a]) (b, [b])
listCons :: p (a, [a]) (f (b, [b])) -> p [a] (f [b])
listCons = p (a, [a]) (f (b, [b])) -> p [a] (f [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 :: p (a, Seq a) (f (b, Seq b)) -> p (Seq a) (f (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 #-}
instance Cons StrictB.ByteString StrictB.ByteString Word8 Word8 where
_Cons :: p (Word8, ByteString) (f (Word8, ByteString))
-> p ByteString (f ByteString)
_Cons = ((Word8, ByteString) -> ByteString)
-> (ByteString -> Maybe (Word8, ByteString))
-> Prism
ByteString ByteString (Word8, ByteString) (Word8, ByteString)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ((Word8 -> ByteString -> ByteString)
-> (Word8, ByteString) -> ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word8 -> ByteString -> ByteString
StrictB.cons) ByteString -> Maybe (Word8, ByteString)
StrictB.uncons
{-# INLINE _Cons #-}
instance Cons LazyB.ByteString LazyB.ByteString Word8 Word8 where
_Cons :: p (Word8, ByteString) (f (Word8, ByteString))
-> p ByteString (f ByteString)
_Cons = ((Word8, ByteString) -> ByteString)
-> (ByteString -> Maybe (Word8, ByteString))
-> Prism
ByteString ByteString (Word8, ByteString) (Word8, ByteString)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ((Word8 -> ByteString -> ByteString)
-> (Word8, ByteString) -> ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word8 -> ByteString -> ByteString
LazyB.cons) ByteString -> Maybe (Word8, ByteString)
LazyB.uncons
{-# INLINE _Cons #-}
instance Cons StrictT.Text StrictT.Text Char Char where
_Cons :: p (Char, Text) (f (Char, Text)) -> p Text (f Text)
_Cons = ((Char, Text) -> Text)
-> (Text -> Maybe (Char, Text))
-> Prism Text Text (Char, Text) (Char, Text)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ((Char -> Text -> Text) -> (Char, Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Text -> Text
StrictT.cons) Text -> Maybe (Char, Text)
StrictT.uncons
{-# INLINE _Cons #-}
instance Cons LazyT.Text LazyT.Text Char Char where
_Cons :: p (Char, Text) (f (Char, Text)) -> p Text (f Text)
_Cons = ((Char, Text) -> Text)
-> (Text -> Maybe (Char, Text))
-> Prism Text Text (Char, Text) (Char, Text)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ((Char -> Text -> Text) -> (Char, Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Text -> Text
LazyT.cons) Text -> Maybe (Char, Text)
LazyT.uncons
{-# INLINE _Cons #-}
instance Cons (Vector a) (Vector b) a b where
_Cons :: p (a, Vector a) (f (b, Vector b)) -> p (Vector a) (f (Vector b))
_Cons = ((b, Vector b) -> Vector b)
-> (Vector a -> Either (Vector b) (a, Vector a))
-> Prism (Vector a) (Vector b) (a, Vector a) (b, Vector b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((b -> Vector b -> Vector b) -> (b, Vector b) -> Vector b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry b -> Vector b -> Vector b
forall a. a -> Vector a -> Vector a
Vector.cons) ((Vector a -> Either (Vector b) (a, Vector a))
-> Prism (Vector a) (Vector b) (a, Vector a) (b, Vector b))
-> (Vector a -> Either (Vector b) (a, Vector a))
-> Prism (Vector a) (Vector b) (a, Vector a) (b, Vector b)
forall a b. (a -> b) -> a -> b
$ \Vector a
v ->
if Vector a -> Bool
forall a. Vector a -> Bool
Vector.null Vector a
v
then Vector b -> Either (Vector b) (a, Vector a)
forall a b. a -> Either a b
Left Vector b
forall a. Vector a
Vector.empty
else (a, Vector a) -> Either (Vector b) (a, Vector a)
forall a b. b -> Either a b
Right (Vector a -> a
forall a. Vector a -> a
Vector.unsafeHead Vector a
v, Vector a -> Vector a
forall a. Vector a -> Vector a
Vector.unsafeTail Vector a
v)
{-# INLINE _Cons #-}
instance (Prim a, Prim b) => Cons (Prim.Vector a) (Prim.Vector b) a b where
_Cons :: p (a, Vector a) (f (b, Vector b)) -> p (Vector a) (f (Vector b))
_Cons = ((b, Vector b) -> Vector b)
-> (Vector a -> Either (Vector b) (a, Vector a))
-> Prism (Vector a) (Vector b) (a, Vector a) (b, Vector b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((b -> Vector b -> Vector b) -> (b, Vector b) -> Vector b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry b -> Vector b -> Vector b
forall a. Prim a => a -> Vector a -> Vector a
Prim.cons) ((Vector a -> Either (Vector b) (a, Vector a))
-> Prism (Vector a) (Vector b) (a, Vector a) (b, Vector b))
-> (Vector a -> Either (Vector b) (a, Vector a))
-> Prism (Vector a) (Vector b) (a, Vector a) (b, Vector b)
forall a b. (a -> b) -> a -> b
$ \Vector a
v ->
if Vector a -> Bool
forall a. Prim a => Vector a -> Bool
Prim.null Vector a
v
then Vector b -> Either (Vector b) (a, Vector a)
forall a b. a -> Either a b
Left Vector b
forall a. Prim a => Vector a
Prim.empty
else (a, Vector a) -> Either (Vector b) (a, Vector a)
forall a b. b -> Either a b
Right (Vector a -> a
forall a. Prim a => Vector a -> a
Prim.unsafeHead Vector a
v, Vector a -> Vector a
forall a. Prim a => Vector a -> Vector a
Prim.unsafeTail Vector a
v)
{-# INLINE _Cons #-}
instance (Storable a, Storable b) => Cons (Storable.Vector a) (Storable.Vector b) a b where
_Cons :: p (a, Vector a) (f (b, Vector b)) -> p (Vector a) (f (Vector b))
_Cons = ((b, Vector b) -> Vector b)
-> (Vector a -> Either (Vector b) (a, Vector a))
-> Prism (Vector a) (Vector b) (a, Vector a) (b, Vector b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((b -> Vector b -> Vector b) -> (b, Vector b) -> Vector b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry b -> Vector b -> Vector b
forall a. Storable a => a -> Vector a -> Vector a
Storable.cons) ((Vector a -> Either (Vector b) (a, Vector a))
-> Prism (Vector a) (Vector b) (a, Vector a) (b, Vector b))
-> (Vector a -> Either (Vector b) (a, Vector a))
-> Prism (Vector a) (Vector b) (a, Vector a) (b, Vector b)
forall a b. (a -> b) -> a -> b
$ \Vector a
v ->
if Vector a -> Bool
forall a. Storable a => Vector a -> Bool
Storable.null Vector a
v
then Vector b -> Either (Vector b) (a, Vector a)
forall a b. a -> Either a b
Left Vector b
forall a. Storable a => Vector a
Storable.empty
else (a, Vector a) -> Either (Vector b) (a, Vector a)
forall a b. b -> Either a b
Right (Vector a -> a
forall a. Storable a => Vector a -> a
Storable.unsafeHead Vector a
v, Vector a -> Vector a
forall a. Storable a => Vector a -> Vector a
Storable.unsafeTail Vector a
v)
{-# INLINE _Cons #-}
instance (Unbox a, Unbox b) => Cons (Unbox.Vector a) (Unbox.Vector b) a b where
_Cons :: p (a, Vector a) (f (b, Vector b)) -> p (Vector a) (f (Vector b))
_Cons = ((b, Vector b) -> Vector b)
-> (Vector a -> Either (Vector b) (a, Vector a))
-> Prism (Vector a) (Vector b) (a, Vector a) (b, Vector b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((b -> Vector b -> Vector b) -> (b, Vector b) -> Vector b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry b -> Vector b -> Vector b
forall a. Unbox a => a -> Vector a -> Vector a
Unbox.cons) ((Vector a -> Either (Vector b) (a, Vector a))
-> Prism (Vector a) (Vector b) (a, Vector a) (b, Vector b))
-> (Vector a -> Either (Vector b) (a, Vector a))
-> Prism (Vector a) (Vector b) (a, Vector a) (b, Vector b)
forall a b. (a -> b) -> a -> b
$ \Vector a
v ->
if Vector a -> Bool
forall a. Unbox a => Vector a -> Bool
Unbox.null Vector a
v
then Vector b -> Either (Vector b) (a, Vector a)
forall a b. a -> Either a b
Left Vector b
forall a. Unbox a => Vector a
Unbox.empty
else (a, Vector a) -> Either (Vector b) (a, Vector a)
forall a b. b -> Either a b
Right (Vector a -> a
forall a. Unbox a => Vector a -> a
Unbox.unsafeHead Vector a
v, Vector a -> Vector a
forall a. Unbox a => Vector a -> Vector a
Unbox.unsafeTail Vector a
v)
{-# 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' Tagged Identity s (a, s) -> (a, s) -> s)
-> Optic' Tagged Identity s (a, s) -> (a, s) -> s
forall k1 k2 (p :: k1 -> k2 -> *) (f :: k1 -> k2) (s :: k1)
(a :: k1) r.
(Optic' p f s a -> r) -> Optic' p f s a -> r
simply Optic' Tagged Identity s (a, s) -> (a, s) -> s
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Optic' Tagged Identity 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' Tagged Identity s (a, s) -> (a, s) -> s)
-> Optic' Tagged Identity s (a, s) -> (a, s) -> s
forall k1 k2 (p :: k1 -> k2 -> *) (f :: k1 -> k2) (s :: k1)
(a :: k1) r.
(Optic' p f s a -> r) -> Optic' p f s a -> r
simply Optic' Tagged Identity s (a, s) -> (a, s) -> s
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Optic' Tagged Identity 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' (->) (Const (First (a, s))) s (a, s) -> s -> Maybe (a, s))
-> Optic' (->) (Const (First (a, s))) s (a, s) -> s -> Maybe (a, s)
forall k1 k2 (p :: k1 -> k2 -> *) (f :: k1 -> k2) (s :: k1)
(a :: k1) r.
(Optic' p f s a -> r) -> Optic' p f s a -> r
simply Optic' (->) (Const (First (a, s))) s (a, s) -> s -> Maybe (a, s)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Optic' (->) (Const (First (a, s))) 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 => Traversal' s a
_head :: Traversal' s a
_head = ((a, s) -> f (a, s)) -> s -> f s
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons(((a, s) -> f (a, s)) -> s -> f s)
-> ((a -> f a) -> (a, s) -> f (a, s)) -> (a -> f a) -> s -> f s
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> f a) -> (a, s) -> f (a, s)
forall s t a b. Field1 s t a b => Lens s t a b
_1
{-# INLINE _head #-}
_tail :: Cons s s a a => Traversal' s s
_tail :: Traversal' s s
_tail = ((a, s) -> f (a, s)) -> s -> f s
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons(((a, s) -> f (a, s)) -> s -> f s)
-> ((s -> f s) -> (a, s) -> f (a, s)) -> (s -> f s) -> s -> f s
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(s -> f s) -> (a, s) -> f (a, 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 :: p ([a], a) (f ([b], b)) -> p [a] (f [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 :: p (ZipList a, a) (f (ZipList b, b))
-> p (ZipList a) (f (ZipList b))
_Snoc = APrism [a] [b] ([a], a) ([b], b)
-> ((([b], b) -> [b])
-> ([a] -> Either [b] ([a], a))
-> p (ZipList a, a) (f (ZipList b, b))
-> p (ZipList a) (f (ZipList b)))
-> p (ZipList a, a) (f (ZipList b, b))
-> p (ZipList a) (f (ZipList b))
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism [a] [b] ([a], a) ([b], b)
Prism [a] [b] ([a], a) ([b], b)
listSnoc (((([b], b) -> [b])
-> ([a] -> Either [b] ([a], a))
-> p (ZipList a, a) (f (ZipList b, b))
-> p (ZipList a) (f (ZipList b)))
-> p (ZipList a, a) (f (ZipList b, b))
-> p (ZipList a) (f (ZipList b)))
-> ((([b], b) -> [b])
-> ([a] -> Either [b] ([a], a))
-> p (ZipList a, a) (f (ZipList b, b))
-> p (ZipList a) (f (ZipList b)))
-> p (ZipList a, a) (f (ZipList b, b))
-> p (ZipList a) (f (ZipList 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 :: p ([a], a) (f ([b], b)) -> p [a] (f [b])
listSnoc = p ([a], a) (f ([b], b)) -> p [a] (f [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 :: p (Seq a, a) (f (Seq b, b)) -> p (Seq a) (f (Seq 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 #-}
instance Snoc (Vector a) (Vector b) a b where
_Snoc :: p (Vector a, a) (f (Vector b, b)) -> p (Vector a) (f (Vector b))
_Snoc = ((Vector b, b) -> Vector b)
-> (Vector a -> Either (Vector b) (Vector a, a))
-> Prism (Vector a) (Vector b) (Vector a, a) (Vector b, b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((Vector b -> b -> Vector b) -> (Vector b, b) -> Vector b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Vector b -> b -> Vector b
forall a. Vector a -> a -> Vector a
Vector.snoc) ((Vector a -> Either (Vector b) (Vector a, a))
-> Prism (Vector a) (Vector b) (Vector a, a) (Vector b, b))
-> (Vector a -> Either (Vector b) (Vector a, a))
-> Prism (Vector a) (Vector b) (Vector a, a) (Vector b, b)
forall a b. (a -> b) -> a -> b
$ \Vector a
v -> if Vector a -> Bool
forall a. Vector a -> Bool
Vector.null Vector a
v
then Vector b -> Either (Vector b) (Vector a, a)
forall a b. a -> Either a b
Left Vector b
forall a. Vector a
Vector.empty
else (Vector a, a) -> Either (Vector b) (Vector a, a)
forall a b. b -> Either a b
Right (Vector a -> Vector a
forall a. Vector a -> Vector a
Vector.unsafeInit Vector a
v, Vector a -> a
forall a. Vector a -> a
Vector.unsafeLast Vector a
v)
{-# INLINE _Snoc #-}
instance (Prim a, Prim b) => Snoc (Prim.Vector a) (Prim.Vector b) a b where
_Snoc :: p (Vector a, a) (f (Vector b, b)) -> p (Vector a) (f (Vector b))
_Snoc = ((Vector b, b) -> Vector b)
-> (Vector a -> Either (Vector b) (Vector a, a))
-> Prism (Vector a) (Vector b) (Vector a, a) (Vector b, b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((Vector b -> b -> Vector b) -> (Vector b, b) -> Vector b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Vector b -> b -> Vector b
forall a. Prim a => Vector a -> a -> Vector a
Prim.snoc) ((Vector a -> Either (Vector b) (Vector a, a))
-> Prism (Vector a) (Vector b) (Vector a, a) (Vector b, b))
-> (Vector a -> Either (Vector b) (Vector a, a))
-> Prism (Vector a) (Vector b) (Vector a, a) (Vector b, b)
forall a b. (a -> b) -> a -> b
$ \Vector a
v -> if Vector a -> Bool
forall a. Prim a => Vector a -> Bool
Prim.null Vector a
v
then Vector b -> Either (Vector b) (Vector a, a)
forall a b. a -> Either a b
Left Vector b
forall a. Prim a => Vector a
Prim.empty
else (Vector a, a) -> Either (Vector b) (Vector a, a)
forall a b. b -> Either a b
Right (Vector a -> Vector a
forall a. Prim a => Vector a -> Vector a
Prim.unsafeInit Vector a
v, Vector a -> a
forall a. Prim a => Vector a -> a
Prim.unsafeLast Vector a
v)
{-# INLINE _Snoc #-}
instance (Storable a, Storable b) => Snoc (Storable.Vector a) (Storable.Vector b) a b where
_Snoc :: p (Vector a, a) (f (Vector b, b)) -> p (Vector a) (f (Vector b))
_Snoc = ((Vector b, b) -> Vector b)
-> (Vector a -> Either (Vector b) (Vector a, a))
-> Prism (Vector a) (Vector b) (Vector a, a) (Vector b, b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((Vector b -> b -> Vector b) -> (Vector b, b) -> Vector b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Vector b -> b -> Vector b
forall a. Storable a => Vector a -> a -> Vector a
Storable.snoc) ((Vector a -> Either (Vector b) (Vector a, a))
-> Prism (Vector a) (Vector b) (Vector a, a) (Vector b, b))
-> (Vector a -> Either (Vector b) (Vector a, a))
-> Prism (Vector a) (Vector b) (Vector a, a) (Vector b, b)
forall a b. (a -> b) -> a -> b
$ \Vector a
v -> if Vector a -> Bool
forall a. Storable a => Vector a -> Bool
Storable.null Vector a
v
then Vector b -> Either (Vector b) (Vector a, a)
forall a b. a -> Either a b
Left Vector b
forall a. Storable a => Vector a
Storable.empty
else (Vector a, a) -> Either (Vector b) (Vector a, a)
forall a b. b -> Either a b
Right (Vector a -> Vector a
forall a. Storable a => Vector a -> Vector a
Storable.unsafeInit Vector a
v, Vector a -> a
forall a. Storable a => Vector a -> a
Storable.unsafeLast Vector a
v)
{-# INLINE _Snoc #-}
instance (Unbox a, Unbox b) => Snoc (Unbox.Vector a) (Unbox.Vector b) a b where
_Snoc :: p (Vector a, a) (f (Vector b, b)) -> p (Vector a) (f (Vector b))
_Snoc = ((Vector b, b) -> Vector b)
-> (Vector a -> Either (Vector b) (Vector a, a))
-> Prism (Vector a) (Vector b) (Vector a, a) (Vector b, b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((Vector b -> b -> Vector b) -> (Vector b, b) -> Vector b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Vector b -> b -> Vector b
forall a. Unbox a => Vector a -> a -> Vector a
Unbox.snoc) ((Vector a -> Either (Vector b) (Vector a, a))
-> Prism (Vector a) (Vector b) (Vector a, a) (Vector b, b))
-> (Vector a -> Either (Vector b) (Vector a, a))
-> Prism (Vector a) (Vector b) (Vector a, a) (Vector b, b)
forall a b. (a -> b) -> a -> b
$ \Vector a
v -> if Vector a -> Bool
forall a. Unbox a => Vector a -> Bool
Unbox.null Vector a
v
then Vector b -> Either (Vector b) (Vector a, a)
forall a b. a -> Either a b
Left Vector b
forall a. Unbox a => Vector a
Unbox.empty
else (Vector a, a) -> Either (Vector b) (Vector a, a)
forall a b. b -> Either a b
Right (Vector a -> Vector a
forall a. Unbox a => Vector a -> Vector a
Unbox.unsafeInit Vector a
v, Vector a -> a
forall a. Unbox a => Vector a -> a
Unbox.unsafeLast Vector a
v)
{-# INLINE _Snoc #-}
instance Snoc StrictB.ByteString StrictB.ByteString Word8 Word8 where
_Snoc :: p (ByteString, Word8) (f (ByteString, Word8))
-> p ByteString (f ByteString)
_Snoc = ((ByteString, Word8) -> ByteString)
-> (ByteString -> Either ByteString (ByteString, Word8))
-> Prism
ByteString ByteString (ByteString, Word8) (ByteString, Word8)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((ByteString -> Word8 -> ByteString)
-> (ByteString, Word8) -> ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> Word8 -> ByteString
StrictB.snoc) ((ByteString -> Either ByteString (ByteString, Word8))
-> Prism
ByteString ByteString (ByteString, Word8) (ByteString, Word8))
-> (ByteString -> Either ByteString (ByteString, Word8))
-> Prism
ByteString ByteString (ByteString, Word8) (ByteString, Word8)
forall a b. (a -> b) -> a -> b
$ \ByteString
v -> if ByteString -> Bool
StrictB.null ByteString
v
then ByteString -> Either ByteString (ByteString, Word8)
forall a b. a -> Either a b
Left ByteString
StrictB.empty
else (ByteString, Word8) -> Either ByteString (ByteString, Word8)
forall a b. b -> Either a b
Right (ByteString -> ByteString
StrictB.init ByteString
v, ByteString -> Word8
StrictB.last ByteString
v)
{-# INLINE _Snoc #-}
instance Snoc LazyB.ByteString LazyB.ByteString Word8 Word8 where
_Snoc :: p (ByteString, Word8) (f (ByteString, Word8))
-> p ByteString (f ByteString)
_Snoc = ((ByteString, Word8) -> ByteString)
-> (ByteString -> Either ByteString (ByteString, Word8))
-> Prism
ByteString ByteString (ByteString, Word8) (ByteString, Word8)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((ByteString -> Word8 -> ByteString)
-> (ByteString, Word8) -> ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> Word8 -> ByteString
LazyB.snoc) ((ByteString -> Either ByteString (ByteString, Word8))
-> Prism
ByteString ByteString (ByteString, Word8) (ByteString, Word8))
-> (ByteString -> Either ByteString (ByteString, Word8))
-> Prism
ByteString ByteString (ByteString, Word8) (ByteString, Word8)
forall a b. (a -> b) -> a -> b
$ \ByteString
v -> if ByteString -> Bool
LazyB.null ByteString
v
then ByteString -> Either ByteString (ByteString, Word8)
forall a b. a -> Either a b
Left ByteString
LazyB.empty
else (ByteString, Word8) -> Either ByteString (ByteString, Word8)
forall a b. b -> Either a b
Right (ByteString -> ByteString
LazyB.init ByteString
v, ByteString -> Word8
LazyB.last ByteString
v)
{-# INLINE _Snoc #-}
instance Snoc StrictT.Text StrictT.Text Char Char where
_Snoc :: p (Text, Char) (f (Text, Char)) -> p Text (f Text)
_Snoc = ((Text, Char) -> Text)
-> (Text -> Either Text (Text, Char))
-> Prism Text Text (Text, Char) (Text, Char)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((Text -> Char -> Text) -> (Text, Char) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Char -> Text
StrictT.snoc) ((Text -> Either Text (Text, Char))
-> Prism Text Text (Text, Char) (Text, Char))
-> (Text -> Either Text (Text, Char))
-> Prism Text Text (Text, Char) (Text, Char)
forall a b. (a -> b) -> a -> b
$ \Text
v -> if Text -> Bool
StrictT.null Text
v
then Text -> Either Text (Text, Char)
forall a b. a -> Either a b
Left Text
StrictT.empty
else (Text, Char) -> Either Text (Text, Char)
forall a b. b -> Either a b
Right (Text -> Text
StrictT.init Text
v, Text -> Char
StrictT.last Text
v)
{-# INLINE _Snoc #-}
instance Snoc LazyT.Text LazyT.Text Char Char where
_Snoc :: p (Text, Char) (f (Text, Char)) -> p Text (f Text)
_Snoc = ((Text, Char) -> Text)
-> (Text -> Either Text (Text, Char))
-> Prism Text Text (Text, Char) (Text, Char)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((Text -> Char -> Text) -> (Text, Char) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Char -> Text
LazyT.snoc) ((Text -> Either Text (Text, Char))
-> Prism Text Text (Text, Char) (Text, Char))
-> (Text -> Either Text (Text, Char))
-> Prism Text Text (Text, Char) (Text, Char)
forall a b. (a -> b) -> a -> b
$ \Text
v -> if Text -> Bool
LazyT.null Text
v
then Text -> Either Text (Text, Char)
forall a b. a -> Either a b
Left Text
LazyT.empty
else (Text, Char) -> Either Text (Text, Char)
forall a b. b -> Either a b
Right (Text -> Text
LazyT.init Text
v, Text -> Char
LazyT.last Text
v)
{-# INLINE _Snoc #-}
_init :: Snoc s s a a => Traversal' s s
_init :: Traversal' s s
_init = ((s, a) -> f (s, a)) -> s -> f s
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc(((s, a) -> f (s, a)) -> s -> f s)
-> ((s -> f s) -> (s, a) -> f (s, a)) -> (s -> f s) -> s -> f s
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(s -> f s) -> (s, a) -> f (s, a)
forall s t a b. Field1 s t a b => Lens s t a b
_1
{-# INLINE _init #-}
_last :: Snoc s s a a => Traversal' s a
_last :: Traversal' s a
_last = ((s, a) -> f (s, a)) -> s -> f s
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc(((s, a) -> f (s, a)) -> s -> f s)
-> ((a -> f a) -> (s, a) -> f (s, a)) -> (a -> f a) -> s -> f s
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> f a) -> (s, a) -> f (s, 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' Tagged Identity s (s, a) -> (s, a) -> s)
-> Optic' Tagged Identity s (s, a) -> (s, a) -> s
forall k1 k2 (p :: k1 -> k2 -> *) (f :: k1 -> k2) (s :: k1)
(a :: k1) r.
(Optic' p f s a -> r) -> Optic' p f s a -> r
simply Optic' Tagged Identity s (s, a) -> (s, a) -> s
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Optic' Tagged Identity 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' Tagged Identity s (s, a) -> (s, a) -> s)
-> Optic' Tagged Identity s (s, a) -> (s, a) -> s
forall k1 k2 (p :: k1 -> k2 -> *) (f :: k1 -> k2) (s :: k1)
(a :: k1) r.
(Optic' p f s a -> r) -> Optic' p f s a -> r
simply Optic' Tagged Identity s (s, a) -> (s, a) -> s
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Optic' Tagged Identity 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 = (Optic' (->) (Const (First (s, a))) s (s, a) -> s -> Maybe (s, a))
-> Optic' (->) (Const (First (s, a))) s (s, a) -> s -> Maybe (s, a)
forall k1 k2 (p :: k1 -> k2 -> *) (f :: k1 -> k2) (s :: k1)
(a :: k1) r.
(Optic' p f s a -> r) -> Optic' p f s a -> r
simply Optic' (->) (Const (First (s, a))) s (s, a) -> s -> Maybe (s, a)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Optic' (->) (Const (First (s, a))) s (s, a)
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc
{-# INLINE unsnoc #-}