{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveTraversable  #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE PatternSynonyms    #-}
{-# LANGUAGE ViewPatterns       #-}
{-# OPTIONS_HADDOCK not-home    #-}

-- |
-- Module      : Data.Sequence.NonEmpty.Internal
-- Copyright   : (c) Justin Le 2018
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Unsafe internal-use functions used in the implementation of
-- "Data.Sequence.NonEmpty".  These functions can potentially be used to
-- break the abstraction of 'NESeq' and produce unsound sequences, so be
-- wary!
module Data.Sequence.NonEmpty.Internal (
    NESeq(..)
  , pattern (:<||)
  , pattern (:||>)
  , withNonEmpty
  , toSeq
  , singleton
  , length
  , fromList
  , fromFunction
  , replicate
  , index
  , (<|), (><), (|><)
  , map
  , foldMapWithIndex
  , traverseWithIndex1
  , tails
  , zip
  , zipWith
  , unzip
  , sortOnSeq
  , unstableSortOnSeq
  , unzipSeq
  , unzipWithSeq
  ) where

import           Control.Comonad
import           Control.DeepSeq
import           Control.Monad
import           Control.Monad.Fix
import           Control.Monad.Zip
import           Data.Bifunctor
import           Data.Coerce
import           Data.Data
import           Data.Functor.Alt
import           Data.Functor.Bind
import           Data.Functor.Classes
import           Data.Functor.Extend
import           Data.List.NonEmpty         (NonEmpty(..))
import           Data.Semigroup
import           Data.Functor.Invariant
import           Data.Semigroup.Foldable
import           Data.Semigroup.Traversable
import           Data.Sequence              (Seq(..))
import           Prelude hiding             (length, zipWith, unzip, zip, map, replicate)
import           Text.Read
import qualified Data.Aeson                 as A
import qualified Data.Foldable              as F
import qualified Data.Sequence              as Seq

-- | A general-purpose non-empty (by construction) finite sequence type.
--
-- Non-emptiness means that:
--
-- *   Functions that /take/ an 'NESeq' can safely operate on it with the
--     assumption that it has at least value.
-- *   Functions that /return/ an 'NESeq' provide an assurance that the
--     result has at least one value.
--
-- "Data.Sequence.NonEmpty" re-exports the API of "Data.Sequence",
-- faithfully reproducing asymptotics, typeclass constraints, and
-- semantics.  Functions that ensure that input and output maps are both
-- non-empty (like 'Data.Sequence.NonEmpty.<|') return 'NESeq', but
-- functions that might potentially return an empty map (like
-- 'Data.Sequence.NonEmpty.tail') return a 'Seq' instead.
--
-- You can directly construct an 'NESeq' with the API from
-- "Data.Sequence.NonEmpty"; it's more or less the same as constructing
-- a normal 'Seq', except you don't have access to 'Data.Seq.empty'.  There
-- are also a few ways to construct an 'NESeq' from a 'Seq':
--
-- 1.  The 'Data.Sequence.NonEmpty.nonEmptySeq' smart constructor will
--     convert a @'Seq' a@ into a @'Maybe' ('NESeq' a)@, returning 'Nothing' if
--     the original 'Seq' was empty.
-- 2.  You can use 'Data.Sequence.NonEmpty.:<||',
--     'Data.Sequence.NonEmpty.:||>', and
--     'Data.Sequence.NonEmpty.insertSeqAt' to insert a value into a 'Seq'
--     to create a guaranteed 'NESeq'.
-- 3.  You can use the 'Data.Sequence.NonEmpty.IsNonEmpty' and
--     'Data.Sequence.NonEmpty.IsEmpty' patterns to "pattern match" on
--     a 'Seq' to reveal it as either containing a 'NESeq' or an empty
--     sequence.
-- 4.  'Data.Sequence.NonEmpty.withNonEmpty' offers a continuation-based
--     interface for deconstructing a 'Seq' and treating it as if it were an
--     'NESeq'.
--
-- You can convert an 'NESeq' into a 'Seq' with 'toSeq' or
-- 'Data.Sequence.NonEmpty.IsNonEmpty', essentially "obscuring" the
-- non-empty property from the type.
data NESeq a = NESeq { forall a. NESeq a -> a
nesHead :: a
                     , forall a. NESeq a -> Seq a
nesTail :: !(Seq a)
                     }
  deriving (Functor NESeq
Foldable NESeq
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => NESeq (m a) -> m (NESeq a)
forall (f :: * -> *) a. Applicative f => NESeq (f a) -> f (NESeq a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NESeq a -> m (NESeq b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NESeq a -> f (NESeq b)
sequence :: forall (m :: * -> *) a. Monad m => NESeq (m a) -> m (NESeq a)
$csequence :: forall (m :: * -> *) a. Monad m => NESeq (m a) -> m (NESeq a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NESeq a -> m (NESeq b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NESeq a -> m (NESeq b)
sequenceA :: forall (f :: * -> *) a. Applicative f => NESeq (f a) -> f (NESeq a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => NESeq (f a) -> f (NESeq a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NESeq a -> f (NESeq b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NESeq a -> f (NESeq b)
Traversable, Typeable)

-- | /O(1)/. An abstract constructor for an 'NESeq' that consists of
-- a "head" @a@ and a "tail" @'Seq' a@.  Similar to ':|' for 'NonEmpty'.
--
-- Can be used to match on the head and tail of an 'NESeq', and also used
-- to /construct/ an 'NESeq' by consing an item to the beginnong of
-- a 'Seq', ensuring that the result is non-empty.
pattern (:<||) :: a -> Seq a -> NESeq a
pattern x $b:<|| :: forall a. a -> Seq a -> NESeq a
$m:<|| :: forall {r} {a}. NESeq a -> (a -> Seq a -> r) -> ((# #) -> r) -> r
:<|| xs = NESeq x xs
{-# COMPLETE (:<||) #-}

unsnoc :: NESeq a -> (Seq a, a)
unsnoc :: forall a. NESeq a -> (Seq a, a)
unsnoc (a
x :<|| (Seq a
xs :|> a
y)) = (a
x forall a. a -> Seq a -> Seq a
:<| Seq a
xs, a
y)
unsnoc (a
x :<|| Seq a
Empty     ) = (forall a. Seq a
Empty   , a
x)
{-# INLINE unsnoc #-}

-- | /O(1)/. An abstract constructor for an 'NESeq' that consists of
-- a "init" @'Seq' a@ and a "last" @a@.  Similar to ':|' for 'NonEmpty',
-- but at the end of the list instead of at the beginning.
--
-- Can be used to match on the init and last of an 'NESeq', and also used
-- to /construct/ an 'NESeq' by snocing an item to the end of a 'Seq',
-- ensuring that the result is non-empty.
pattern (:||>) :: Seq a -> a -> NESeq a
pattern xs $b:||> :: forall a. Seq a -> a -> NESeq a
$m:||> :: forall {r} {a}. NESeq a -> (Seq a -> a -> r) -> ((# #) -> r) -> r
:||> x <- (unsnoc->(!xs, x))
  where
    (a
x :<| Seq a
xs) :||> a
y = a
x forall a. a -> Seq a -> NESeq a
:<|| (Seq a
xs forall a. Seq a -> a -> Seq a
:|> a
y)
    Seq a
Empty      :||> a
y = a
y forall a. a -> Seq a -> NESeq a
:<|| forall a. Seq a
Empty
{-# COMPLETE (:||>) #-}

infixr 5 `NESeq`
infixr 5 :<||
infixl 5 :||>

instance Show a => Show (NESeq a) where
    showsPrec :: Int -> NESeq a -> ShowS
showsPrec Int
p NESeq a
xs = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"fromList (" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty NESeq a
xs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"

instance Read a => Read (NESeq a) where
    readPrec :: ReadPrec (NESeq a)
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ do
        Ident String
"fromList" <- ReadPrec Lexeme
lexP
        NonEmpty a
xs <- forall a. ReadPrec a -> ReadPrec a
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ forall a. Read a => ReadPrec a
readPrec
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. NonEmpty a -> NESeq a
fromList NonEmpty a
xs)
    readListPrec :: ReadPrec [NESeq a]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault

instance Eq a => Eq (NESeq a) where
    NESeq a
xs == :: NESeq a -> NESeq a -> Bool
== NESeq a
ys = forall a. NESeq a -> Int
length NESeq a
xs forall a. Eq a => a -> a -> Bool
== forall a. NESeq a -> Int
length NESeq a
ys
            Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty NESeq a
xs forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty NESeq a
ys

instance Ord a => Ord (NESeq a) where
    compare :: NESeq a -> NESeq a -> Ordering
compare NESeq a
xs NESeq a
ys = forall a. Ord a => a -> a -> Ordering
compare (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList NESeq a
xs) (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList NESeq a
ys)

instance Show1 NESeq where
    liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NESeq a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d NESeq a
m =
        forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) String
"fromList" Int
d (forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty NESeq a
m)

instance Read1 NESeq where
    liftReadsPrec :: forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (NESeq a)
liftReadsPrec Int -> ReadS a
_rp ReadS [a]
readLst Int
p = forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ \String
r -> do
      (String
"fromList",String
s) <- ReadS String
lex String
r
      (NonEmpty a
xs, String
t) <- forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
_rp ReadS [a]
readLst Int
10 String
s
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. NonEmpty a -> NESeq a
fromList NonEmpty a
xs, String
t)

instance Eq1 NESeq where
    liftEq :: forall a b. (a -> b -> Bool) -> NESeq a -> NESeq b -> Bool
liftEq a -> b -> Bool
eq NESeq a
xs NESeq b
ys = forall a. NESeq a -> Int
length NESeq a
xs forall a. Eq a => a -> a -> Bool
== forall a. NESeq a -> Int
length NESeq b
ys Bool -> Bool -> Bool
&& forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq (forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty NESeq a
xs) (forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty NESeq b
ys)

instance Ord1 NESeq where
    liftCompare :: forall a b. (a -> b -> Ordering) -> NESeq a -> NESeq b -> Ordering
liftCompare a -> b -> Ordering
cmp NESeq a
xs NESeq b
ys = forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp (forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty NESeq a
xs) (forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty NESeq b
ys)

instance Data a => Data (NESeq a) where
    gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NESeq a -> c (NESeq a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z (a
x :<|| Seq a
xs)    = forall g. g -> c g
z forall a. a -> Seq a -> NESeq a
(:<||) forall d b. Data d => c (d -> b) -> d -> c b
`f` a
x forall d b. Data d => c (d -> b) -> d -> c b
`f` Seq a
xs
    gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (NESeq a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
_   = forall b r. Data b => c (b -> r) -> c r
k (forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall a. a -> Seq a -> NESeq a
(:<||)))
    toConstr :: NESeq a -> Constr
toConstr NESeq a
_      = Constr
consConstr
    dataTypeOf :: NESeq a -> DataType
dataTypeOf NESeq a
_    = DataType
seqDataType
    dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (NESeq a))
dataCast1 forall d. Data d => c (t d)
f     = forall {k1} {k2} (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 forall d. Data d => c (t d)
f

consConstr :: Constr
consConstr :: Constr
consConstr  = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
seqDataType String
":<||" [] Fixity
Infix

seqDataType :: DataType
seqDataType :: DataType
seqDataType = String -> [Constr] -> DataType
mkDataType String
"Data.Sequence.NonEmpty.Internal.NESeq" [Constr
consConstr]


instance A.ToJSON a => A.ToJSON (NESeq a) where
    toJSON :: NESeq a -> Value
toJSON     = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NESeq a -> Seq a
toSeq
    toEncoding :: NESeq a -> Encoding
toEncoding = forall a. ToJSON a => a -> Encoding
A.toEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NESeq a -> Seq a
toSeq

instance A.FromJSON a => A.FromJSON (NESeq a) where
    parseJSON :: Value -> Parser (NESeq a)
parseJSON = forall r a. r -> (NESeq a -> r) -> Seq a -> r
withNonEmpty (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err) forall (f :: * -> *) a. Applicative f => a -> f a
pure
            forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. FromJSON a => Value -> Parser a
A.parseJSON
      where
        err :: String
err = String
"NESeq: Non-empty sequence expected, but empty sequence found"


-- | /O(log n)/. A general continuation-based way to consume a 'Seq' as if
-- it were an 'NESeq'. @'withNonEmpty' def f@ will take a 'Seq'.  If map is
-- empty, it will evaluate to @def@.  Otherwise, a non-empty map 'NESeq'
-- will be fed to the function @f@ instead.
--
-- @'Data.Sequence.NonEmpty.nonEmptySeq' == 'withNonEmpty' 'Nothing' 'Just'@
withNonEmpty :: r -> (NESeq a -> r) -> Seq a -> r
withNonEmpty :: forall r a. r -> (NESeq a -> r) -> Seq a -> r
withNonEmpty r
def NESeq a -> r
f = \case
    a
x :<| Seq a
xs -> NESeq a -> r
f (a
x forall a. a -> Seq a -> NESeq a
:<|| Seq a
xs)
    Seq a
Empty    -> r
def
{-# INLINE withNonEmpty #-}

-- | /O(1)/.
-- Convert a non-empty sequence back into a normal possibly-empty sequence,
-- for usage with functions that expect 'Seq'.
--
-- Can be thought of as "obscuring" the non-emptiness of the map in its
-- type.  See the 'Data.Sequence.NonEmpty.IsNotEmpty' pattern.
--
-- 'Data.Sequence.NonEmpty.nonEmptySeq' and @'maybe' 'Data.Seq.empty'
-- 'toSeq'@ form an isomorphism: they are perfect structure-preserving
-- inverses of eachother.
toSeq :: NESeq a -> Seq a
toSeq :: forall a. NESeq a -> Seq a
toSeq (a
x :<|| Seq a
xs) = a
x forall a. a -> Seq a -> Seq a
:<| Seq a
xs
{-# INLINE toSeq #-}

-- | \( O(1) \). A singleton sequence.
singleton :: a -> NESeq a
singleton :: forall a. a -> NESeq a
singleton = (forall a. a -> Seq a -> NESeq a
:<|| forall a. Seq a
Seq.empty)
{-# INLINE singleton #-}

-- | \( O(1) \). The number of elements in the sequence.
length :: NESeq a -> Int
length :: forall a. NESeq a -> Int
length (a
_ :<|| Seq a
xs) = Int
1 forall a. Num a => a -> a -> a
+ forall a. Seq a -> Int
Seq.length Seq a
xs
{-# INLINE length #-}

-- | \( O(n) \). Create a sequence from a finite list of elements.  There
-- is a function 'toNonEmpty' in the opposite direction for all instances
-- of the 'Foldable1' class, including 'NESeq'.
fromList :: NonEmpty a -> NESeq a
fromList :: forall a. NonEmpty a -> NESeq a
fromList (a
x :| [a]
xs) = a
x forall a. a -> Seq a -> NESeq a
:<|| forall a. [a] -> Seq a
Seq.fromList [a]
xs
{-# INLINE fromList #-}

-- | \( O(n) \). Convert a given sequence length and a function representing that
-- sequence into a sequence.
fromFunction :: Int -> (Int -> a) -> NESeq a
fromFunction :: forall a. Int -> (Int -> a) -> NESeq a
fromFunction Int
n Int -> a
f
    | Int
n forall a. Ord a => a -> a -> Bool
< Int
1     = forall a. HasCallStack => String -> a
error String
"NESeq.fromFunction: must take a positive integer argument"
    | Bool
otherwise = Int -> a
f Int
0 forall a. a -> Seq a -> NESeq a
:<|| forall a. Int -> (Int -> a) -> Seq a
Seq.fromFunction (Int
n forall a. Num a => a -> a -> a
- Int
1) (Int -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ Int
1))

-- | \( O(\log n) \). @replicate n x@ is a sequence consisting of @n@
-- copies of @x@.  Is only defined when @n@ is positive.
replicate :: Int -> a -> NESeq a
replicate :: forall a. Int -> a -> NESeq a
replicate Int
n a
x
    | Int
n forall a. Ord a => a -> a -> Bool
< Int
1     = forall a. HasCallStack => String -> a
error String
"NESeq.replicate: must take a positive integer argument"
    | Bool
otherwise = a
x forall a. a -> Seq a -> NESeq a
:<|| forall a. Int -> a -> Seq a
Seq.replicate (Int
n forall a. Num a => a -> a -> a
- Int
1) a
x
{-# INLINE replicate #-}

-- | \( O(\log(\min(i,n-i))) \). The element at the specified position,
-- counting from 0.  The argument should thus be a non-negative
-- integer less than the size of the sequence.
-- If the position is out of range, 'index' fails with an error.
--
-- prop> xs `index` i = toList xs !! i
--
-- Caution: 'index' necessarily delays retrieving the requested
-- element until the result is forced. It can therefore lead to a space
-- leak if the result is stored, unforced, in another structure. To retrieve
-- an element immediately without forcing it, use 'lookup' or '(!?)'.
index :: NESeq a -> Int -> a
index :: forall a. NESeq a -> Int -> a
index (a
x :<|| Seq a
_ ) Int
0 = a
x
index (a
_ :<|| Seq a
xs) Int
i = Seq a
xs forall a. Seq a -> Int -> a
`Seq.index` (Int
i forall a. Num a => a -> a -> a
- Int
1)
{-# INLINE index #-}

-- | \( O(1) \). Add an element to the left end of a non-empty sequence.
-- Mnemonic: a triangle with the single element at the pointy end.
(<|) :: a -> NESeq a -> NESeq a
a
x <| :: forall a. a -> NESeq a -> NESeq a
<| NESeq a
xs = a
x forall a. a -> Seq a -> NESeq a
:<|| forall a. NESeq a -> Seq a
toSeq NESeq a
xs
{-# INLINE (<|) #-}

-- | \( O(\log(\min(n_1,n_2))) \). Concatenate two non-empty sequences.
(><) :: NESeq a -> NESeq a -> NESeq a
(a
x :<|| Seq a
xs) >< :: forall a. NESeq a -> NESeq a -> NESeq a
>< NESeq a
ys = a
x forall a. a -> Seq a -> NESeq a
:<|| (Seq a
xs forall a. Seq a -> Seq a -> Seq a
Seq.>< forall a. NESeq a -> Seq a
toSeq NESeq a
ys)
{-# INLINE (><) #-}

-- | \( O(\log(\min(n_1,n_2))) \). Concatenate a non-empty sequence with
-- a potentially empty sequence ('Seq'), to produce a guaranteed non-empty
-- sequence.  Mnemonic: like '><', but a pipe for the guarunteed non-empty
-- side.
(|><) :: NESeq a -> Seq a -> NESeq a
(a
x :<|| Seq a
xs) |>< :: forall a. NESeq a -> Seq a -> NESeq a
|>< Seq a
ys = a
x forall a. a -> Seq a -> NESeq a
:<|| (Seq a
xs forall a. Seq a -> Seq a -> Seq a
Seq.>< Seq a
ys)
{-# INLINE (|><) #-}

infixr 5 <|
infixr 5 ><
infixr 5 |><

-- | Defined here but hidden; intended for use with RULES pragma.
map :: (a -> b) -> NESeq a -> NESeq b
map :: forall a b. (a -> b) -> NESeq a -> NESeq b
map a -> b
f (a
x :<|| Seq a
xs) = a -> b
f a
x forall a. a -> Seq a -> NESeq a
:<|| forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seq a
xs
{-# NOINLINE [1] map #-}
{-# RULES
"map/map" forall f g xs . map f (map g xs) = map (f . g) xs
 #-}
{-# RULES
"map/coerce" map coerce = coerce
 #-}

-- | /O(n)/. A generalization of 'foldMap1', 'foldMapWithIndex' takes
-- a folding function that also depends on the element's index, and applies
-- it to every element in the sequence.
foldMapWithIndex :: Semigroup m => (Int -> a -> m) -> NESeq a -> m
#if MIN_VERSION_base(4,11,0)
foldMapWithIndex :: forall m a. Semigroup m => (Int -> a -> m) -> NESeq a -> m
foldMapWithIndex Int -> a -> m
f (a
x :<|| Seq a
xs) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> a -> m
f Int
0 a
x) (Int -> a -> m
f Int
0 a
x forall a. Semigroup a => a -> a -> a
<>)
                               forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m a. Monoid m => (Int -> a -> m) -> Seq a -> m
Seq.foldMapWithIndex (\Int
i -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> m
f (Int
i forall a. Num a => a -> a -> a
+ Int
1))
                               forall a b. (a -> b) -> a -> b
$ Seq a
xs
#else
foldMapWithIndex f (x :<|| xs) = option (f 0 x) (f 0 x <>)
                               . Seq.foldMapWithIndex (\i -> Option . Just . f (i + 1))
                               $ xs
#endif
{-# INLINE foldMapWithIndex #-}

-- | /O(n)/. 'traverseWithIndex1' is a version of 'traverse1' that also
-- offers access to the index of each element.
traverseWithIndex1 :: Apply f => (Int -> a -> f b) -> NESeq a -> f (NESeq b)
traverseWithIndex1 :: forall (f :: * -> *) a b.
Apply f =>
(Int -> a -> f b) -> NESeq a -> f (NESeq b)
traverseWithIndex1 Int -> a -> f b
f (a
x :<|| Seq a
xs) = case forall (f :: * -> *) a. MaybeApply f a -> Either (f a) a
runMaybeApply MaybeApply f (Seq b)
xs' of
    Left  f (Seq b)
ys -> forall a. a -> Seq a -> NESeq a
(:<||)    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> f b
f Int
0 a
x forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f (Seq b)
ys
    Right Seq b
ys -> (forall a. a -> Seq a -> NESeq a
:<|| Seq b
ys) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> f b
f Int
0 a
x
  where
    xs' :: MaybeApply f (Seq b)
xs' = forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> Seq a -> f (Seq b)
Seq.traverseWithIndex (\Int
i -> forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> f b
f (Int
iforall a. Num a => a -> a -> a
+Int
1)) Seq a
xs
{-# INLINABLE traverseWithIndex1 #-}

-- | \( O(n) \).  Returns a sequence of all non-empty suffixes of this
-- sequence, longest first.  For example,
--
-- > tails (fromList (1:|[2,3])) = fromList (fromList (1:|[2,3]) :| [fromList (2:|[3]), fromList (3:|[])])
--
-- Evaluating the \( i \)th suffix takes \( O(\log(\min(i, n-i))) \), but evaluating
-- every suffix in the sequence takes \( O(n) \) due to sharing.

-- TODO: is this true?
tails :: NESeq a -> NESeq (NESeq a)
tails :: forall a. NESeq a -> NESeq (NESeq a)
tails xs :: NESeq a
xs@(a
_ :<|| Seq a
ys) = forall r a. r -> (NESeq a -> r) -> Seq a -> r
withNonEmpty (forall a. a -> NESeq a
singleton NESeq a
xs) ((NESeq a
xs forall a. a -> NESeq a -> NESeq a
<|) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NESeq a -> NESeq (NESeq a)
tails) Seq a
ys
{-# INLINABLE tails #-}

-- | \( O(\min(n_1,n_2)) \).  'zip' takes two sequences and returns
-- a sequence of corresponding pairs.  If one input is short, excess
-- elements are discarded from the right end of the longer sequence.
zip :: NESeq a -> NESeq b -> NESeq (a, b)
zip :: forall a b. NESeq a -> NESeq b -> NESeq (a, b)
zip (a
x :<|| Seq a
xs) (b
y :<|| Seq b
ys) = (a
x, b
y) forall a. a -> Seq a -> NESeq a
:<|| forall a b. Seq a -> Seq b -> Seq (a, b)
Seq.zip Seq a
xs Seq b
ys
{-# INLINE zip #-}

-- | \( O(\min(n_1,n_2)) \).  'zipWith' generalizes 'zip' by zipping with the
-- function given as the first argument, instead of a tupling function.
-- For example, @zipWith (+)@ is applied to two sequences to take the
-- sequence of corresponding sums.
zipWith :: (a -> b -> c) -> NESeq a -> NESeq b -> NESeq c
zipWith :: forall a b c. (a -> b -> c) -> NESeq a -> NESeq b -> NESeq c
zipWith a -> b -> c
f (a
x :<|| Seq a
xs) (b
y :<|| Seq b
ys) = a -> b -> c
f a
x b
y forall a. a -> Seq a -> NESeq a
:<|| forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith a -> b -> c
f Seq a
xs Seq b
ys
{-# INLINE zipWith #-}

-- | Unzip a sequence of pairs.
--
-- @
-- unzip ps = ps ``seq`` ('fmap' 'fst' ps) ('fmap' 'snd' ps)
-- @
--
-- Example:
--
-- @
-- unzip $ fromList ((1,"a") :| [(2,"b"), (3,"c")]) =
--   (fromList (1:|[2,3]), fromList ("a":|["b","c"]))
-- @
--
-- See the note about efficiency at 'Data.Sequence.NonEmpty.unzipWith'.
unzip :: NESeq (a, b) -> (NESeq a, NESeq b)
unzip :: forall a b. NESeq (a, b) -> (NESeq a, NESeq b)
unzip ((a
x, b
y) :<|| Seq (a, b)
xys) = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (a
x forall a. a -> Seq a -> NESeq a
:<||) (b
y forall a. a -> Seq a -> NESeq a
:<||) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Seq (a, b) -> (Seq a, Seq b)
unzipSeq forall a b. (a -> b) -> a -> b
$ Seq (a, b)
xys
{-# INLINE unzip #-}

instance Semigroup (NESeq a) where
    <> :: NESeq a -> NESeq a -> NESeq a
(<>) = forall a. NESeq a -> NESeq a -> NESeq a
(><)
    {-# INLINE (<>) #-}

instance Functor NESeq where
    fmap :: forall a b. (a -> b) -> NESeq a -> NESeq b
fmap = forall a b. (a -> b) -> NESeq a -> NESeq b
map
    {-# INLINE fmap #-}
    a
x <$ :: forall a b. a -> NESeq b -> NESeq a
<$ NESeq b
xs = forall a. Int -> a -> NESeq a
replicate (forall a. NESeq a -> Int
length NESeq b
xs) a
x
    {-# INLINE (<$) #-}

-- | @since 0.3.4.4
instance Invariant NESeq where
    invmap :: forall a b. (a -> b) -> (b -> a) -> NESeq a -> NESeq b
invmap a -> b
f b -> a
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f
    {-# INLINE invmap #-}

instance Apply NESeq where
    (a -> b
f :<|| Seq (a -> b)
fs) <.> :: forall a b. NESeq (a -> b) -> NESeq a -> NESeq b
<.> NESeq a
xs = NESeq b
fxs forall a. NESeq a -> Seq a -> NESeq a
|>< Seq b
fsxs
      where
        fxs :: NESeq b
fxs  = a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NESeq a
xs
        fsxs :: Seq b
fsxs = Seq (a -> b)
fs forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> forall a. NESeq a -> Seq a
toSeq NESeq a
xs
    {-# INLINABLE (<.>) #-}

instance Applicative NESeq where
    pure :: forall a. a -> NESeq a
pure = forall a. a -> NESeq a
singleton
    {-# INLINE pure #-}
    <*> :: forall a b. NESeq (a -> b) -> NESeq a -> NESeq b
(<*>) = forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)
    {-# INLINABLE (<*>) #-}

instance Alt NESeq where
    <!> :: forall a. NESeq a -> NESeq a -> NESeq a
(<!>) = forall a. NESeq a -> NESeq a -> NESeq a
(><)
    {-# INLINE (<!>) #-}

instance Bind NESeq where
    NESeq a
x Seq a
xs >>- :: forall a b. NESeq a -> (a -> NESeq b) -> NESeq b
>>- a -> NESeq b
f = forall r a. r -> (NESeq a -> r) -> Seq a -> r
withNonEmpty (a -> NESeq b
f a
x) ((a -> NESeq b
f a
x forall a. NESeq a -> NESeq a -> NESeq a
><) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- a -> NESeq b
f)) Seq a
xs
    {-# INLINABLE (>>-) #-}

instance Monad NESeq where
    return :: forall a. a -> NESeq a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE return #-}
    >>= :: forall a b. NESeq a -> (a -> NESeq b) -> NESeq b
(>>=) = forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
(>>-)
    {-# INLINABLE (>>=) #-}

instance Extend NESeq where
    duplicated :: forall a. NESeq a -> NESeq (NESeq a)
duplicated = forall a. NESeq a -> NESeq (NESeq a)
tails
    {-# INLINE duplicated #-}
    extended :: forall a b. (NESeq a -> b) -> NESeq a -> NESeq b
extended NESeq a -> b
f xs0 :: NESeq a
xs0@(a
_ :<|| Seq a
xs) = forall r a. r -> (NESeq a -> r) -> Seq a -> r
withNonEmpty (forall a. a -> NESeq a
singleton (NESeq a -> b
f NESeq a
xs0))
                                              ((NESeq a -> b
f NESeq a
xs0 forall a. a -> NESeq a -> NESeq a
<|) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend NESeq a -> b
f)
                                              Seq a
xs
    {-# INLINE extended #-}

instance Comonad NESeq where
    extract :: forall a. NESeq a -> a
extract (a
x :<|| Seq a
_) = a
x
    {-# INLINE extract #-}
    duplicate :: forall a. NESeq a -> NESeq (NESeq a)
duplicate = forall (w :: * -> *) a. Extend w => w a -> w (w a)
duplicated
    {-# INLINE duplicate #-}
    extend :: forall a b. (NESeq a -> b) -> NESeq a -> NESeq b
extend = forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended
    {-# INLINE extend #-}

-- | 'foldr1', 'foldl1', 'maximum', and 'minimum' are all total, unlike for
-- 'Seq'.
instance Foldable NESeq where
#if MIN_VERSION_base(4,11,0)
    fold :: forall m. Monoid m => NESeq m -> m
fold (m
x :<|| Seq m
xs) = m
x forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold Seq m
xs
    {-# INLINE fold #-}
    foldMap :: forall m a. Monoid m => (a -> m) -> NESeq a -> m
foldMap a -> m
f (a
x :<|| Seq a
xs) = a -> m
f a
x forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> m
f Seq a
xs
    {-# INLINE foldMap #-}
#else
    fold (x :<|| xs) = x `mappend` F.fold xs
    {-# INLINE fold #-}
    foldMap f (x :<|| xs) = f x `mappend` F.foldMap f xs
    {-# INLINE foldMap #-}
#endif
    foldr :: forall a b. (a -> b -> b) -> b -> NESeq a -> b
foldr a -> b -> b
f b
z (a
x :<|| Seq a
xs) = a
x a -> b -> b
`f` forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z Seq a
xs
    {-# INLINE foldr #-}
    foldr' :: forall a b. (a -> b -> b) -> b -> NESeq a -> b
foldr' a -> b -> b
f b
z (Seq a
xs :||> a
x) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr' a -> b -> b
f b
y Seq a
xs
      where
        !y :: b
y = a -> b -> b
f a
x b
z
    {-# INLINE foldr' #-}
    foldl :: forall b a. (b -> a -> b) -> b -> NESeq a -> b
foldl b -> a -> b
f b
z (Seq a
xs :||> a
x) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z Seq a
xs b -> a -> b
`f` a
x
    {-# INLINE foldl #-}
    foldl' :: forall b a. (b -> a -> b) -> b -> NESeq a -> b
foldl' b -> a -> b
f b
z (a
x :<|| Seq a
xs) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' b -> a -> b
f b
y Seq a
xs
      where
        !y :: b
y = b -> a -> b
f b
z a
x
    {-# INLINE foldl' #-}
    foldr1 :: forall a. (a -> a -> a) -> NESeq a -> a
foldr1 a -> a -> a
f (Seq a
xs :||> a
x) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
f a
x Seq a
xs
    {-# INLINE foldr1 #-}
    foldl1 :: forall a. (a -> a -> a) -> NESeq a -> a
foldl1 a -> a -> a
f (a
x :<|| Seq a
xs) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
f a
x Seq a
xs
    {-# INLINE foldl1 #-}
    null :: forall a. NESeq a -> Bool
null NESeq a
_ = Bool
False
    {-# INLINE null #-}
    length :: forall a. NESeq a -> Int
length = forall a. NESeq a -> Int
length
    {-# INLINE length #-}

instance Foldable1 NESeq where
#if MIN_VERSION_base(4,11,0)
    fold1 :: forall m. Semigroup m => NESeq m -> m
fold1 (m
x :<|| Seq m
xs) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe m
x (m
x forall a. Semigroup a => a -> a -> a
<>)
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap forall a. a -> Maybe a
Just
                      forall a b. (a -> b) -> a -> b
$ Seq m
xs
#else
    fold1 (x :<|| xs) = option x (x <>)
                      . F.foldMap (Option . Just)
                      $ xs
#endif
    {-# INLINE fold1 #-}
    foldMap1 :: forall m a. Semigroup m => (a -> m) -> NESeq a -> m
foldMap1 a -> m
f = forall m a. Semigroup m => (Int -> a -> m) -> NESeq a -> m
foldMapWithIndex (forall a b. a -> b -> a
const a -> m
f)
    {-# INLINE foldMap1 #-}
    -- TODO: use build
    toNonEmpty :: forall a. NESeq a -> NonEmpty a
toNonEmpty (a
x :<|| Seq a
xs) = a
x forall a. a -> [a] -> NonEmpty a
:| forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq a
xs
    {-# INLINE toNonEmpty #-}

instance Traversable1 NESeq where
    traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> NESeq a -> f (NESeq b)
traverse1 a -> f b
f = forall (f :: * -> *) a b.
Apply f =>
(Int -> a -> f b) -> NESeq a -> f (NESeq b)
traverseWithIndex1 (forall a b. a -> b -> a
const a -> f b
f)
    {-# INLINE traverse1 #-}
    sequence1 :: forall (f :: * -> *) b. Apply f => NESeq (f b) -> f (NESeq b)
sequence1 (f b
x :<|| Seq (f b)
xs) = case forall (f :: * -> *) a. MaybeApply f a -> Either (f a) a
runMaybeApply MaybeApply f (Seq b)
xs' of
        Left  f (Seq b)
ys -> forall a. a -> Seq a -> NESeq a
(:<||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
x forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f (Seq b)
ys
        Right Seq b
ys -> (forall a. a -> Seq a -> NESeq a
:<|| Seq b
ys) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
x
      where
        xs' :: MaybeApply f (Seq b)
xs' = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) Seq (f b)
xs
    {-# INLINABLE sequence1 #-}

-- | @mzipWith = zipWith@
--
-- @munzip = unzip@
instance MonadZip NESeq where
    mzipWith :: forall a b c. (a -> b -> c) -> NESeq a -> NESeq b -> NESeq c
mzipWith = forall a b c. (a -> b -> c) -> NESeq a -> NESeq b -> NESeq c
zipWith
    munzip :: forall a b. NESeq (a, b) -> (NESeq a, NESeq b)
munzip   = forall a b. NESeq (a, b) -> (NESeq a, NESeq b)
unzip

instance MonadFix NESeq where
    mfix :: forall a. (a -> NESeq a) -> NESeq a
mfix = forall a. (a -> NESeq a) -> NESeq a
mfixSeq

mfixSeq :: (a -> NESeq a) -> NESeq a
mfixSeq :: forall a. (a -> NESeq a) -> NESeq a
mfixSeq a -> NESeq a
f = forall a. Int -> (Int -> a) -> NESeq a
fromFunction (forall a. NESeq a -> Int
length (a -> NESeq a
f forall {a}. a
err)) (\Int
k -> forall a. (a -> a) -> a
fix (\a
xk -> a -> NESeq a
f a
xk forall a. NESeq a -> Int -> a
`index` Int
k))
  where
    err :: a
err = forall a. HasCallStack => String -> a
error String
"mfix for Data.Sequence.NonEmpty.NESeq applied to strict function"

instance NFData a => NFData (NESeq a) where
    rnf :: NESeq a -> ()
rnf (a
x :<|| Seq a
xs) = forall a. NFData a => a -> ()
rnf a
x seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Seq a
xs seq :: forall a b. a -> b -> b
`seq` ()

-- ---------------------------------------------
-- | CPP for new functions not in old containers
-- ---------------------------------------------

-- | Compatibility layer for 'Data.Sequence.sortOn'.
sortOnSeq :: Ord b => (a -> b) -> Seq a -> Seq a
#if MIN_VERSION_containers(0,5,11)
sortOnSeq :: forall b a. Ord b => (a -> b) -> Seq a -> Seq a
sortOnSeq = forall b a. Ord b => (a -> b) -> Seq a -> Seq a
Seq.sortOn
#else
sortOnSeq f = Seq.sortBy (\x y -> f x `compare` f y)
#endif
{-# INLINE sortOnSeq #-}

-- | Compatibility layer for 'Data.Sequence.unstableSortOn'.
unstableSortOnSeq :: Ord b => (a -> b) -> Seq a -> Seq a
#if MIN_VERSION_containers(0,5,11)
unstableSortOnSeq :: forall b a. Ord b => (a -> b) -> Seq a -> Seq a
unstableSortOnSeq = forall b a. Ord b => (a -> b) -> Seq a -> Seq a
Seq.unstableSortOn
#else
unstableSortOnSeq f = Seq.unstableSortBy (\x y -> f x `compare` f y)
#endif
{-# INLINE unstableSortOnSeq #-}

-- | Compatibility layer for 'Data.Sequence.unzip'.
unzipSeq :: Seq (a, b) -> (Seq a, Seq b)
#if MIN_VERSION_containers(0,5,11)
unzipSeq :: forall a b. Seq (a, b) -> (Seq a, Seq b)
unzipSeq = forall a b. Seq (a, b) -> (Seq a, Seq b)
Seq.unzip
{-# INLINE unzipSeq #-}
#else
unzipSeq = \case
    (x, y) :<| xys -> bimap (x :<|) (y :<|) . unzipSeq $ xys
    Empty          -> (Empty, Empty)
{-# INLINABLE unzipSeq #-}
#endif

-- | Compatibility layer for 'Data.Sequence.unzipWith'.
unzipWithSeq :: (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
#if MIN_VERSION_containers(0,5,11)
unzipWithSeq :: forall a b c. (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
unzipWithSeq = forall a b c. (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
Seq.unzipWith
{-# INLINE unzipWithSeq #-}
#else
unzipWithSeq f = go
  where
    go = \case
      x :<| xs -> let ~(y, z) = f x
                  in  bimap (y :<|) (z :<|) . go $ xs
      Empty    -> (Empty, Empty)
{-# INLINABLE unzipWithSeq #-}
#endif