module Data.Sequence.Lens
( at, viewL, viewR
, traverseHead, traverseTail
, traverseLast, traverseInit
, traverseTo, traverseFrom
, traverseSlice
) where
import Control.Applicative
import Control.Lens as Lens
import Data.Monoid
import Data.Sequence as Seq
import Data.Traversable
at :: Int -> SimpleIndexedLens Int (Seq a) a
at i = Lens.index $ \ f m -> (\a -> update i a m) <$> f i (Seq.index m i)
viewL :: Iso (Seq a) (Seq b) (ViewL a) (ViewL b)
viewL = isos viewl unviewl viewl unviewl where
unviewl :: ViewL a -> Seq a
unviewl EmptyL = mempty
unviewl (a :< as) = a <| as
viewR :: Iso (Seq a) (Seq b) (ViewR a) (ViewR b)
viewR = isos viewr unviewr viewr unviewr where
unviewr :: ViewR a -> Seq a
unviewr EmptyR = mempty
unviewr (as :> a) = as |> a
traverseSeq :: IndexedTraversal Int (Seq a) (Seq b) a b
traverseSeq = Lens.index $ \ f -> sequenceA . Seq.mapWithIndex f
traverseHead :: SimpleIndexedTraversal Int (Seq a) a
traverseHead = Lens.index $ \f m -> case viewl m of
a :< as -> (<| as) <$> f (0::Int) a
EmptyL -> pure m
traverseTail :: SimpleIndexedTraversal Int (Seq a) a
traverseTail = Lens.index $ \f m -> case viewl m of
a :< as -> (a <|) <$> withIndex traverseSeq (f . (+1)) as
EmptyL -> pure m
traverseLast :: SimpleIndexedTraversal Int (Seq a) a
traverseLast = Lens.index $ \f m -> case viewr m of
as :> a -> (as |>) <$> f (Seq.length as) a
EmptyR -> pure m
traverseInit :: SimpleIndexedTraversal Int (Seq a) a
traverseInit = Lens.index $ \ f m -> case viewr m of
as :> a -> (|> a) <$> withIndex traverseSeq f as
EmptyR -> pure m
traverseTo :: Int -> SimpleIndexedTraversal Int (Seq a) a
traverseTo n = Lens.index $ \f m -> case Seq.splitAt n m of
(l,r) -> (>< r) <$> withIndex traverseSeq f l
traverseFrom :: Int -> SimpleIndexedTraversal Int (Seq a) a
traverseFrom n = Lens.index $ \ f m -> case Seq.splitAt n m of
(l,r) -> (l ><) <$> withIndex traverseSeq (f . (+n)) r
traverseSlice :: Int -> Int -> SimpleIndexedTraversal Int (Seq a) a
traverseSlice i j = Lens.index $ \ f s -> case Seq.splitAt i s of
(l,mr) -> case Seq.splitAt (ji) mr of
(m, r) -> (\n -> l >< n >< r) <$> withIndex traverseSeq (f . (+i)) m