-- |
-- Module: Optics.Cons.Core
-- Description: Optics to access the left or right element of a container.
--
-- This module defines the 'Cons' and 'Snoc' classes, which provide 'Prism's for
-- the leftmost and rightmost elements of a container, respectively.
--
-- Note that orphan instances for these classes are defined in the @Optics.Cons@
-- module from @optics-extra@, so if you are not simply depending on @optics@
-- you may wish to import that module instead.
--
module Optics.Cons.Core
  (
  -- * Cons
    Cons(..)
  , (<|)
  , cons
  , uncons
  , _head, _tail
  , pattern (:<)
  -- * Snoc
  , Snoc(..)
  , (|>)
  , snoc
  , unsnoc
  , _init, _last
  , pattern (:>)
  ) where

import Control.Applicative (ZipList(..))
import Data.Coerce
import Data.Sequence hiding ((<|), (|>), (:<), (:>))
import qualified Data.Sequence as Seq

import Data.Tuple.Optics
import Optics.AffineFold
import Optics.AffineTraversal
import Optics.Coerce
import Optics.Internal.Utils
import Optics.Optic
import Optics.Prism
import Optics.Review

infixr 5 <|, `cons`
infixl 5 |>, `snoc`

-- | Pattern synonym for matching on the leftmost element of a structure.
--
-- >>> case ['a','b','c'] of (x :< _) -> x
-- 'a'
--
pattern (:<) :: forall s a. Cons s s a a => a -> s -> s
pattern $b:< :: forall s a. Cons s s a a => a -> s -> s
$m:< :: forall {r} {s} {a}.
Cons s s a a =>
s -> (a -> s -> r) -> ((# #) -> r) -> r
(:<) a s <- (preview _Cons -> Just (a, s)) where
  (:<) a
a s
s = forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons (a
a, s
s)

infixr 5 :<
infixl 5 :>

-- | Pattern synonym for matching on the rightmost element of a structure.
--
-- >>> case ['a','b','c'] of (_ :> x) -> x
-- 'c'
--
pattern (:>) :: forall s a. Snoc s s a a => s -> a -> s
pattern $b:> :: forall s a. Snoc s s a a => s -> a -> s
$m:> :: forall {r} {s} {a}.
Snoc s s a a =>
s -> (s -> a -> r) -> ((# #) -> r) -> r
(:>) s a <- (preview _Snoc -> Just (s, a)) where
  (:>) s
a a
s = forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc (s
a, a
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'' Text ('Char', Text)
  -- '_Cons' :: 'Prism'' ByteString ('Data.Word.Word8', 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 s' k (is :: IxList) t a b.
Coercible s s' =>
Optic k is s t a b -> Optic k is s' t a b
coerceS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t t' k (is :: IxList) s a b.
Coercible t t' =>
Optic k is s t a b -> Optic k is s t' a b
coerceT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a a' k (is :: IxList) s t b.
Coercible a a' =>
Optic k is s t a b -> Optic k is s t a' b
coerceA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b b' k (is :: IxList) s t a.
Coercible b b' =>
Optic k is s t a b -> Optic k is s t a b'
coerceB forall a b. (a -> b) -> a -> b
$ Prism [a] [b] (a, [a]) (b, [b])
listCons
    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 #-}

-- | 'cons' an element onto a container.
--
-- This is an infix alias for 'cons'.
--
-- >>> 1 <| []
-- [1]
--
-- >>> 'a' <| "bc"
-- "abc"
--
-- >>> 1 <| []
-- [1]
--
-- >>> 1 <| [2, 3]
-- [1,2,3]
(<|) :: Cons s s a a => a -> s -> s
<| :: forall s a. Cons s s a a => a -> s -> s
(<|) = forall a b c. ((a, b) -> c) -> a -> b -> c
curry (forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> 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' "bc"
-- "abc"
cons :: Cons s s a a => a -> s -> s
cons :: forall s a. Cons s s a a => a -> s -> s
cons = forall a b c. ((a, b) -> c) -> a -> b -> c
curry (forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> 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 [1, 2, 3]
-- Just (1,[2,3])
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 k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons
{-# INLINE uncons #-}

-- | An 'AffineTraversal' reading and writing to the 'head' of a /non-empty/
-- container.
--
-- >>> "abc" ^? _head
-- Just 'a'
--
-- >>> "abc" & _head .~ 'd'
-- "dbc"
--
-- >>> [1,2,3] & _head %~ (*10)
-- [10,2,3]
--
-- >>> [] & _head %~ absurd
-- []
--
-- >>> [1,2,3] ^? _head
-- Just 1
--
-- >>> [] ^? _head
-- Nothing
--
-- >>> [1,2] ^? _head
-- Just 1
--
-- >>> [] & _head .~ 1
-- []
--
-- >>> [0] & _head .~ 2
-- [2]
--
-- >>> [0,1] & _head .~ 2
-- [2,1]
_head :: Cons s s a a => AffineTraversal' s a
_head :: forall s a. Cons s s a a => AffineTraversal' s a
_head = forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s t a b. Field1 s t a b => Lens s t a b
_1
{-# INLINE _head #-}

-- | An 'AffineTraversal' reading and writing to the 'tail' of a /non-empty/
-- container.
--
-- >>> "ab" & _tail .~ "cde"
-- "acde"
--
-- >>> [] & _tail .~ [1,2]
-- []
--
-- >>> [1,2,3,4,5] & _tail % traversed %~ (*10)
-- [1,20,30,40,50]
--
-- >>> [1,2] & _tail .~ [3,4,5]
-- [1,3,4,5]
--
-- >>> [] & _tail .~ [1,2]
-- []
--
-- >>> "abc" ^? _tail
-- Just "bc"
--
-- >>> "hello" ^? _tail
-- Just "ello"
--
-- >>> "" ^? _tail
-- Nothing
_tail :: Cons s s a a => AffineTraversal' s s
_tail :: forall s a. Cons s s a a => AffineTraversal' s s
_tail = forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% 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 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 k (is :: IxList) s t a b r.
Is k A_Prism =>
Optic k is s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism 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 #-}

-- | An 'AffineTraversal' reading and replacing all but the a last element of a
-- /non-empty/ container.
--
-- >>> "abcd" ^? _init
-- Just "abc"
--
-- >>> "" ^? _init
-- Nothing
--
-- >>> "ab" & _init .~ "cde"
-- "cdeb"
--
-- >>> [] & _init .~ [1,2]
-- []
--
-- >>> [1,2,3,4] & _init % traversed %~ (*10)
-- [10,20,30,4]
--
-- >>> [1,2,3] ^? _init
-- Just [1,2]
--
-- >>> "hello" ^? _init
-- Just "hell"
--
-- >>> [] ^? _init
-- Nothing
_init :: Snoc s s a a => AffineTraversal' s s
_init :: forall s a. Snoc s s a a => AffineTraversal' s s
_init = forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s t a b. Field1 s t a b => Lens s t a b
_1
{-# INLINE _init #-}

-- | An 'AffineTraversal' reading and writing to the last element of a
-- /non-empty/ container.
--
-- >>> "abc" ^? _last
-- Just 'c'
--
-- >>> "" ^? _last
-- Nothing
--
-- >>> [1,2,3] & _last %~ (+1)
-- [1,2,4]
--
-- >>> [1,2] ^? _last
-- Just 2
--
-- >>> [] & _last .~ 1
-- []
--
-- >>> [0] & _last .~ 2
-- [2]
--
-- >>> [0,1] & _last .~ 2
-- [0,2]
_last :: Snoc s s a a => AffineTraversal' s a
_last :: forall s a. Snoc s s a a => AffineTraversal' s a
_last = forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% 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'.
--
-- >>> "" |> 'a'
-- "a"
--
-- >>> "bc" |> 'a'
-- "bca"
(|>) :: Snoc s s a a => s -> a -> s
|> :: forall s a. Snoc s s a a => s -> a -> s
(|>) = forall a b c. ((a, b) -> c) -> a -> b -> c
curry (forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> 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 "hello" '!'
-- "hello!"
snoc  :: Snoc s s a a => s -> a -> s
snoc :: forall s a. Snoc s s a a => s -> a -> s
snoc = forall a b c. ((a, b) -> c) -> a -> b -> c
curry (forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> 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 "hello!"
-- Just ("hello",'!')
--
-- >>> unsnoc ""
-- 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 s
s = forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc s
s
{-# INLINE unsnoc #-}

-- $setup
-- >>> import Data.Void
-- >>> import Optics.Core