{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

-- | Strict variants of 'Seq' operations.
module Data.Sequence.Strict (
  StrictSeq (Empty, (:<|), (:|>)),
  fromStrict,
  forceToStrict,

  -- * Construction
  empty,
  singleton,
  (<|),
  (|>),
  (><),
  fromList,

  -- * Deconstruction

  -- | Additional functions for deconstructing sequences are available
  -- via the 'Foldable' instance of 'Seq'.

  -- ** Queries
  null,
  length,

  -- * Scans
  scanl,

  -- * Sublists

  -- ** Sequential searches
  takeWhileL,
  takeWhileR,
  dropWhileL,
  dropWhileR,
  spanl,
  spanr,

  -- * Indexing
  lookup,
  (!?),
  take,
  takeLast,
  drop,
  dropLast,
  splitAt,
  splitAtEnd,

  -- * Indexing with predicates
  findIndexL,
  findIndicesL,
  findIndexR,
  findIndicesR,

  -- * Zips and unzips
  zip,
  zipWith,
  unzip,
  unzipWith,
)
where

import Cardano.Binary (FromCBOR (..), ToCBOR (..))
import Codec.Serialise (Serialise)
import Control.Arrow ((***))
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Foldable (toList)
import qualified Data.Foldable as F (foldl')
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Unit.Strict (forceElemsToWHNF)
import qualified GHC.Exts as GHC (IsList (..))
import NoThunks.Class (NoThunks (..), noThunksInValues)
import Prelude hiding (
  drop,
  length,
  lookup,
  null,
  scanl,
  splitAt,
  take,
  unzip,
  zip,
  zipWith,
 )

infixr 5 ><

infixr 5 <|

infixl 5 |>

infixr 5 :<|

infixl 5 :|>

{-# COMPLETE Empty, (:<|) #-}

{-# COMPLETE Empty, (:|>) #-}

-- | A @newtype@ wrapper around a 'Seq', representing a general-purpose finite
-- sequence that is strict in its values.
--
-- This strictness is not enforced at the type level, but rather by the
-- construction functions in this module. These functions essentially just
-- wrap the original "Data.Sequence" functions while forcing the provided
-- value to WHNF.
newtype StrictSeq a = StrictSeq {forall a. StrictSeq a -> Seq a
fromStrict :: Seq a}
  deriving stock (StrictSeq a -> StrictSeq a -> Bool
forall a. Eq a => StrictSeq a -> StrictSeq a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StrictSeq a -> StrictSeq a -> Bool
$c/= :: forall a. Eq a => StrictSeq a -> StrictSeq a -> Bool
== :: StrictSeq a -> StrictSeq a -> Bool
$c== :: forall a. Eq a => StrictSeq a -> StrictSeq a -> Bool
Eq, StrictSeq a -> StrictSeq a -> Bool
StrictSeq a -> StrictSeq a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (StrictSeq a)
forall a. Ord a => StrictSeq a -> StrictSeq a -> Bool
forall a. Ord a => StrictSeq a -> StrictSeq a -> Ordering
forall a. Ord a => StrictSeq a -> StrictSeq a -> StrictSeq a
min :: StrictSeq a -> StrictSeq a -> StrictSeq a
$cmin :: forall a. Ord a => StrictSeq a -> StrictSeq a -> StrictSeq a
max :: StrictSeq a -> StrictSeq a -> StrictSeq a
$cmax :: forall a. Ord a => StrictSeq a -> StrictSeq a -> StrictSeq a
>= :: StrictSeq a -> StrictSeq a -> Bool
$c>= :: forall a. Ord a => StrictSeq a -> StrictSeq a -> Bool
> :: StrictSeq a -> StrictSeq a -> Bool
$c> :: forall a. Ord a => StrictSeq a -> StrictSeq a -> Bool
<= :: StrictSeq a -> StrictSeq a -> Bool
$c<= :: forall a. Ord a => StrictSeq a -> StrictSeq a -> Bool
< :: StrictSeq a -> StrictSeq a -> Bool
$c< :: forall a. Ord a => StrictSeq a -> StrictSeq a -> Bool
compare :: StrictSeq a -> StrictSeq a -> Ordering
$ccompare :: forall a. Ord a => StrictSeq a -> StrictSeq a -> Ordering
Ord, Int -> StrictSeq a -> ShowS
forall a. Show a => Int -> StrictSeq a -> ShowS
forall a. Show a => [StrictSeq a] -> ShowS
forall a. Show a => StrictSeq a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StrictSeq a] -> ShowS
$cshowList :: forall a. Show a => [StrictSeq a] -> ShowS
show :: StrictSeq a -> String
$cshow :: forall a. Show a => StrictSeq a -> String
showsPrec :: Int -> StrictSeq a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> StrictSeq a -> ShowS
Show)
  deriving newtype (forall a. Eq a => a -> StrictSeq a -> Bool
forall a. Num a => StrictSeq a -> a
forall a. Ord a => StrictSeq a -> a
forall m. Monoid m => StrictSeq m -> m
forall a. StrictSeq a -> Bool
forall a. StrictSeq a -> Int
forall a. StrictSeq a -> [a]
forall a. (a -> a -> a) -> StrictSeq a -> a
forall m a. Monoid m => (a -> m) -> StrictSeq a -> m
forall b a. (b -> a -> b) -> b -> StrictSeq a -> b
forall a b. (a -> b -> b) -> b -> StrictSeq a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => StrictSeq a -> a
$cproduct :: forall a. Num a => StrictSeq a -> a
sum :: forall a. Num a => StrictSeq a -> a
$csum :: forall a. Num a => StrictSeq a -> a
minimum :: forall a. Ord a => StrictSeq a -> a
$cminimum :: forall a. Ord a => StrictSeq a -> a
maximum :: forall a. Ord a => StrictSeq a -> a
$cmaximum :: forall a. Ord a => StrictSeq a -> a
elem :: forall a. Eq a => a -> StrictSeq a -> Bool
$celem :: forall a. Eq a => a -> StrictSeq a -> Bool
length :: forall a. StrictSeq a -> Int
$clength :: forall a. StrictSeq a -> Int
null :: forall a. StrictSeq a -> Bool
$cnull :: forall a. StrictSeq a -> Bool
toList :: forall a. StrictSeq a -> [a]
$ctoList :: forall a. StrictSeq a -> [a]
foldl1 :: forall a. (a -> a -> a) -> StrictSeq a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> StrictSeq a -> a
foldr1 :: forall a. (a -> a -> a) -> StrictSeq a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> StrictSeq a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> StrictSeq a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> StrictSeq a -> b
foldl :: forall b a. (b -> a -> b) -> b -> StrictSeq a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> StrictSeq a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> StrictSeq a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> StrictSeq a -> b
foldr :: forall a b. (a -> b -> b) -> b -> StrictSeq a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> StrictSeq a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> StrictSeq a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> StrictSeq a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> StrictSeq a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> StrictSeq a -> m
fold :: forall m. Monoid m => StrictSeq m -> m
$cfold :: forall m. Monoid m => StrictSeq m -> m
Foldable, StrictSeq a
[StrictSeq a] -> StrictSeq a
StrictSeq a -> StrictSeq a -> StrictSeq a
forall {a}. Semigroup (StrictSeq a)
forall a. StrictSeq a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [StrictSeq a] -> StrictSeq a
forall a. StrictSeq a -> StrictSeq a -> StrictSeq a
mconcat :: [StrictSeq a] -> StrictSeq a
$cmconcat :: forall a. [StrictSeq a] -> StrictSeq a
mappend :: StrictSeq a -> StrictSeq a -> StrictSeq a
$cmappend :: forall a. StrictSeq a -> StrictSeq a -> StrictSeq a
mempty :: StrictSeq a
$cmempty :: forall a. StrictSeq a
Monoid, NonEmpty (StrictSeq a) -> StrictSeq a
StrictSeq a -> StrictSeq a -> StrictSeq a
forall b. Integral b => b -> StrictSeq a -> StrictSeq a
forall a. NonEmpty (StrictSeq a) -> StrictSeq a
forall a. StrictSeq a -> StrictSeq a -> StrictSeq a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> StrictSeq a -> StrictSeq a
stimes :: forall b. Integral b => b -> StrictSeq a -> StrictSeq a
$cstimes :: forall a b. Integral b => b -> StrictSeq a -> StrictSeq a
sconcat :: NonEmpty (StrictSeq a) -> StrictSeq a
$csconcat :: forall a. NonEmpty (StrictSeq a) -> StrictSeq a
<> :: StrictSeq a -> StrictSeq a -> StrictSeq a
$c<> :: forall a. StrictSeq a -> StrictSeq a -> StrictSeq a
Semigroup, [StrictSeq a] -> Encoding
StrictSeq a -> Encoding
forall s. Decoder s [StrictSeq a]
forall s. Decoder s (StrictSeq a)
forall a. Serialise a => [StrictSeq a] -> Encoding
forall a. Serialise a => StrictSeq a -> Encoding
forall a s. Serialise a => Decoder s [StrictSeq a]
forall a s. Serialise a => Decoder s (StrictSeq a)
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: forall s. Decoder s [StrictSeq a]
$cdecodeList :: forall a s. Serialise a => Decoder s [StrictSeq a]
encodeList :: [StrictSeq a] -> Encoding
$cencodeList :: forall a. Serialise a => [StrictSeq a] -> Encoding
decode :: forall s. Decoder s (StrictSeq a)
$cdecode :: forall a s. Serialise a => Decoder s (StrictSeq a)
encode :: StrictSeq a -> Encoding
$cencode :: forall a. Serialise a => StrictSeq a -> Encoding
Serialise, StrictSeq a -> ()
forall a. NFData a => StrictSeq a -> ()
forall a. (a -> ()) -> NFData a
rnf :: StrictSeq a -> ()
$crnf :: forall a. NFData a => StrictSeq a -> ()
NFData)

instance ToCBOR a => ToCBOR (StrictSeq a) where
  toCBOR :: StrictSeq a -> Encoding
toCBOR = forall a. ToCBOR a => a -> Encoding
toCBOR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StrictSeq a -> Seq a
fromStrict

instance FromCBOR a => FromCBOR (StrictSeq a) where
  fromCBOR :: forall s. Decoder s (StrictSeq a)
fromCBOR = forall a. Seq a -> StrictSeq a
forceToStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. FromCBOR a => Decoder s a
fromCBOR

instance Functor StrictSeq where
  fmap :: forall a b. (a -> b) -> StrictSeq a -> StrictSeq b
fmap a -> b
f (StrictSeq Seq a
s) = forall a. Seq a -> StrictSeq a
StrictSeq forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> t a
forceElemsToWHNF forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seq a
s

instance Traversable StrictSeq where
  sequenceA :: forall (f :: * -> *) a.
Applicative f =>
StrictSeq (f a) -> f (StrictSeq a)
sequenceA (StrictSeq Seq (f a)
xs) = forall a. Seq a -> StrictSeq a
forceToStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA Seq (f a)
xs

-- | Instance for 'StrictSeq' checks elements only
--
-- The internal fingertree in 'Seq' might have thunks, which is essential for
-- its asymptotic complexity.
instance NoThunks a => NoThunks (StrictSeq a) where
  showTypeOf :: Proxy (StrictSeq a) -> String
showTypeOf Proxy (StrictSeq a)
_ = String
"StrictSeq"
  wNoThunks :: Context -> StrictSeq a -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt = forall a. NoThunks a => Context -> [a] -> IO (Maybe ThunkInfo)
noThunksInValues Context
ctxt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance FromJSON a => FromJSON (StrictSeq a) where
  parseJSON :: Value -> Parser (StrictSeq a)
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> StrictSeq a
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON

instance ToJSON a => ToJSON (StrictSeq a) where
  toJSON :: StrictSeq a -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  toEncoding :: StrictSeq a -> Encoding
toEncoding = forall a. ToJSON a => a -> Encoding
toEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance GHC.IsList (StrictSeq a) where
  type Item (StrictSeq a) = a
  fromList :: [Item (StrictSeq a)] -> StrictSeq a
fromList = forall a. [a] -> StrictSeq a
fromList
  toList :: StrictSeq a -> [Item (StrictSeq a)]
toList = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StrictSeq a -> Seq a
fromStrict

-- | A helper function for the ':<|' pattern.
viewFront :: StrictSeq a -> Maybe (a, StrictSeq a)
viewFront :: forall a. StrictSeq a -> Maybe (a, StrictSeq a)
viewFront (StrictSeq Seq a
xs) = case forall a. Seq a -> ViewL a
Seq.viewl Seq a
xs of
  ViewL a
Seq.EmptyL -> forall a. Maybe a
Nothing
  a
x Seq.:< Seq a
xs' -> forall a. a -> Maybe a
Just (a
x, forall a. Seq a -> StrictSeq a
StrictSeq Seq a
xs')

-- | A helper function for the ':|>' pattern.
viewBack :: StrictSeq a -> Maybe (StrictSeq a, a)
viewBack :: forall a. StrictSeq a -> Maybe (StrictSeq a, a)
viewBack (StrictSeq Seq a
xs) = case forall a. Seq a -> ViewR a
Seq.viewr Seq a
xs of
  ViewR a
Seq.EmptyR -> forall a. Maybe a
Nothing
  Seq a
xs' Seq.:> a
x -> forall a. a -> Maybe a
Just (forall a. Seq a -> StrictSeq a
StrictSeq Seq a
xs', a
x)

-- | A bidirectional pattern synonym matching an empty sequence.
pattern Empty :: StrictSeq a
pattern $bEmpty :: forall a. StrictSeq a
$mEmpty :: forall {r} {a}. StrictSeq a -> ((# #) -> r) -> ((# #) -> r) -> r
Empty = StrictSeq Seq.Empty

-- | A bidirectional pattern synonym viewing the front of a non-empty
-- sequence.
pattern (:<|) :: a -> StrictSeq a -> StrictSeq a
pattern x $b:<| :: forall a. a -> StrictSeq a -> StrictSeq a
$m:<| :: forall {r} {a}.
StrictSeq a -> (a -> StrictSeq a -> r) -> ((# #) -> r) -> r
:<| xs <-
  (viewFront -> Just (x, xs))
  where
    a
x :<| StrictSeq a
xs = a
x forall a. a -> StrictSeq a -> StrictSeq a
<| StrictSeq a
xs

-- | A bidirectional pattern synonym viewing the rear of a non-empty
-- sequence.
pattern (:|>) :: StrictSeq a -> a -> StrictSeq a
pattern xs $b:|> :: forall a. StrictSeq a -> a -> StrictSeq a
$m:|> :: forall {r} {a}.
StrictSeq a -> (StrictSeq a -> a -> r) -> ((# #) -> r) -> r
:|> x <-
  (viewBack -> Just (xs, x))
  where
    StrictSeq a
xs :|> a
x = StrictSeq a
xs forall a. StrictSeq a -> a -> StrictSeq a
|> a
x

{-------------------------------------------------------------------------------
  Construction
-------------------------------------------------------------------------------}

-- | \( O(1) \). The empty sequence.
empty :: StrictSeq a
empty :: forall a. StrictSeq a
empty = forall a. StrictSeq a
Empty

-- | \( O(1) \). A singleton sequence.
singleton :: a -> StrictSeq a
singleton :: forall a. a -> StrictSeq a
singleton !a
x = forall a. Seq a -> StrictSeq a
StrictSeq (forall a. a -> Seq a
Seq.singleton a
x)

-- | \( O(1) \). Add an element to the left end of a sequence.
-- Mnemonic: a triangle with the single element at the pointy end.
(<|) :: a -> StrictSeq a -> StrictSeq a
(!a
x) <| :: forall a. a -> StrictSeq a -> StrictSeq a
<| StrictSeq Seq a
s = forall a. Seq a -> StrictSeq a
StrictSeq (a
x forall a. a -> Seq a -> Seq a
Seq.<| Seq a
s)

-- | \( O(1) \). Add an element to the right end of a sequence.
-- Mnemonic: a triangle with the single element at the pointy end.
(|>) :: StrictSeq a -> a -> StrictSeq a
StrictSeq Seq a
s |> :: forall a. StrictSeq a -> a -> StrictSeq a
|> (!a
x) = forall a. Seq a -> StrictSeq a
StrictSeq (Seq a
s forall a. Seq a -> a -> Seq a
Seq.|> a
x)

-- | \( O(\log(\min(n_1,n_2))) \). Concatenate two sequences.
(><) :: StrictSeq a -> StrictSeq a -> StrictSeq a
StrictSeq Seq a
xs >< :: forall a. StrictSeq a -> StrictSeq a -> StrictSeq a
>< StrictSeq Seq a
ys = forall a. Seq a -> StrictSeq a
StrictSeq (Seq a
xs forall a. Seq a -> Seq a -> Seq a
Seq.>< Seq a
ys)

fromList :: [a] -> StrictSeq a
fromList :: forall a. [a] -> StrictSeq a
fromList ![a]
xs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' forall a. StrictSeq a -> a -> StrictSeq a
(|>) forall a. StrictSeq a
empty [a]
xs

-- | Convert a 'Seq' into a 'StrictSeq' by forcing each element to WHNF.
forceToStrict :: Seq a -> StrictSeq a
forceToStrict :: forall a. Seq a -> StrictSeq a
forceToStrict Seq a
xs = forall a. Seq a -> StrictSeq a
StrictSeq (forall (t :: * -> *) a. Foldable t => t a -> t a
forceElemsToWHNF Seq a
xs)

{-------------------------------------------------------------------------------
  Deconstruction
-------------------------------------------------------------------------------}

-- | \( O(1) \). Is this the empty sequence?
null :: StrictSeq a -> Bool
null :: forall a. StrictSeq a -> Bool
null (StrictSeq Seq a
xs) = forall a. Seq a -> Bool
Seq.null Seq a
xs

-- | \( O(1) \). The number of elements in the sequence.
length :: StrictSeq a -> Int
length :: forall a. StrictSeq a -> Int
length (StrictSeq Seq a
xs) = forall a. Seq a -> Int
Seq.length Seq a
xs

{-------------------------------------------------------------------------------
  Scans
-------------------------------------------------------------------------------}

-- | 'scanl' is similar to 'foldl', but returns a sequence of reduced
-- values from the left:
--
-- > scanl f z (fromList [x1, x2, ...]) = fromList [z, z `f` x1, (z `f` x1) `f` x2, ...]
scanl :: (a -> b -> a) -> a -> StrictSeq b -> StrictSeq a
scanl :: forall a b. (a -> b -> a) -> a -> StrictSeq b -> StrictSeq a
scanl a -> b -> a
f !a
z0 (StrictSeq Seq b
xs) = forall a. Seq a -> StrictSeq a
StrictSeq forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> t a
forceElemsToWHNF (forall a b. (a -> b -> a) -> a -> Seq b -> Seq a
Seq.scanl a -> b -> a
f a
z0 Seq b
xs)

{-------------------------------------------------------------------------------
  Sublists
-------------------------------------------------------------------------------}

-- | \( O(i) \) where \( i \) is the prefix length. 'takeWhileL', applied
-- to a predicate @p@ and a sequence @xs@, returns the longest prefix
-- (possibly empty) of @xs@ of elements that satisfy @p@.
takeWhileL :: (a -> Bool) -> StrictSeq a -> StrictSeq a
takeWhileL :: forall a. (a -> Bool) -> StrictSeq a -> StrictSeq a
takeWhileL a -> Bool
p (StrictSeq Seq a
xs) = forall a. Seq a -> StrictSeq a
StrictSeq (forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileL a -> Bool
p Seq a
xs)

-- | \( O(i) \) where \( i \) is the suffix length.  'takeWhileR', applied
-- to a predicate @p@ and a sequence @xs@, returns the longest suffix
-- (possibly empty) of @xs@ of elements that satisfy @p@.
--
-- @'takeWhileR' p xs@ is equivalent to @'reverse' ('takeWhileL' p ('reverse' xs))@.
takeWhileR :: (a -> Bool) -> StrictSeq a -> StrictSeq a
takeWhileR :: forall a. (a -> Bool) -> StrictSeq a -> StrictSeq a
takeWhileR a -> Bool
p (StrictSeq Seq a
xs) = forall a. Seq a -> StrictSeq a
StrictSeq (forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileR a -> Bool
p Seq a
xs)

-- | \( O(i) \) where \( i \) is the prefix length.  @'dropWhileL' p xs@ returns
-- the suffix remaining after @'takeWhileL' p xs@.
dropWhileL :: (a -> Bool) -> StrictSeq a -> StrictSeq a
dropWhileL :: forall a. (a -> Bool) -> StrictSeq a -> StrictSeq a
dropWhileL a -> Bool
p (StrictSeq Seq a
xs) = forall a. Seq a -> StrictSeq a
StrictSeq (forall a. (a -> Bool) -> Seq a -> Seq a
Seq.dropWhileL a -> Bool
p Seq a
xs)

-- | \( O(i) \) where \( i \) is the suffix length.  @'dropWhileR' p xs@ returns
-- the prefix remaining after @'takeWhileR' p xs@.
--
-- @'dropWhileR' p xs@ is equivalent to @'reverse' ('dropWhileL' p ('reverse' xs))@.
dropWhileR :: (a -> Bool) -> StrictSeq a -> StrictSeq a
dropWhileR :: forall a. (a -> Bool) -> StrictSeq a -> StrictSeq a
dropWhileR a -> Bool
p (StrictSeq Seq a
xs) = forall a. Seq a -> StrictSeq a
StrictSeq (forall a. (a -> Bool) -> Seq a -> Seq a
Seq.dropWhileR a -> Bool
p Seq a
xs)

-- | \( O(i) \) where \( i \) is the prefix length.  'spanl', applied to
-- a predicate @p@ and a sequence @xs@, returns a pair whose first
-- element is the longest prefix (possibly empty) of @xs@ of elements that
-- satisfy @p@ and the second element is the remainder of the sequence.
spanl :: (a -> Bool) -> StrictSeq a -> (StrictSeq a, StrictSeq a)
spanl :: forall a. (a -> Bool) -> StrictSeq a -> (StrictSeq a, StrictSeq a)
spanl a -> Bool
p (StrictSeq Seq a
xs) = forall a. (Seq a, Seq a) -> (StrictSeq a, StrictSeq a)
toStrictSeqTuple (forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.spanl a -> Bool
p Seq a
xs)

-- | \( O(i) \) where \( i \) is the suffix length.  'spanr', applied to a
-- predicate @p@ and a sequence @xs@, returns a pair whose /first/ element
-- is the longest /suffix/ (possibly empty) of @xs@ of elements that
-- satisfy @p@ and the second element is the remainder of the sequence.
spanr :: (a -> Bool) -> StrictSeq a -> (StrictSeq a, StrictSeq a)
spanr :: forall a. (a -> Bool) -> StrictSeq a -> (StrictSeq a, StrictSeq a)
spanr a -> Bool
p (StrictSeq Seq a
xs) = forall a. (Seq a, Seq a) -> (StrictSeq a, StrictSeq a)
toStrictSeqTuple (forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.spanr a -> Bool
p Seq a
xs)

{-------------------------------------------------------------------------------
  Indexing
-------------------------------------------------------------------------------}

-- | \( O(\log(\min(i,n-i))) \). The element at the specified position,
-- counting from 0. If the specified position is negative or at
-- least the length of the sequence, 'lookup' returns 'Nothing'.
--
-- prop> 0 <= i < length xs ==> lookup i xs == Just (toList xs !! i)
-- prop> i < 0 || i >= length xs ==> lookup i xs = Nothing
--
-- Unlike 'index', this can be used to retrieve an element without
-- forcing it. For example, to insert the fifth element of a sequence
-- @xs@ into a 'Data.Map.Lazy.Map' @m@ at key @k@, you could use
--
-- @
-- case lookup 5 xs of
--   Nothing -> m
--   Just x -> 'Data.Map.Lazy.insert' k x m
-- @
lookup :: Int -> StrictSeq a -> Maybe a
lookup :: forall a. Int -> StrictSeq a -> Maybe a
lookup Int
i (StrictSeq Seq a
xs) = forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
i Seq a
xs

-- | \( O(\log(\min(i,n-i))) \). A flipped, infix version of 'lookup'.
(!?) :: StrictSeq a -> Int -> Maybe a
!? :: forall a. StrictSeq a -> Int -> Maybe a
(!?) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Int -> StrictSeq a -> Maybe a
lookup

-- | \( O(\log(\min(i,n-i))) \). The first @i@ elements of a sequence.
-- If @i@ is negative, @'take' i s@ yields the empty sequence.
-- If the sequence contains fewer than @i@ elements, the whole sequence
-- is returned.
take :: Int -> StrictSeq a -> StrictSeq a
take :: forall a. Int -> StrictSeq a -> StrictSeq a
take Int
i (StrictSeq Seq a
xs) = forall a. Seq a -> StrictSeq a
StrictSeq (forall a. Int -> Seq a -> Seq a
Seq.take Int
i Seq a
xs)

-- | Take the last @n@ elements
--
-- Returns the entire sequence if it has fewer than @n@ elements.
--
-- Inherits asymptotic complexity from @drop@.
takeLast :: Int -> StrictSeq a -> StrictSeq a
takeLast :: forall a. Int -> StrictSeq a -> StrictSeq a
takeLast Int
i StrictSeq a
xs
  | forall a. StrictSeq a -> Int
length StrictSeq a
xs forall a. Ord a => a -> a -> Bool
>= Int
i = forall a. Int -> StrictSeq a -> StrictSeq a
drop (forall a. StrictSeq a -> Int
length StrictSeq a
xs forall a. Num a => a -> a -> a
- Int
i) StrictSeq a
xs
  | Bool
otherwise = StrictSeq a
xs

-- | \( O(\log(\min(i,n-i))) \). Elements of a sequence after the first @i@.
-- If @i@ is negative, @'drop' i s@ yields the whole sequence.
-- If the sequence contains fewer than @i@ elements, the empty sequence
-- is returned.
drop :: Int -> StrictSeq a -> StrictSeq a
drop :: forall a. Int -> StrictSeq a -> StrictSeq a
drop Int
i (StrictSeq Seq a
xs) = forall a. Seq a -> StrictSeq a
StrictSeq (forall a. Int -> Seq a -> Seq a
Seq.drop Int
i Seq a
xs)

-- | Drop the last @n@ elements
--
-- Returns the @Empty@ sequence if it has fewer than @n@ elements.
--
-- Inherits asymptotic complexity from @take@.
dropLast :: Int -> StrictSeq a -> StrictSeq a
dropLast :: forall a. Int -> StrictSeq a -> StrictSeq a
dropLast Int
i StrictSeq a
xs
  | forall a. StrictSeq a -> Int
length StrictSeq a
xs forall a. Ord a => a -> a -> Bool
>= Int
i = forall a. Int -> StrictSeq a -> StrictSeq a
take (forall a. StrictSeq a -> Int
length StrictSeq a
xs forall a. Num a => a -> a -> a
- Int
i) StrictSeq a
xs
  | Bool
otherwise = forall a. StrictSeq a
Empty

-- | \( O(\log(\min(i,n-i))) \). Split a sequence at a given position.
-- @'splitAt' i s = ('take' i s, 'drop' i s)@.
splitAt :: Int -> StrictSeq a -> (StrictSeq a, StrictSeq a)
splitAt :: forall a. Int -> StrictSeq a -> (StrictSeq a, StrictSeq a)
splitAt Int
i (StrictSeq Seq a
xs) = forall a. (Seq a, Seq a) -> (StrictSeq a, StrictSeq a)
toStrictSeqTuple (forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
i Seq a
xs)

-- | Split at the given position counting from the end of the sequence.
--
-- Inherits asymptotic complexity from 'splitAt'.
splitAtEnd :: Int -> StrictSeq a -> (StrictSeq a, StrictSeq a)
splitAtEnd :: forall a. Int -> StrictSeq a -> (StrictSeq a, StrictSeq a)
splitAtEnd Int
i StrictSeq a
xs
  | forall a. StrictSeq a -> Int
length StrictSeq a
xs forall a. Ord a => a -> a -> Bool
>= Int
i = forall a. Int -> StrictSeq a -> (StrictSeq a, StrictSeq a)
splitAt (forall a. StrictSeq a -> Int
length StrictSeq a
xs forall a. Num a => a -> a -> a
- Int
i) StrictSeq a
xs
  | Bool
otherwise = (forall a. StrictSeq a
Empty, StrictSeq a
xs)

-- | @'findIndexL' p xs@ finds the index of the leftmost element that
-- satisfies @p@, if any exist.
findIndexL :: (a -> Bool) -> StrictSeq a -> Maybe Int
findIndexL :: forall a. (a -> Bool) -> StrictSeq a -> Maybe Int
findIndexL a -> Bool
p (StrictSeq Seq a
xs) = forall a. (a -> Bool) -> Seq a -> Maybe Int
Seq.findIndexL a -> Bool
p Seq a
xs

-- | @'findIndexR' p xs@ finds the index of the rightmost element that
-- satisfies @p@, if any exist.
findIndexR :: (a -> Bool) -> StrictSeq a -> Maybe Int
findIndexR :: forall a. (a -> Bool) -> StrictSeq a -> Maybe Int
findIndexR a -> Bool
p (StrictSeq Seq a
xs) = forall a. (a -> Bool) -> Seq a -> Maybe Int
Seq.findIndexR a -> Bool
p Seq a
xs

-- | @'findIndicesL' p@ finds all indices of elements that satisfy @p@, in
-- ascending order.
findIndicesL :: (a -> Bool) -> StrictSeq a -> [Int]
findIndicesL :: forall a. (a -> Bool) -> StrictSeq a -> [Int]
findIndicesL a -> Bool
p (StrictSeq Seq a
xs) = forall a. (a -> Bool) -> Seq a -> [Int]
Seq.findIndicesL a -> Bool
p Seq a
xs

-- | @'findIndicesR' p@ finds all indices of elements that satisfy @p@, in
-- descending order.
findIndicesR :: (a -> Bool) -> StrictSeq a -> [Int]
findIndicesR :: forall a. (a -> Bool) -> StrictSeq a -> [Int]
findIndicesR a -> Bool
p (StrictSeq Seq a
xs) = forall a. (a -> Bool) -> Seq a -> [Int]
Seq.findIndicesR a -> Bool
p Seq a
xs

{-------------------------------------------------------------------------------
  Zips and Unzips
-------------------------------------------------------------------------------}

zip :: StrictSeq a -> StrictSeq b -> StrictSeq (a, b)
zip :: forall a b. StrictSeq a -> StrictSeq b -> StrictSeq (a, b)
zip = forall a b c.
(a -> b -> c) -> StrictSeq a -> StrictSeq b -> StrictSeq c
zipWith (,)

zipWith :: (a -> b -> c) -> StrictSeq a -> StrictSeq b -> StrictSeq c
zipWith :: forall a b c.
(a -> b -> c) -> StrictSeq a -> StrictSeq b -> StrictSeq c
zipWith a -> b -> c
f (StrictSeq Seq a
x) (StrictSeq Seq b
y) = forall a. Seq a -> StrictSeq a
forceToStrict forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith a -> b -> c
f Seq a
x Seq b
y

unzip :: StrictSeq (a, b) -> (StrictSeq a, StrictSeq b)
unzip :: forall a b. StrictSeq (a, b) -> (StrictSeq a, StrictSeq b)
unzip = forall a b c.
(a -> (b, c)) -> StrictSeq a -> (StrictSeq b, StrictSeq c)
unzipWith forall a. a -> a
id

unzipWith :: (a -> (b, c)) -> StrictSeq a -> (StrictSeq b, StrictSeq c)
unzipWith :: forall a b c.
(a -> (b, c)) -> StrictSeq a -> (StrictSeq b, StrictSeq c)
unzipWith a -> (b, c)
f (StrictSeq Seq a
xs) = forall a. Seq a -> StrictSeq a
StrictSeq forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a. Seq a -> StrictSeq a
StrictSeq forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
Seq.unzipWith a -> (b, c)
f Seq a
xs

{-------------------------------------------------------------------------------
  Helpers
-------------------------------------------------------------------------------}

toStrictSeqTuple :: (Seq a, Seq a) -> (StrictSeq a, StrictSeq a)
toStrictSeqTuple :: forall a. (Seq a, Seq a) -> (StrictSeq a, StrictSeq a)
toStrictSeqTuple (Seq a
a, Seq a
b) = (forall a. Seq a -> StrictSeq a
StrictSeq Seq a
a, forall a. Seq a -> StrictSeq a
StrictSeq Seq a
b)