{-# 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
-- Copyright   :  (C) 2012-16 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
module Control.Lens.Cons
  (
  -- * Cons
    Cons(..)
  , (<|)
  , cons
  , uncons
  , _head, _tail
  , (<|~), (<|=), (<<|~), (<<|=), (<<<|~), (<<<|=)
  , pattern (:<)
  -- * Snoc
  , Snoc(..)
  , (|>)
  , snoc
  , unsnoc
  , _init, _last
  , (|>~), (|>=), (<|>~), (<|>=), (<<|>~), (<<|>=)
  , pattern (:>)

  ) where

import Control.Lens.Equality (simply)
import Control.Lens.Fold
import Control.Lens.Lens
import Control.Lens.Prism
import Control.Lens.Review
import Control.Lens.Setter
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           Control.Monad.State.Class as State
import           Prelude

-- $setup
-- >>> :set -XNoOverloadedStrings
-- >>> import Control.Lens
-- >>> import qualified Data.Sequence as Seq
-- >>> import qualified Data.Vector as Vector
-- >>> import qualified Data.Text.Lazy as LazyT
-- >>> import Debug.SimpleReflect.Expr
-- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g)
-- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f
-- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g

infixr 5 <|, `cons`
infixl 5 |>, `snoc`
infixr 4 <|~, |>~, <<|~, <|>~, <<<|~, <<|>~
infix  4 <|=, |>=, <<|=, <|>=, <<<|=, <<|>=

pattern (:<) :: Cons b b a a => a -> b -> b
pattern $m:< :: forall {r} {b} {a}.
Cons b b a a =>
b -> (a -> b -> r) -> ((# #) -> r) -> r
$b:< :: forall b a. Cons b b a a => a -> b -> b
(:<) 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)
Prism b b (a, b) (a, b)
_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 $m:> :: forall {r} {a} {b}.
Snoc a a b b =>
a -> (a -> b -> r) -> ((# #) -> r) -> r
$b:> :: forall a b. Snoc a a b b => a -> b -> a
(:>) 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)
Prism a a (a, b) (a, 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)

------------------------------------------------------------------------------
-- Cons
------------------------------------------------------------------------------

-- | This class provides a way to attach or detach elements on the left
-- side of a structure in a flexible manner.
class Cons s t a b | s -> a, t -> b, s b -> t, t a -> s where
  -- |
  --
  -- @
  -- '_Cons' :: 'Prism' [a] [b] (a, [a]) (b, [b])
  -- '_Cons' :: 'Prism' ('Seq' a) ('Seq' b) (a, 'Seq' a) (b, 'Seq' b)
  -- '_Cons' :: 'Prism' ('Vector' a) ('Vector' b) (a, 'Vector' a) (b, 'Vector' b)
  -- '_Cons' :: 'Prism'' 'String' ('Char', 'String')
  -- '_Cons' :: 'Prism'' 'StrictT.Text' ('Char', 'StrictT.Text')
  -- '_Cons' :: 'Prism'' 'StrictB.ByteString' ('Word8', 'StrictB.ByteString')
  -- @
  _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 = 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
forall a b. Coercible a b => a -> b
coerce (b, [b]) -> [b]
listReview) (([a] -> Either [b] (a, [a]))
-> ZipList a -> Either (ZipList b) (a, ZipList a)
forall a b. Coercible a b => a -> b
coerce [a] -> Either [b] (a, [a])
listPreview) where

    listCons :: Prism [a] [b] (a, [a]) (b, [b])
    listCons :: Prism [a] [b] (a, [a]) (b, [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)
Prism [a] [b] (a, [a]) (b, [b])
_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 #-}

instance Cons StrictB.ByteString StrictB.ByteString Word8 Word8 where
  _Cons :: Prism ByteString ByteString (Word8, ByteString) (Word8, 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 :: Prism ByteString ByteString (Word8, ByteString) (Word8, 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 :: Prism Text Text (Char, Text) (Char, 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 :: Prism Text Text (Char, Text) (Char, 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 :: Prism (Vector a) (Vector b) (a, Vector a) (b, 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 :: Prism (Vector a) (Vector b) (a, Vector a) (b, 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 :: Prism (Vector a) (Vector b) (a, Vector a) (b, 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 :: Prism (Vector a) (Vector b) (a, Vector a) (b, 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' an element onto a container.
--
-- This is an infix alias for 'cons'.
--
-- >>> a <| []
-- [a]
--
-- >>> a <| [b, c]
-- [a,b,c]
--
-- >>> a <| Seq.fromList []
-- fromList [a]
--
-- >>> a <| Seq.fromList [b, c]
-- fromList [a,b,c]
(<|) :: Cons s s a a => a -> s -> s
<| :: forall b a. Cons b b a a => a -> b -> b
(<|) = ((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 {k} {k1} (p :: k -> k1 -> *) (f :: k -> k1) (s :: k)
       (a :: k) 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)
Prism s s (a, s) (a, s)
_Cons)
{-# INLINE (<|) #-}

-- | 'cons' an element onto a container.
--
-- >>> cons a []
-- [a]
--
-- >>> cons a [b, c]
-- [a,b,c]
--
-- >>> cons a (Seq.fromList [])
-- fromList [a]
--
-- >>> cons a (Seq.fromList [b, c])
-- fromList [a,b,c]
cons :: Cons s s a a => a -> s -> s
cons :: forall b a. Cons b b a a => a -> b -> b
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 {k} {k1} (p :: k -> k1 -> *) (f :: k -> k1) (s :: k)
       (a :: k) 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)
Prism s s (a, s) (a, s)
_Cons)
{-# INLINE cons #-}

-- | Attempt to extract the left-most element from a container, and a version of the container without that element.
--
-- >>> uncons []
-- Nothing
--
-- >>> uncons [a, b, c]
-- Just (a,[b,c])
uncons :: Cons s s a a => s -> Maybe (a, s)
uncons :: forall s a. Cons s s a a => 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 {k} {k1} (p :: k -> k1 -> *) (f :: k -> k1) (s :: k)
       (a :: k) 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)
Prism s s (a, s) (a, s)
_Cons
{-# INLINE uncons #-}

-- | A 'Traversal' reading and writing to the 'head' of a /non-empty/ container.
--
-- >>> [a,b,c]^? _head
-- Just a
--
-- >>> [a,b,c] & _head .~ d
-- [d,b,c]
--
-- >>> [a,b,c] & _head %~ f
-- [f a,b,c]
--
-- >>> [] & _head %~ f
-- []
--
-- >>> [1,2,3]^?!_head
-- 1
--
-- >>> []^?_head
-- Nothing
--
-- >>> [1,2]^?_head
-- Just 1
--
-- >>> [] & _head .~ 1
-- []
--
-- >>> [0] & _head .~ 2
-- [2]
--
-- >>> [0,1] & _head .~ 2
-- [2,1]
--
-- This isn't limited to lists.
--
-- For instance you can also 'Data.Traversable.traverse' the head of a 'Seq':
--
-- >>> Seq.fromList [a,b,c,d] & _head %~ f
-- fromList [f a,b,c,d]
--
-- >>> Seq.fromList [] ^? _head
-- Nothing
--
-- >>> Seq.fromList [a,b,c,d] ^? _head
-- Just a
--
-- @
-- '_head' :: 'Traversal'' [a] a
-- '_head' :: 'Traversal'' ('Seq' a) a
-- '_head' :: 'Traversal'' ('Vector' a) a
-- @
_head :: Cons s s a a => Traversal' s a
_head :: forall s a. Cons s s a a => 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)
Prism s s (a, s) (a, s)
_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
Lens (a, s) (a, s) a a
_1
{-# INLINE _head #-}

-- | A 'Traversal' reading and writing to the 'tail' of a /non-empty/ container.
--
-- >>> [a,b] & _tail .~ [c,d,e]
-- [a,c,d,e]
--
-- >>> [] & _tail .~ [a,b]
-- []
--
-- >>> [a,b,c,d,e] & _tail.traverse %~ f
-- [a,f b,f c,f d,f e]
--
-- >>> [1,2] & _tail .~ [3,4,5]
-- [1,3,4,5]
--
-- >>> [] & _tail .~ [1,2]
-- []
--
-- >>> [a,b,c]^?_tail
-- Just [b,c]
--
-- >>> [1,2]^?!_tail
-- [2]
--
-- >>> "hello"^._tail
-- "ello"
--
-- >>> ""^._tail
-- ""
--
-- This isn't limited to lists. For instance you can also 'Control.Traversable.traverse' the tail of a 'Seq'.
--
-- >>> Seq.fromList [a,b] & _tail .~ Seq.fromList [c,d,e]
-- fromList [a,c,d,e]
--
-- >>> Seq.fromList [a,b,c] ^? _tail
-- Just (fromList [b,c])
--
-- >>> Seq.fromList [] ^? _tail
-- Nothing
--
-- @
-- '_tail' :: 'Traversal'' [a] [a]
-- '_tail' :: 'Traversal'' ('Seq' a) ('Seq' a)
-- '_tail' :: 'Traversal'' ('Vector' a) ('Vector' a)
-- @
_tail :: Cons s s a a => Traversal' s s
_tail :: forall s a. Cons s s a a => 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)
Prism s s (a, s) (a, s)
_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
Lens (a, s) (a, s) s s
_2
{-# INLINE _tail #-}

-- | Modify the target of a 'Cons' value by using @('<|')@.
--
-- >>> (["world"], ["lens"]) & _1 <|~ "hello"
-- (["hello","world"],["lens"])
(<|~) :: Cons b b a a => ASetter s t b b -> a -> s -> t
ASetter s t b b
l <|~ :: forall b a s t. Cons b b a a => ASetter s t b b -> a -> s -> t
<|~ a
n = ASetter s t b b -> (b -> b) -> s -> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter s t b b
l (a
n a -> b -> b
forall b a. Cons b b a a => a -> b -> b
<|)
{-# INLINE (<|~) #-}

-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by using @('<|')@.
(<|=) :: (MonadState s m, Cons b b a a) => ASetter s s b b -> a -> m ()
ASetter s s b b
l <|= :: forall s (m :: * -> *) b a.
(MonadState s m, Cons b b a a) =>
ASetter s s b b -> a -> m ()
<|= a
a = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (ASetter s s b b
l ASetter s s b b -> a -> s -> s
forall b a s t. Cons b b a a => ASetter s t b b -> a -> s -> t
<|~ a
a)
{-# INLINE (<|=) #-}

-- | ('<|') a 'Cons' value onto the end of the target of a 'Lens' and
-- return the result.
--
-- When you do not need the result of the operation, ('Control.Lens.Cons.<|~') is more flexible.
(<<|~) :: Cons b b a a => LensLike ((,) b) s t b b -> a -> s -> (b, t)
LensLike ((,) b) s t b b
l <<|~ :: forall b a s t.
Cons b b a a =>
LensLike ((,) b) s t b b -> a -> s -> (b, t)
<<|~ a
m = LensLike ((,) b) s t b b
l LensLike ((,) b) s t b b -> (b -> b) -> s -> (b, t)
forall b s t a. LensLike ((,) b) s t a b -> (a -> b) -> s -> (b, t)
<%~ (a
m a -> b -> b
forall b a. Cons b b a a => a -> b -> b
<|)
{-# INLINE (<<|~) #-}

-- | ('<|') a 'Cons' value onto the end of the target of a 'Lens' and
-- return the /old/ result.
--
-- When you do not need the result of the operation, ('Control.Lens.Cons.<|~') is more flexible.
(<<<|~) :: Cons b b a a => LensLike' ((,) b) s b -> a -> s -> (b, s)
LensLike' ((,) b) s b
l <<<|~ :: forall b a s.
Cons b b a a =>
LensLike' ((,) b) s b -> a -> s -> (b, s)
<<<|~ a
m = LensLike' ((,) b) s b
l LensLike' ((,) b) s b -> (b -> b) -> s -> (b, s)
forall a s t b. LensLike ((,) a) s t a b -> (a -> b) -> s -> (a, t)
<<%~ (a
m a -> b -> b
forall b a. Cons b b a a => a -> b -> b
<|)
{-# INLINE (<<<|~) #-}

-- | ('<|') a 'Semigroup' value onto the end of the target of a 'Lens' into
-- your 'Monad''s state and return the result.
--
-- When you do not need the result of the operation, ('Control.Lens.Cons.<|=') is more flexible.
(<<|=) :: (MonadState s m, Cons b b a a) => LensLike ((,) b) s s b b -> a -> m b
LensLike ((,) b) s s b b
l <<|= :: forall s (m :: * -> *) b a.
(MonadState s m, Cons b b a a) =>
LensLike ((,) b) s s b b -> a -> m b
<<|= a
r = LensLike ((,) b) s s b b
l LensLike ((,) b) s s b b -> (b -> b) -> m b
forall s (m :: * -> *) b a.
MonadState s m =>
LensLike ((,) b) s s a b -> (a -> b) -> m b
<%= (a
r a -> b -> b
forall b a. Cons b b a a => a -> b -> b
<|)
{-# INLINE (<<|=) #-}

-- | ('<|') a 'Semigroup' value onto the end of the target of a 'Lens' into
-- your 'Monad''s state and return the /old/ result.
--
-- When you do not need the result of the operation, ('Control.Lens.Cons.<|=') is more flexible.
(<<<|=) :: (MonadState s m, Cons b b a a) => LensLike ((,) b) s s b b -> a -> m b
LensLike ((,) b) s s b b
l <<<|= :: forall s (m :: * -> *) b a.
(MonadState s m, Cons b b a a) =>
LensLike ((,) b) s s b b -> a -> m b
<<<|= a
r = LensLike ((,) b) s s b b
l LensLike ((,) b) s s b b -> (b -> b) -> m b
forall (p :: * -> * -> *) s (m :: * -> *) a b.
(Strong p, MonadState s m) =>
Over p ((,) a) s s a b -> p a b -> m a
<<%= (a
r a -> b -> b
forall b a. Cons b b a a => a -> b -> b
<|)
{-# INLINE (<<<|=) #-}

------------------------------------------------------------------------------
-- Snoc
------------------------------------------------------------------------------

-- | This class provides a way to attach or detach elements on the right
-- side of a structure in a flexible manner.
class Snoc s t a b | s -> a, t -> b, s b -> t, t a -> s where
  -- |
  --
  -- @
  -- '_Snoc' :: 'Prism' [a] [b] ([a], a) ([b], b)
  -- '_Snoc' :: 'Prism' ('Seq' a) ('Seq' b) ('Seq' a, a) ('Seq' b, b)
  -- '_Snoc' :: 'Prism' ('Vector' a) ('Vector' b) ('Vector' a, a) ('Vector' b, b)
  -- '_Snoc' :: 'Prism'' 'String' ('String', 'Char')
  -- '_Snoc' :: 'Prism'' 'StrictT.Text' ('StrictT.Text', 'Char')
  -- '_Snoc' :: 'Prism'' 'StrictB.ByteString' ('StrictB.ByteString', 'Word8')
  -- @
  _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 a. [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. HasCallStack => [a] -> [a]
Prelude.init [a]
aas, [a] -> a
forall a. HasCallStack => [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 = 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
forall a b. Coercible a b => a -> b
coerce ([b], b) -> [b]
listReview) (([a] -> Either [b] ([a], a))
-> ZipList a -> Either (ZipList b) (ZipList a, a)
forall a b. Coercible a b => a -> b
coerce [a] -> Either [b] ([a], a)
listPreview) where

    listSnoc :: Prism [a] [b] ([a], a) ([b], b)
    listSnoc :: Prism [a] [b] ([a], a) ([b], 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)
Prism [a] [b] ([a], a) ([b], 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 #-}

instance Snoc (Vector a) (Vector b) a b where
  _Snoc :: Prism (Vector a) (Vector b) (Vector a, a) (Vector b, 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 :: Prism (Vector a) (Vector b) (Vector a, a) (Vector b, 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 :: Prism (Vector a) (Vector b) (Vector a, a) (Vector b, 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 :: Prism (Vector a) (Vector b) (Vector a, a) (Vector b, 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 :: Prism ByteString ByteString (ByteString, Word8) (ByteString, Word8)
_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 (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
StrictB.init ByteString
v, HasCallStack => ByteString -> Word8
ByteString -> Word8
StrictB.last ByteString
v)
  {-# INLINE _Snoc #-}

instance Snoc LazyB.ByteString LazyB.ByteString Word8 Word8 where
  _Snoc :: Prism ByteString ByteString (ByteString, Word8) (ByteString, Word8)
_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 (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
LazyB.init ByteString
v, HasCallStack => ByteString -> Word8
ByteString -> Word8
LazyB.last ByteString
v)
  {-# INLINE _Snoc #-}

instance Snoc StrictT.Text StrictT.Text Char Char where
  _Snoc :: Prism Text Text (Text, Char) (Text, Char)
_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 (HasCallStack => Text -> Text
Text -> Text
StrictT.init Text
v, HasCallStack => Text -> Char
Text -> Char
StrictT.last Text
v)
  {-# INLINE _Snoc #-}

instance Snoc LazyT.Text LazyT.Text Char Char where
  _Snoc :: Prism Text Text (Text, Char) (Text, Char)
_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 (HasCallStack => Text -> Text
Text -> Text
LazyT.init Text
v, HasCallStack => Text -> Char
Text -> Char
LazyT.last Text
v)
  {-# INLINE _Snoc #-}

-- | A 'Traversal' reading and replacing all but the a last element of a /non-empty/ container.
--
-- >>> [a,b,c,d]^?_init
-- Just [a,b,c]
--
-- >>> []^?_init
-- Nothing
--
-- >>> [a,b] & _init .~ [c,d,e]
-- [c,d,e,b]
--
-- >>> [] & _init .~ [a,b]
-- []
--
-- >>> [a,b,c,d] & _init.traverse %~ f
-- [f a,f b,f c,d]
--
-- >>> [1,2,3]^?_init
-- Just [1,2]
--
-- >>> [1,2,3,4]^?!_init
-- [1,2,3]
--
-- >>> "hello"^._init
-- "hell"
--
-- >>> ""^._init
-- ""
--
-- @
-- '_init' :: 'Traversal'' [a] [a]
-- '_init' :: 'Traversal'' ('Seq' a) ('Seq' a)
-- '_init' :: 'Traversal'' ('Vector' a) ('Vector' a)
-- @
_init :: Snoc s s a a => Traversal' s s
_init :: forall s a. Snoc s s a a => 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)
Prism s s (s, a) (s, a)
_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
Lens (s, a) (s, a) s s
_1
{-# INLINE _init #-}

-- | A 'Traversal' reading and writing to the last element of a /non-empty/ container.
--
-- >>> [a,b,c]^?!_last
-- c
--
-- >>> []^?_last
-- Nothing
--
-- >>> [a,b,c] & _last %~ f
-- [a,b,f c]
--
-- >>> [1,2]^?_last
-- Just 2
--
-- >>> [] & _last .~ 1
-- []
--
-- >>> [0] & _last .~ 2
-- [2]
--
-- >>> [0,1] & _last .~ 2
-- [0,2]
--
-- This 'Traversal' is not limited to lists, however. We can also work with other containers, such as a 'Vector'.
--
-- >>> Vector.fromList "abcde" ^? _last
-- Just 'e'
--
-- >>> Vector.empty ^? _last
-- Nothing
--
-- >>> (Vector.fromList "abcde" & _last .~ 'Q') == Vector.fromList "abcdQ"
-- True
--
-- @
-- '_last' :: 'Traversal'' [a] a
-- '_last' :: 'Traversal'' ('Seq' a) a
-- '_last' :: 'Traversal'' ('Vector' a) a
-- @
_last :: Snoc s s a a => Traversal' s a
_last :: forall s a. Snoc s s a a => 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)
Prism s s (s, a) (s, a)
_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
Lens (s, a) (s, a) a a
_2
{-# INLINE _last #-}

-- | 'snoc' an element onto the end of a container.
--
-- This is an infix alias for 'snoc'.
--
-- >>> Seq.fromList [] |> a
-- fromList [a]
--
-- >>> Seq.fromList [b, c] |> a
-- fromList [b,c,a]
--
-- >>> LazyT.pack "hello" |> '!'
-- "hello!"
(|>) :: Snoc s s a a => s -> a -> s
|> :: forall a b. Snoc a a b b => a -> b -> a
(|>) = ((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 {k} {k1} (p :: k -> k1 -> *) (f :: k -> k1) (s :: k)
       (a :: k) 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)
Prism s s (s, a) (s, a)
_Snoc)
{-# INLINE (|>) #-}

-- | 'snoc' an element onto the end of a container.
--
-- >>> snoc (Seq.fromList []) a
-- fromList [a]
--
-- >>> snoc (Seq.fromList [b, c]) a
-- fromList [b,c,a]
--
-- >>> snoc (LazyT.pack "hello") '!'
-- "hello!"
snoc  :: Snoc s s a a => s -> a -> s
snoc :: forall a b. Snoc a a b b => a -> b -> a
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 {k} {k1} (p :: k -> k1 -> *) (f :: k -> k1) (s :: k)
       (a :: k) 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)
Prism s s (s, a) (s, a)
_Snoc)
{-# INLINE snoc #-}

-- | Attempt to extract the right-most element from a container, and a version of the container without that element.
--
-- >>> unsnoc (LazyT.pack "hello!")
-- Just ("hello",'!')
--
-- >>> unsnoc (LazyT.pack "")
-- Nothing
--
-- >>> unsnoc (Seq.fromList [b,c,a])
-- Just (fromList [b,c],a)
--
-- >>> unsnoc (Seq.fromList [])
-- Nothing
unsnoc :: Snoc s s a a => s -> Maybe (s, a)
unsnoc :: forall s a. Snoc s s a a => 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 {k} {k1} (p :: k -> k1 -> *) (f :: k -> k1) (s :: k)
       (a :: k) 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)
Prism s s (s, a) (s, a)
_Snoc
{-# INLINE unsnoc #-}

-- | Modify the target of a 'Cons' value by using @('|>')@.
--
-- >>> (["world"], ["lens"]) & _1 |>~ "hello"
-- (["world","hello"],["lens"])
(|>~) :: Snoc b b a a => ASetter s t b b -> a -> s -> t
ASetter s t b b
l |>~ :: forall b a s t. Snoc b b a a => ASetter s t b b -> a -> s -> t
|>~ a
n = ASetter s t b b -> (b -> b) -> s -> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter s t b b
l (b -> a -> b
forall a b. Snoc a a b b => a -> b -> a
|> a
n)
{-# INLINE (|>~) #-}

-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by using @('|>')@.
(|>=) :: (MonadState s m, Snoc b b a a) => ASetter s s b b -> a -> m ()
ASetter s s b b
l |>= :: forall s (m :: * -> *) b a.
(MonadState s m, Snoc b b a a) =>
ASetter s s b b -> a -> m ()
|>= a
a = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (ASetter s s b b
l ASetter s s b b -> a -> s -> s
forall b a s t. Snoc b b a a => ASetter s t b b -> a -> s -> t
|>~ a
a)
{-# INLINE (|>=) #-}

-- | ('|>') a 'Cons' value onto the end of the target of a 'Lens' and
-- return the result.
--
-- When you do not need the result of the operation, ('Control.Lens.Cons.|>~') is more flexible.
(<|>~) :: Snoc b b p p => LensLike ((,) b) s t b b -> p -> s -> (b, t)
LensLike ((,) b) s t b b
l <|>~ :: forall b p s t.
Snoc b b p p =>
LensLike ((,) b) s t b b -> p -> s -> (b, t)
<|>~ p
m = LensLike ((,) b) s t b b
l LensLike ((,) b) s t b b -> (b -> b) -> s -> (b, t)
forall b s t a. LensLike ((,) b) s t a b -> (a -> b) -> s -> (b, t)
<%~ (b -> p -> b
forall a b. Snoc a a b b => a -> b -> a
|> p
m)
{-# INLINE (<|>~) #-}

-- | ('|>') a 'Cons' value onto the end of the target of a 'Lens' and
-- return the /old/ result.
--
-- When you do not need the result of the operation, ('Control.Lens.Cons.|>~') is more flexible.
(<<|>~) :: Snoc b b p p => LensLike' ((,) b) s b -> p -> s -> (b, s)
LensLike' ((,) b) s b
l <<|>~ :: forall b p s.
Snoc b b p p =>
LensLike' ((,) b) s b -> p -> s -> (b, s)
<<|>~ p
m = LensLike' ((,) b) s b
l LensLike' ((,) b) s b -> (b -> b) -> s -> (b, s)
forall a s t b. LensLike ((,) a) s t a b -> (a -> b) -> s -> (a, t)
<<%~ (b -> p -> b
forall a b. Snoc a a b b => a -> b -> a
|> p
m)
{-# INLINE (<<|>~) #-}

-- | ('|>') a 'Semigroup' value onto the end of the target of a 'Lens' into
-- your 'Monad''s state and return the result.
--
-- When you do not need the result of the operation, ('Control.Lens.Cons.|>=') is more flexible.
(<|>=) :: (MonadState s m, Snoc b b p p) => LensLike ((,) b) s s b b -> p -> m b
LensLike ((,) b) s s b b
l <|>= :: forall s (m :: * -> *) b p.
(MonadState s m, Snoc b b p p) =>
LensLike ((,) b) s s b b -> p -> m b
<|>= p
r = LensLike ((,) b) s s b b
l LensLike ((,) b) s s b b -> (b -> b) -> m b
forall s (m :: * -> *) b a.
MonadState s m =>
LensLike ((,) b) s s a b -> (a -> b) -> m b
<%= (b -> p -> b
forall a b. Snoc a a b b => a -> b -> a
|> p
r)
{-# INLINE (<|>=) #-}

-- | ('|>') a 'Semigroup' value onto the end of the target of a 'Lens' into
-- your 'Monad''s state and return the result.
--
-- When you do not need the result of the operation, ('Control.Lens.Cons.|>=') is more flexible.
(<<|>=) :: (MonadState s m, Snoc b b p p) => LensLike ((,) b) s s b b -> p -> m b
LensLike ((,) b) s s b b
l <<|>= :: forall s (m :: * -> *) b p.
(MonadState s m, Snoc b b p p) =>
LensLike ((,) b) s s b b -> p -> m b
<<|>= p
r = LensLike ((,) b) s s b b
l LensLike ((,) b) s s b b -> (b -> b) -> m b
forall (p :: * -> * -> *) s (m :: * -> *) a b.
(Strong p, MonadState s m) =>
Over p ((,) a) s s a b -> p a b -> m a
<<%= (b -> p -> b
forall a b. Snoc a a b b => a -> b -> a
|> p
r)
{-# INLINE (<<|>=) #-}