{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}
-----------------------------------------------------------------------------

-- |

-- Module      :  Data.Sequence.Lens

-- 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 Data.Sequence.Lens
  ( viewL, viewR
  , sliced, slicedTo, slicedFrom
  , seqOf
  ) where

import Control.Applicative
import Control.Lens
import Data.Monoid
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, ViewL(EmptyL), ViewR(EmptyR), (><), viewl, viewr)
import Prelude

-- $setup

-- >>> import Control.Lens

-- >>> import qualified Data.Sequence as Seq

-- >>> import Data.Sequence (ViewL(EmptyL), ViewR(EmptyR))

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


-- * Sequence isomorphisms


-- | A 'Seq' is isomorphic to a 'ViewL'

--

-- @'viewl' m ≡ m '^.' 'viewL'@

--

-- >>> Seq.fromList [a,b,c] ^. viewL

-- a :< fromList [b,c]

--

-- >>> Seq.empty ^. viewL

-- EmptyL

--

-- >>> EmptyL ^. from viewL

-- fromList []

--

-- >>> review viewL $ a Seq.:< Seq.fromList [b,c]

-- fromList [a,b,c]

viewL :: Iso (Seq a) (Seq b) (ViewL a) (ViewL b)
viewL :: forall a b. Iso (Seq a) (Seq b) (ViewL a) (ViewL b)
viewL = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall a. Seq a -> ViewL a
viewl forall a b. (a -> b) -> a -> b
$ \ ViewL b
xs -> case ViewL b
xs of
  ViewL b
EmptyL ->  forall a. Monoid a => a
mempty
  b
a Seq.:< Seq b
as -> b
a forall a. a -> Seq a -> Seq a
Seq.<| Seq b
as
{-# INLINE viewL #-}

-- | A 'Seq' is isomorphic to a 'ViewR'

--

-- @'viewr' m ≡ m '^.' 'viewR'@

--

-- >>> Seq.fromList [a,b,c] ^. viewR

-- fromList [a,b] :> c

--

-- >>> Seq.empty ^. viewR

-- EmptyR

--

-- >>> EmptyR ^. from viewR

-- fromList []

--

-- >>> review viewR $ Seq.fromList [a,b] Seq.:> c

-- fromList [a,b,c]

viewR :: Iso (Seq a) (Seq b) (ViewR a) (ViewR b)
viewR :: forall a b. Iso (Seq a) (Seq b) (ViewR a) (ViewR b)
viewR = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall a. Seq a -> ViewR a
viewr forall a b. (a -> b) -> a -> b
$ \ViewR b
xs -> case ViewR b
xs of
  ViewR b
EmptyR  -> forall a. Monoid a => a
mempty
  Seq b
as Seq.:> b
a -> Seq b
as forall a. Seq a -> a -> Seq a
Seq.|> b
a
{-# INLINE viewR #-}

-- | Traverse the first @n@ elements of a 'Seq'

--

-- >>> Seq.fromList [a,b,c,d,e] ^.. slicedTo 2

-- [a,b]

--

-- >>> Seq.fromList [a,b,c,d,e] & slicedTo 2 %~ f

-- fromList [f a,f b,c,d,e]

--

-- >>> Seq.fromList [a,b,c,d,e] & slicedTo 10 .~ x

-- fromList [x,x,x,x,x]

slicedTo :: Int -> IndexedTraversal' Int (Seq a) a
slicedTo :: forall a. Int -> IndexedTraversal' Int (Seq a) a
slicedTo Int
n p a (f a)
f Seq a
m = case forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
n Seq a
m of
  (Seq a
l,Seq a
r) -> (forall a. Seq a -> Seq a -> Seq a
>< Seq a
r) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f a)
f) Seq a
l
{-# INLINE slicedTo #-}

-- | Traverse all but the first @n@ elements of a 'Seq'

--

-- >>> Seq.fromList [a,b,c,d,e] ^.. slicedFrom 2

-- [c,d,e]

--

-- >>> Seq.fromList [a,b,c,d,e] & slicedFrom 2 %~ f

-- fromList [a,b,f c,f d,f e]

--

-- >>> Seq.fromList [a,b,c,d,e] & slicedFrom 10 .~ x

-- fromList [a,b,c,d,e]

slicedFrom :: Int -> IndexedTraversal' Int (Seq a) a
slicedFrom :: forall a. Int -> IndexedTraversal' Int (Seq a) a
slicedFrom Int
n p a (f a)
f Seq a
m = case 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 forall a. Seq a -> Seq a -> Seq a
><) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f a)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 [a,b,c,d,e] & sliced 1 3 %~ f

-- fromList [a,f b,f c,d,e]


-- >>> Seq.fromList [a,b,c,d,e] ^.. sliced 1 3

-- [f b,f c]

--

-- >>> Seq.fromList [a,b,c,d,e] & sliced 1 3 .~ x

-- fromList [a,x,x,b,e]

sliced :: Int -> Int -> IndexedTraversal' Int (Seq a) a
sliced :: forall a. Int -> Int -> IndexedTraversal' Int (Seq a) a
sliced Int
i Int
j p a (f a)
f Seq a
s = case forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
i Seq a
s of
  (Seq a
l,Seq a
mr) -> case forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt (Int
jforall a. Num a => a -> a -> a
-Int
i) Seq a
mr of
     (Seq a
m, Seq a
r) -> forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f a)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+Int
i)) Seq a
m forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Seq a
n -> Seq a
l forall a. Seq a -> Seq a -> Seq a
>< Seq a
n forall a. Seq a -> Seq a -> Seq a
>< Seq a
r
{-# INLINE sliced #-}

-- | Construct a 'Seq' from a 'Getter', 'Control.Lens.Fold.Fold', 'Control.Lens.Traversal.Traversal', 'Control.Lens.Lens.Lens' or 'Control.Lens.Iso.Iso'.

--

-- >>> seqOf folded ["hello","world"]

-- fromList ["hello","world"]

--

-- >>> seqOf (folded._2) [("hello",1),("world",2),("!!!",3)]

-- fromList [1,2,3]

--

-- @

-- 'seqOf' :: 'Getter' s a     -> s -> 'Seq' a

-- 'seqOf' :: 'Fold' s a       -> s -> 'Seq' a

-- 'seqOf' :: 'Iso'' s a       -> s -> 'Seq' a

-- 'seqOf' :: 'Lens'' s a      -> s -> 'Seq' a

-- 'seqOf' :: 'Traversal'' s a -> s -> 'Seq' a

-- @

seqOf :: Getting (Seq a) s a -> s -> Seq a
seqOf :: forall a s. Getting (Seq a) s a -> s -> Seq a
seqOf Getting (Seq a) s a
l = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Getting (Seq a) s a
l forall a. a -> Seq a
Seq.singleton
{-# INLINE seqOf #-}