{-# 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.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

-- $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`

pattern (:<) :: Cons b b a a => a -> b -> b
pattern $b:< :: forall b a. Cons b b a a => a -> b -> b
$m:< :: forall {r} {b} {a}.
Cons b b a a =>
b -> (a -> b -> r) -> ((# #) -> r) -> r
(:<) a s <- (preview _Cons -> Just (a,s)) where
  (:<) a
a b
s = forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons 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:> :: forall a b. Snoc a a b b => a -> b -> a
$m:> :: forall {r} {a} {b}.
Snoc a a b b =>
a -> (a -> b -> r) -> ((# #) -> r) -> r
(:>) s a <- (preview _Snoc -> Just (s,a)) where
  (:>) a
a b
s = forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc 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 = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:)) forall a b. (a -> b) -> a -> b
$ \ [a]
aas -> case [a]
aas of
    (a
a:[a]
as) -> forall a b. b -> Either a b
Right (a
a, [a]
as)
    []     -> 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 = forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism Prism [a] [b] (a, [a]) (b, [b])
listCons forall a b. (a -> b) -> a -> b
$ \(b, [b]) -> [b]
listReview [a] -> Either [b] (a, [a])
listPreview ->
    forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (coerce :: forall a b. Coercible a b => a -> b
coerce (b, [b]) -> [b]
listReview) (coerce :: 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 = 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 = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> Seq a -> Seq a
(Seq.<|)) forall a b. (a -> b) -> a -> b
$ \Seq a
aas -> case forall a. Seq a -> ViewL a
viewl Seq a
aas of
    a
a Seq.:< Seq a
as -> forall a b. b -> Either a b
Right (a
a, Seq a
as)
    ViewL a
EmptyL  -> forall a b. a -> Either a b
Left 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 = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (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 = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (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 = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (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 = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (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 = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> Vector a -> Vector a
Vector.cons) forall a b. (a -> b) -> a -> b
$ \Vector a
v ->
    if forall a. Vector a -> Bool
Vector.null Vector a
v
    then forall a b. a -> Either a b
Left forall a. Vector a
Vector.empty
    else forall a b. b -> Either a b
Right (forall a. Vector a -> a
Vector.unsafeHead Vector a
v, 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 = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Prim a => a -> Vector a -> Vector a
Prim.cons) forall a b. (a -> b) -> a -> b
$ \Vector a
v ->
    if forall a. Prim a => Vector a -> Bool
Prim.null Vector a
v
    then forall a b. a -> Either a b
Left forall a. Prim a => Vector a
Prim.empty
    else forall a b. b -> Either a b
Right (forall a. Prim a => Vector a -> a
Prim.unsafeHead Vector a
v, 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 = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Storable a => a -> Vector a -> Vector a
Storable.cons) forall a b. (a -> b) -> a -> b
$ \Vector a
v ->
    if forall a. Storable a => Vector a -> Bool
Storable.null Vector a
v
    then forall a b. a -> Either a b
Left forall a. Storable a => Vector a
Storable.empty
    else forall a b. b -> Either a b
Right (forall a. Storable a => Vector a -> a
Storable.unsafeHead Vector a
v, 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 = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Unbox a => a -> Vector a -> Vector a
Unbox.cons) forall a b. (a -> b) -> a -> b
$ \Vector a
v ->
    if forall a. Unbox a => Vector a -> Bool
Unbox.null Vector a
v
    then forall a b. a -> Either a b
Left forall a. Unbox a => Vector a
Unbox.empty
    else forall a b. b -> Either a b
Right (forall a. Unbox a => Vector a -> a
Unbox.unsafeHead Vector a
v, 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
(<|) = forall a b c. ((a, b) -> c) -> a -> b -> c
curry (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 forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_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 = forall a b c. ((a, b) -> c) -> a -> b -> c
curry (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 forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_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 = 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 forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_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 = forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Consforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field1 s t a b => Lens s t a b
_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 = forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Consforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field2 s t a b => Lens s t a b
_2
{-# INLINE _tail #-}

------------------------------------------------------------------------------

-- 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 = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (\([b]
as,b
a) -> [b]
as forall a. [a] -> [a] -> [a]
Prelude.++ [b
a]) forall a b. (a -> b) -> a -> b
$ \[a]
aas -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [a]
aas
    then forall a b. a -> Either a b
Left []
    else forall a b. b -> Either a b
Right (forall a. [a] -> [a]
Prelude.init [a]
aas, 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 = forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism Prism [a] [b] ([a], a) ([b], b)
listSnoc forall a b. (a -> b) -> a -> b
$ \([b], b) -> [b]
listReview [a] -> Either [b] ([a], a)
listPreview ->
    forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (coerce :: forall a b. Coercible a b => a -> b
coerce ([b], b) -> [b]
listReview) (coerce :: 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 = 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 = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Seq a -> a -> Seq a
(Seq.|>)) forall a b. (a -> b) -> a -> b
$ \Seq a
aas -> case forall a. Seq a -> ViewR a
viewr Seq a
aas of
    Seq a
as Seq.:> a
a -> forall a b. b -> Either a b
Right (Seq a
as, a
a)
    ViewR a
EmptyR  -> forall a b. a -> Either a b
Left 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 = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Vector a -> a -> Vector a
Vector.snoc) forall a b. (a -> b) -> a -> b
$ \Vector a
v -> if forall a. Vector a -> Bool
Vector.null Vector a
v
    then forall a b. a -> Either a b
Left forall a. Vector a
Vector.empty
    else forall a b. b -> Either a b
Right (forall a. Vector a -> Vector a
Vector.unsafeInit Vector a
v, 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 = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Prim a => Vector a -> a -> Vector a
Prim.snoc) forall a b. (a -> b) -> a -> b
$ \Vector a
v -> if forall a. Prim a => Vector a -> Bool
Prim.null Vector a
v
    then forall a b. a -> Either a b
Left forall a. Prim a => Vector a
Prim.empty
    else forall a b. b -> Either a b
Right (forall a. Prim a => Vector a -> Vector a
Prim.unsafeInit Vector a
v, 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 = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Storable a => Vector a -> a -> Vector a
Storable.snoc) forall a b. (a -> b) -> a -> b
$ \Vector a
v -> if forall a. Storable a => Vector a -> Bool
Storable.null Vector a
v
    then forall a b. a -> Either a b
Left forall a. Storable a => Vector a
Storable.empty
    else forall a b. b -> Either a b
Right (forall a. Storable a => Vector a -> Vector a
Storable.unsafeInit Vector a
v, 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 = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Unbox a => Vector a -> a -> Vector a
Unbox.snoc) forall a b. (a -> b) -> a -> b
$ \Vector a
v -> if forall a. Unbox a => Vector a -> Bool
Unbox.null Vector a
v
    then forall a b. a -> Either a b
Left forall a. Unbox a => Vector a
Unbox.empty
    else forall a b. b -> Either a b
Right (forall a. Unbox a => Vector a -> Vector a
Unbox.unsafeInit Vector a
v, 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 = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> Word8 -> ByteString
StrictB.snoc) forall a b. (a -> b) -> a -> b
$ \ByteString
v -> if ByteString -> Bool
StrictB.null ByteString
v
    then forall a b. a -> Either a b
Left ByteString
StrictB.empty
    else forall a b. b -> Either a b
Right (HasCallStack => ByteString -> ByteString
StrictB.init ByteString
v, HasCallStack => 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 = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> Word8 -> ByteString
LazyB.snoc) forall a b. (a -> b) -> a -> b
$ \ByteString
v -> if ByteString -> Bool
LazyB.null ByteString
v
    then forall a b. a -> Either a b
Left ByteString
LazyB.empty
    else forall a b. b -> Either a b
Right (HasCallStack => ByteString -> ByteString
LazyB.init ByteString
v, HasCallStack => 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 = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Char -> Text
StrictT.snoc) forall a b. (a -> b) -> a -> b
$ \Text
v -> if Text -> Bool
StrictT.null Text
v
    then forall a b. a -> Either a b
Left Text
StrictT.empty
    else 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 :: Prism Text Text (Text, Char) (Text, Char)
_Snoc = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Char -> Text
LazyT.snoc) forall a b. (a -> b) -> a -> b
$ \Text
v -> if Text -> Bool
LazyT.null Text
v
    then forall a b. a -> Either a b
Left Text
LazyT.empty
    else forall a b. b -> Either a b
Right (Text -> Text
LazyT.init Text
v, 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 = forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snocforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field1 s t a b => Lens s t a b
_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 = forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snocforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field2 s t a b => Lens s t a b
_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
(|>) = forall a b c. ((a, b) -> c) -> a -> b -> c
curry (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 forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_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 = forall a b c. ((a, b) -> c) -> a -> b -> c
curry (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 forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_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 = 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 forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc
{-# INLINE unsnoc #-}