{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Strict.Sequence.Lens
  ( viewL
  , viewR
  , slicedTo
  , slicedFrom
  , sliced
  , seqOf
  ) where

import           Control.Lens

import qualified Data.Foldable as Foldable
import qualified Data.Strict.Sequence as Seq

import           Data.Strict.Sequence (Seq, ViewL(EmptyL), ViewR(EmptyR), (><), viewl, viewr)


#if !MIN_VERSION_lens(5,0,0)
instance FunctorWithIndex Int Seq where
  imap = Seq.mapWithIndex
  {-# INLINE imap #-}

instance FoldableWithIndex Int Seq where
  ifoldMap = Seq.foldMapWithIndex
  {-# INLINE ifoldMap #-}
  ifoldr = Seq.foldrWithIndex
  {-# INLINE ifoldr #-}
  ifoldl f = Seq.foldlWithIndex (flip f)
  {-# INLINE ifoldl #-}

instance TraversableWithIndex Int Seq where
  itraverse = Seq.traverseWithIndex
  {-# INLINE itraverse #-}
#endif

type instance Index (Seq a) = Int
type instance IxValue (Seq a) = a
instance Ixed (Seq a) where
  -- This is slightly different from lens' definition to make our ixTest work.
  -- It is analogous to how Map.ix is defined.
  ix :: Index (Seq a) -> Traversal' (Seq a) (IxValue (Seq a))
ix Index (Seq a)
i IxValue (Seq a) -> f (IxValue (Seq a))
f Seq a
m = case forall a. Int -> Seq a -> Maybe a
Seq.lookup Index (Seq a)
i Seq a
m of
    Maybe a
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq a
m
    Just a
v -> IxValue (Seq a) -> f (IxValue (Seq a))
f a
v forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
a -> forall a. Int -> a -> Seq a -> Seq a
Seq.update Index (Seq a)
i a
a Seq a
m
  {-# INLINE ix #-}

instance AsEmpty (Seq a) where
  _Empty :: Prism' (Seq a) ()
_Empty = forall a. a -> (a -> Bool) -> Prism' a ()
nearly forall a. Seq a
Seq.empty forall a. Seq a -> Bool
Seq.null
  {-# INLINE _Empty #-}

instance Each (Seq a) (Seq b) a b where
  each :: Traversal (Seq a) (Seq b) a b
each = forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed
  {-# INLINE each #-}

instance (t ~ Seq a') => Rewrapped (Seq a) t
instance Wrapped (Seq a) where
  type Unwrapped (Seq a) = [a]
  _Wrapped' :: Iso' (Seq a) (Unwrapped (Seq a))
_Wrapped' = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList forall a. [a] -> Seq a
Seq.fromList
  {-# INLINE _Wrapped' #-}

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

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

instance Reversing (Seq a) where
  reversing :: Seq a -> Seq a
reversing = forall a. Seq a -> Seq a
Seq.reverse

-- | Analogous to 'Data.Sequence.Lens.viewL'.
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 #-}

-- | Analogous to 'Data.Sequence.Lens.viewR'.
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 #-}

-- | Analogous to 'Data.Sequence.Lens.slicedTo'.
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 #-}

-- | Analogous to 'Data.Sequence.Lens.slicedFrom'.
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 #-}

-- | Analogous to 'Data.Sequence.Lens.sliced'.
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 #-}

-- | Analogous to 'Data.Sequence.Lens.seqOf'.
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 #-}