-- |
-- Module:  Data.Sequence.Optics
-- Description: Optics for working with 'Seq's.
--
-- This module defines optics for constructing and manipulating finite 'Seq's.
--
module Data.Sequence.Optics
  ( viewL, viewR
  , sliced, slicedTo, slicedFrom
  , seqOf
  ) where

import Data.Sequence (Seq, ViewL (..), ViewR (..), (><))
import qualified Data.Sequence as Seq

import Optics.Internal.Indexed
import Optics.Fold
import Optics.Iso
import Optics.IxTraversal
import Optics.Optic
import Optics.Traversal

-- * Sequence isomorphisms

-- | A 'Seq' is isomorphic to a 'ViewL'
--
-- @'viewl' m ≡ m 'Optics.Operators.^.' 'viewL'@
--
-- >>> Seq.fromList [1,2,3] ^. viewL
-- 1 :< fromList [2,3]
--
-- >>> Seq.empty ^. viewL
-- EmptyL
--
-- >>> EmptyL ^. re viewL
-- fromList []
--
-- >>> review viewL $ 1 Seq.:< Seq.fromList [2,3]
-- fromList [1,2,3]
viewL :: Iso (Seq a) (Seq b) (ViewL a) (ViewL b)
viewL :: Iso (Seq a) (Seq b) (ViewL a) (ViewL b)
viewL = (Seq a -> ViewL a)
-> (ViewL b -> Seq b) -> Iso (Seq a) (Seq b) (ViewL a) (ViewL b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Seq a -> ViewL a
forall a. Seq a -> ViewL a
Seq.viewl ((ViewL b -> Seq b) -> Iso (Seq a) (Seq b) (ViewL a) (ViewL b))
-> (ViewL b -> Seq b) -> Iso (Seq a) (Seq b) (ViewL a) (ViewL b)
forall a b. (a -> b) -> a -> b
$ \ViewL b
xs -> case ViewL b
xs of
  ViewL b
EmptyL      -> Seq b
forall a. Monoid a => a
mempty
  b
a Seq.:< Seq b
as -> b
a b -> Seq b -> Seq b
forall a. a -> Seq a -> Seq a
Seq.<| Seq b
as
{-# INLINE viewL #-}

-- | A 'Seq' is isomorphic to a 'ViewR'
--
-- @'viewr' m ≡ m 'Optics.Operators.^.' 'viewR'@
--
-- >>> Seq.fromList [1,2,3] ^. viewR
-- fromList [1,2] :> 3
--
-- >>> Seq.empty ^. viewR
-- EmptyR
--
-- >>> EmptyR ^. re viewR
-- fromList []
--
-- >>> review viewR $ Seq.fromList [1,2] Seq.:> 3
-- fromList [1,2,3]
viewR :: Iso (Seq a) (Seq b) (ViewR a) (ViewR b)
viewR :: Iso (Seq a) (Seq b) (ViewR a) (ViewR b)
viewR = (Seq a -> ViewR a)
-> (ViewR b -> Seq b) -> Iso (Seq a) (Seq b) (ViewR a) (ViewR b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Seq a -> ViewR a
forall a. Seq a -> ViewR a
Seq.viewr ((ViewR b -> Seq b) -> Iso (Seq a) (Seq b) (ViewR a) (ViewR b))
-> (ViewR b -> Seq b) -> Iso (Seq a) (Seq b) (ViewR a) (ViewR b)
forall a b. (a -> b) -> a -> b
$ \ViewR b
xs -> case ViewR b
xs of
  ViewR b
EmptyR      -> Seq b
forall a. Monoid a => a
mempty
  Seq b
as Seq.:> b
a -> Seq b
as Seq b -> b -> Seq b
forall a. Seq a -> a -> Seq a
Seq.|> b
a
{-# INLINE viewR #-}

-- | Traverse the first @n@ elements of a 'Seq'
--
-- >>> Seq.fromList [1,2,3,4,5] ^.. slicedTo 2
-- [1,2]
--
-- >>> Seq.fromList [1,2,3,4,5] & slicedTo 2 %~ (*10)
-- fromList [10,20,3,4,5]
--
-- >>> Seq.fromList [1,2,4,5,6] & slicedTo 10 .~ 0
-- fromList [0,0,0,0,0]
slicedTo :: Int -> IxTraversal' Int (Seq a) a
slicedTo :: Int -> IxTraversal' Int (Seq a) a
slicedTo Int
n = Optic A_Traversal NoIx (Seq a) (Seq a) a a
-> IxTraversal' Int (Seq a) a -> IxTraversal' Int (Seq a) a
forall (is :: IxList) i k s t a b.
HasSingleIndex is i =>
Optic k NoIx s t a b -> Optic k is s t a b -> Optic k is s t a b
conjoined Optic A_Traversal NoIx (Seq a) (Seq a) a a
noix IxTraversal' Int (Seq a) a
ix
  where
    noix :: Optic A_Traversal NoIx (Seq a) (Seq a) a a
noix = TraversalVL (Seq a) (Seq a) a a
-> Optic A_Traversal NoIx (Seq a) (Seq a) a a
forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL (TraversalVL (Seq a) (Seq a) a a
 -> Optic A_Traversal NoIx (Seq a) (Seq a) a a)
-> TraversalVL (Seq a) (Seq a) a a
-> Optic A_Traversal NoIx (Seq a) (Seq a) a a
forall a b. (a -> b) -> a -> b
$ \a -> f a
f Seq a
m -> case Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
n Seq a
m of
      (Seq a
l, Seq a
r) -> (Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
r) (Seq a -> Seq a) -> f (Seq a) -> f (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f a) -> Seq a -> f (Seq a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f a
f Seq a
l

    ix :: IxTraversal' Int (Seq a) a
ix = IxTraversalVL Int (Seq a) (Seq a) a a -> IxTraversal' Int (Seq a) a
forall i s t a b. IxTraversalVL i s t a b -> IxTraversal i s t a b
itraversalVL (IxTraversalVL Int (Seq a) (Seq a) a a
 -> IxTraversal' Int (Seq a) a)
-> IxTraversalVL Int (Seq a) (Seq a) a a
-> IxTraversal' Int (Seq a) a
forall a b. (a -> b) -> a -> b
$ \Int -> a -> f a
f Seq a
m -> case Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
n Seq a
m of
      (Seq a
l, Seq a
r) -> (Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
r) (Seq a -> Seq a) -> f (Seq a) -> f (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> a -> f a) -> Seq a -> f (Seq a)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse Int -> a -> f a
f Seq a
l
{-# INLINE slicedTo #-}

-- | Traverse all but the first @n@ elements of a 'Seq'
--
-- >>> Seq.fromList [1,2,3,4,5] ^.. slicedFrom 2
-- [3,4,5]
--
-- >>> Seq.fromList [1,2,3,4,5] & slicedFrom 2 %~ (*10)
-- fromList [1,2,30,40,50]
--
-- >>> Seq.fromList [1,2,3,4,5] & slicedFrom 10 .~ 0
-- fromList [1,2,3,4,5]
slicedFrom :: Int -> IxTraversal' Int (Seq a) a
slicedFrom :: Int -> IxTraversal' Int (Seq a) a
slicedFrom Int
n = Optic A_Traversal NoIx (Seq a) (Seq a) a a
-> IxTraversal' Int (Seq a) a -> IxTraversal' Int (Seq a) a
forall (is :: IxList) i k s t a b.
HasSingleIndex is i =>
Optic k NoIx s t a b -> Optic k is s t a b -> Optic k is s t a b
conjoined Optic A_Traversal NoIx (Seq a) (Seq a) a a
noix IxTraversal' Int (Seq a) a
ix
  where
    noix :: Optic A_Traversal NoIx (Seq a) (Seq a) a a
noix = TraversalVL (Seq a) (Seq a) a a
-> Optic A_Traversal NoIx (Seq a) (Seq a) a a
forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL (TraversalVL (Seq a) (Seq a) a a
 -> Optic A_Traversal NoIx (Seq a) (Seq a) a a)
-> TraversalVL (Seq a) (Seq a) a a
-> Optic A_Traversal NoIx (Seq a) (Seq a) a a
forall a b. (a -> b) -> a -> b
$ \a -> f a
f Seq a
m -> case Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
n Seq a
m of
      (Seq a
l, Seq a
r) -> (Seq a
l Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
><) (Seq a -> Seq a) -> f (Seq a) -> f (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f a) -> Seq a -> f (Seq a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f a
f Seq a
r

    ix :: IxTraversal' Int (Seq a) a
ix = IxTraversalVL Int (Seq a) (Seq a) a a -> IxTraversal' Int (Seq a) a
forall i s t a b. IxTraversalVL i s t a b -> IxTraversal i s t a b
itraversalVL (IxTraversalVL Int (Seq a) (Seq a) a a
 -> IxTraversal' Int (Seq a) a)
-> IxTraversalVL Int (Seq a) (Seq a) a a
-> IxTraversal' Int (Seq a) a
forall a b. (a -> b) -> a -> b
$ \Int -> a -> f a
f Seq a
m -> case Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
n Seq a
m of
      (Seq a
l, Seq a
r) -> (Seq a
l Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
><) (Seq a -> Seq a) -> f (Seq a) -> f (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> a -> f a) -> Seq a -> f (Seq a)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (Int -> a -> f a
f (Int -> a -> f a) -> (Int -> Int) -> Int -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n)) Seq a
r
{-# INLINE slicedFrom #-}

-- | Traverse all the elements numbered from @i@ to @j@ of a 'Seq'
--
-- >>> Seq.fromList [1,2,3,4,5] & sliced 1 3 %~ (*10)
-- fromList [1,20,30,4,5]
--
-- >>> Seq.fromList [1,2,3,4,5] ^.. sliced 1 3
-- [2,3]
--
-- >>> Seq.fromList [1,2,3,4,5] & sliced 1 3 .~ 0
-- fromList [1,0,0,4,5]
sliced :: Int -> Int -> IxTraversal' Int (Seq a) a
sliced :: Int -> Int -> IxTraversal' Int (Seq a) a
sliced Int
i Int
j = Optic A_Traversal NoIx (Seq a) (Seq a) a a
-> IxTraversal' Int (Seq a) a -> IxTraversal' Int (Seq a) a
forall (is :: IxList) i k s t a b.
HasSingleIndex is i =>
Optic k NoIx s t a b -> Optic k is s t a b -> Optic k is s t a b
conjoined Optic A_Traversal NoIx (Seq a) (Seq a) a a
noix IxTraversal' Int (Seq a) a
ix
  where
    noix :: Optic A_Traversal NoIx (Seq a) (Seq a) a a
noix = TraversalVL (Seq a) (Seq a) a a
-> Optic A_Traversal NoIx (Seq a) (Seq a) a a
forall s t a b. TraversalVL s t a b -> Traversal s t a b
traversalVL (TraversalVL (Seq a) (Seq a) a a
 -> Optic A_Traversal NoIx (Seq a) (Seq a) a a)
-> TraversalVL (Seq a) (Seq a) a a
-> Optic A_Traversal NoIx (Seq a) (Seq a) a a
forall a b. (a -> b) -> a -> b
$ \a -> f a
f Seq a
s -> case Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
i Seq a
s of
      (Seq a
l, Seq a
mr) -> case Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) Seq a
mr of
        (Seq a
m, Seq a
r) -> (a -> f a) -> Seq a -> f (Seq a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f a
f Seq a
m f (Seq a) -> (Seq a -> Seq a) -> f (Seq a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Seq a
n -> Seq a
l Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
n Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
r

    ix :: IxTraversal' Int (Seq a) a
ix = IxTraversalVL Int (Seq a) (Seq a) a a -> IxTraversal' Int (Seq a) a
forall i s t a b. IxTraversalVL i s t a b -> IxTraversal i s t a b
itraversalVL (IxTraversalVL Int (Seq a) (Seq a) a a
 -> IxTraversal' Int (Seq a) a)
-> IxTraversalVL Int (Seq a) (Seq a) a a
-> IxTraversal' Int (Seq a) a
forall a b. (a -> b) -> a -> b
$ \Int -> a -> f a
f Seq a
s -> case Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
i Seq a
s of
      (Seq a
l, Seq a
mr) -> case Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) Seq a
mr of
        (Seq a
m, Seq a
r) -> (Int -> a -> f a) -> Seq a -> f (Seq a)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (Int -> a -> f a
f (Int -> a -> f a) -> (Int -> Int) -> Int -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i)) Seq a
m f (Seq a) -> (Seq a -> Seq a) -> f (Seq a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Seq a
n -> Seq a
l Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
n Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
r
{-# INLINE sliced #-}

-- | Construct a 'Seq' from a fold.
--
-- >>> seqOf folded ["hello","world"]
-- fromList ["hello","world"]
--
-- >>> seqOf (folded % _2) [("hello",1),("world",2),("!!!",3)]
-- fromList [1,2,3]
seqOf :: Is k A_Fold => Optic' k is s a -> s -> Seq a
seqOf :: Optic' k is s a -> s -> Seq a
seqOf Optic' k is s a
l = Optic' k is s a -> (a -> Seq a) -> s -> Seq a
forall k m (is :: IxList) s a.
(Is k A_Fold, Monoid m) =>
Optic' k is s a -> (a -> m) -> s -> m
foldMapOf Optic' k is s a
l a -> Seq a
forall a. a -> Seq a
Seq.singleton
{-# INLINE seqOf #-}

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