{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Strict.Sequence.Internal where

import Data.Sequence                as L
import Data.Strict.Sequence.Autogen as S

import Data.Binary
import Data.Foldable
import Data.Foldable.WithIndex
import Data.Functor.WithIndex
import Data.Traversable.WithIndex
import Data.Semigroup (Semigroup (..)) -- helps with compatibility
import Data.Strict.Classes

instance Strict (L.Seq k) (S.Seq k) where
  toStrict :: Seq k -> Seq k
toStrict = [k] -> Seq k
forall a. [a] -> Seq a
S.fromList ([k] -> Seq k) -> (Seq k -> [k]) -> Seq k -> Seq k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq k -> [k]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  toLazy :: Seq k -> Seq k
toLazy = [k] -> Seq k
forall a. [a] -> Seq a
L.fromList ([k] -> Seq k) -> (Seq k -> [k]) -> Seq k -> Seq k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq k -> [k]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  {-# INLINE toStrict #-}
  {-# INLINE toLazy #-}

-- code copied from indexed-traversable

-- | The position in the 'Seq' is available as the index.
instance FunctorWithIndex Int S.Seq where
  imap :: (Int -> a -> b) -> Seq a -> Seq b
imap = (Int -> a -> b) -> Seq a -> Seq b
forall a b. (Int -> a -> b) -> Seq a -> Seq b
S.mapWithIndex
  {-# INLINE imap #-}

instance FoldableWithIndex Int S.Seq where
  ifoldMap :: (Int -> a -> m) -> Seq a -> m
ifoldMap = (Int -> a -> m) -> Seq a -> m
forall m a. Monoid m => (Int -> a -> m) -> Seq a -> m
S.foldMapWithIndex
  {-# INLINE ifoldMap #-}
  ifoldr :: (Int -> a -> b -> b) -> b -> Seq a -> b
ifoldr = (Int -> a -> b -> b) -> b -> Seq a -> b
forall a b. (Int -> a -> b -> b) -> b -> Seq a -> b
S.foldrWithIndex
  {-# INLINE ifoldr #-}
  ifoldl :: (Int -> b -> a -> b) -> b -> Seq a -> b
ifoldl Int -> b -> a -> b
f = (b -> Int -> a -> b) -> b -> Seq a -> b
forall b a. (b -> Int -> a -> b) -> b -> Seq a -> b
S.foldlWithIndex ((Int -> b -> a -> b) -> b -> Int -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> b -> a -> b
f)
  {-# INLINE ifoldl #-}

instance TraversableWithIndex Int S.Seq where
  itraverse :: (Int -> a -> f b) -> Seq a -> f (Seq b)
itraverse = (Int -> a -> f b) -> Seq a -> f (Seq b)
forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> Seq a -> f (Seq b)
S.traverseWithIndex
  {-# INLINE itraverse #-}

-- code copied from binary

instance (Binary e) => Binary (S.Seq e) where
    put :: Seq e -> Put
put Seq e
s = Int -> Put
forall t. Binary t => t -> Put
put (Seq e -> Int
forall a. Seq a -> Int
S.length Seq e
s) Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> (e -> Put) -> Seq e -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ e -> Put
forall t. Binary t => t -> Put
put Seq e
s
    get :: Get (Seq e)
get = do Int
n <- Get Int
forall t. Binary t => Get t
get :: Get Int
             Seq e -> Int -> Get e -> Get (Seq e)
forall t (m :: * -> *) a.
(Eq t, Num t, Monad m) =>
Seq a -> t -> m a -> m (Seq a)
rep Seq e
forall a. Seq a
S.empty Int
n Get e
forall t. Binary t => Get t
get
      where rep :: Seq a -> t -> m a -> m (Seq a)
rep Seq a
xs t
0 m a
_ = Seq a -> m (Seq a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq a -> m (Seq a)) -> Seq a -> m (Seq a)
forall a b. (a -> b) -> a -> b
$! Seq a
xs
            rep Seq a
xs t
n m a
g = Seq a
xs Seq a -> m (Seq a) -> m (Seq a)
`seq` t
n t -> m (Seq a) -> m (Seq a)
`seq` do
                           a
x <- m a
g
                           Seq a -> t -> m a -> m (Seq a)
rep (Seq a
xs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
S.|> a
x) (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) m a
g