{-# 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 (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (ViewL a) (f (ViewL b)) -> p (Seq a) (f (Seq 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
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 '^.' '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 (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (ViewR a) (f (ViewR b)) -> p (Seq a) (f (Seq 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
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 [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 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)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> Seq a -> f (Seq b)
itraverse (p a (f a) -> Int -> a -> f a
forall a b. p a b -> Int -> a -> b
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 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)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> Seq a -> f (Seq b)
itraverse (p a (f a) -> Int -> a -> f a
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p 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 [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 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)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> Seq a -> f (Seq b)
itraverse (p a (f a) -> Int -> a -> f a
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p 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 t'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' :: t'Getter' s a    -> s -> 'Seq' a
-- 'seqOf' :: t'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 = Getting (Seq a) s a -> (a -> Seq a) -> s -> Seq a
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Getting (Seq a) s a
l a -> Seq a
forall a. a -> Seq a
Seq.singleton
{-# INLINE seqOf #-}