{-# LANGUAGE CPP #-}
#include "containers.h"
{-# LANGUAGE BangPatterns #-}
#if __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Trustworthy #-}
#endif
#ifdef DEFINE_PATTERN_SYNONYMS
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
#endif
{-# LANGUAGE PatternGuards #-}

{-# OPTIONS_HADDOCK not-home #-}
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Sequence.Internal
-- Copyright   :  (c) Ross Paterson 2005
--                (c) Louis Wasserman 2009
--                (c) Bertram Felgenhauer, David Feuer, Ross Paterson, and
--                    Milan Straka 2014
-- License     :  BSD-style
-- Maintainer  :  libraries@haskell.org
-- Portability :  portable
--
--
-- = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this module are expected to track development
-- closely.
--
-- = Description
--
-- General purpose finite sequences.
-- Apart from being finite and having strict operations, sequences
-- also differ from lists in supporting a wider variety of operations
-- efficiently.
--
-- An amortized running time is given for each operation, with \( n \) referring
-- to the length of the sequence and \( i \) being the integral index used by
-- some operations. These bounds hold even in a persistent (shared) setting.
--
-- The implementation uses 2-3 finger trees annotated with sizes,
-- as described in section 4.2 of
--
--    * Ralf Hinze and Ross Paterson,
--      \"Finger trees: a simple general-purpose data structure\",
--      /Journal of Functional Programming/ 16:2 (2006) pp 197-217.
--      <http://staff.city.ac.uk/~ross/papers/FingerTree.html>
--
-- /Note/: Many of these operations have the same names as similar
-- operations on lists in the "Prelude". The ambiguity may be resolved
-- using either qualification or the @hiding@ clause.
--
-- /Warning/: The size of a 'Seq' must not exceed @maxBound::Int@.  Violation
-- of this condition is not detected and if the size limit is exceeded, the
-- behaviour of the sequence is undefined.  This is unlikely to occur in most
-- applications, but some care may be required when using '><', '<*>', '*>', or
-- '>>', particularly repeatedly and particularly in combination with
-- 'replicate' or 'fromFunction'.
--
-- @since 0.5.9
-----------------------------------------------------------------------------

module Data.Sequence.Internal (
    Elem(..), FingerTree(..), Node(..), Digit(..), Sized(..), MaybeForce,
#if defined(DEFINE_PATTERN_SYNONYMS)
    Seq (.., Empty, (:<|), (:|>)),
#else
    Seq (..),
#endif
    State(..),
    execState,
    foldDigit,
    foldNode,
    foldWithIndexDigit,
    foldWithIndexNode,

    -- * Construction
    empty,          -- :: Seq a
    singleton,      -- :: a -> Seq a
    (<|),           -- :: a -> Seq a -> Seq a
    (|>),           -- :: Seq a -> a -> Seq a
    (><),           -- :: Seq a -> Seq a -> Seq a
    fromList,       -- :: [a] -> Seq a
    fromFunction,   -- :: Int -> (Int -> a) -> Seq a
    fromArray,      -- :: Ix i => Array i a -> Seq a
    -- ** Repetition
    replicate,      -- :: Int -> a -> Seq a
    replicateA,     -- :: Applicative f => Int -> f a -> f (Seq a)
    replicateM,     -- :: Applicative m => Int -> m a -> m (Seq a)
    cycleTaking,    -- :: Int -> Seq a -> Seq a
    -- ** Iterative construction
    iterateN,       -- :: Int -> (a -> a) -> a -> Seq a
    unfoldr,        -- :: (b -> Maybe (a, b)) -> b -> Seq a
    unfoldl,        -- :: (b -> Maybe (b, a)) -> b -> Seq a
    -- * Deconstruction
    -- | Additional functions for deconstructing sequences are available
    -- via the 'Foldable' instance of 'Seq'.

    -- ** Queries
    null,           -- :: Seq a -> Bool
    length,         -- :: Seq a -> Int
    -- ** Views
    ViewL(..),
    viewl,          -- :: Seq a -> ViewL a
    ViewR(..),
    viewr,          -- :: Seq a -> ViewR a
    -- * Scans
    scanl,          -- :: (a -> b -> a) -> a -> Seq b -> Seq a
    scanl1,         -- :: (a -> a -> a) -> Seq a -> Seq a
    scanr,          -- :: (a -> b -> b) -> b -> Seq a -> Seq b
    scanr1,         -- :: (a -> a -> a) -> Seq a -> Seq a
    -- * Sublists
    tails,          -- :: Seq a -> Seq (Seq a)
    inits,          -- :: Seq a -> Seq (Seq a)
    chunksOf,       -- :: Int -> Seq a -> Seq (Seq a)
    -- ** Sequential searches
    takeWhileL,     -- :: (a -> Bool) -> Seq a -> Seq a
    takeWhileR,     -- :: (a -> Bool) -> Seq a -> Seq a
    dropWhileL,     -- :: (a -> Bool) -> Seq a -> Seq a
    dropWhileR,     -- :: (a -> Bool) -> Seq a -> Seq a
    spanl,          -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
    spanr,          -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
    breakl,         -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
    breakr,         -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
    partition,      -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
    filter,         -- :: (a -> Bool) -> Seq a -> Seq a
    -- * Indexing
    lookup,         -- :: Int -> Seq a -> Maybe a
    (!?),           -- :: Seq a -> Int -> Maybe a
    index,          -- :: Seq a -> Int -> a
    adjust,         -- :: (a -> a) -> Int -> Seq a -> Seq a
    adjust',        -- :: (a -> a) -> Int -> Seq a -> Seq a
    update,         -- :: Int -> a -> Seq a -> Seq a
    take,           -- :: Int -> Seq a -> Seq a
    drop,           -- :: Int -> Seq a -> Seq a
    insertAt,       -- :: Int -> a -> Seq a -> Seq a
    deleteAt,       -- :: Int -> Seq a -> Seq a
    splitAt,        -- :: Int -> Seq a -> (Seq a, Seq a)
    -- ** Indexing with predicates
    -- | These functions perform sequential searches from the left
    -- or right ends of the sequence, returning indices of matching
    -- elements.
    elemIndexL,     -- :: Eq a => a -> Seq a -> Maybe Int
    elemIndicesL,   -- :: Eq a => a -> Seq a -> [Int]
    elemIndexR,     -- :: Eq a => a -> Seq a -> Maybe Int
    elemIndicesR,   -- :: Eq a => a -> Seq a -> [Int]
    findIndexL,     -- :: (a -> Bool) -> Seq a -> Maybe Int
    findIndicesL,   -- :: (a -> Bool) -> Seq a -> [Int]
    findIndexR,     -- :: (a -> Bool) -> Seq a -> Maybe Int
    findIndicesR,   -- :: (a -> Bool) -> Seq a -> [Int]
    -- * Folds
    -- | General folds are available via the 'Foldable' instance of 'Seq'.
    foldMapWithIndex, -- :: Monoid m => (Int -> a -> m) -> Seq a -> m
    foldlWithIndex, -- :: (b -> Int -> a -> b) -> b -> Seq a -> b
    foldrWithIndex, -- :: (Int -> a -> b -> b) -> b -> Seq a -> b
    -- * Transformations
    mapWithIndex,   -- :: (Int -> a -> b) -> Seq a -> Seq b
    traverseWithIndex, -- :: Applicative f => (Int -> a -> f b) -> Seq a -> f (Seq b)
    reverse,        -- :: Seq a -> Seq a
    intersperse,    -- :: a -> Seq a -> Seq a
    liftA2Seq,      -- :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
    -- ** Zips and unzips
    zip,            -- :: Seq a -> Seq b -> Seq (a, b)
    zipWith,        -- :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
    zip3,           -- :: Seq a -> Seq b -> Seq c -> Seq (a, b, c)
    zipWith3,       -- :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
    zip4,           -- :: Seq a -> Seq b -> Seq c -> Seq d -> Seq (a, b, c, d)
    zipWith4,       -- :: (a -> b -> c -> d -> e) -> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
    unzip,          -- :: Seq (a, b) -> (Seq a, Seq b)
    unzipWith,      -- :: (a -> (b, c)) -> Seq a -> (Seq b, Seq c)
#ifdef TESTING
    deep,
    node2,
    node3,
#endif
    ) where

import Prelude hiding (
    Functor(..),
#if MIN_VERSION_base(4,11,0)
    (<>),
#endif
#if MIN_VERSION_base(4,8,0)
    Applicative, (<$>), foldMap, Monoid,
#endif
    null, length, lookup, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
    scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3,
    unzip, takeWhile, dropWhile, iterate, reverse, filter, mapM, sum, all)
import Control.Applicative (Applicative(..), (<$>), (<**>),  Alternative,
                            liftA2, liftA3)
import qualified Control.Applicative as Applicative
import Control.DeepSeq (NFData(rnf))
import Control.Monad (MonadPlus(..))
import Data.Monoid (Monoid(..))
import Data.Functor (Functor(..))
import Utils.Containers.Internal.State (State(..), execState)
import Data.Foldable (Foldable(foldl, foldl1, foldr, foldr1, foldMap, foldl', foldr'), toList)
import qualified Data.Foldable as F

#if !(__GLASGOW_HASKELL__ >= 708)
import qualified Data.List
#endif

#if MIN_VERSION_base(4,9,0)
import qualified Data.Semigroup as Semigroup
import Data.Functor.Classes
#endif
import Data.Traversable
import Data.Typeable

-- GHC specific stuff
#ifdef __GLASGOW_HASKELL__
import GHC.Exts (build)
import Text.Read (Lexeme(Ident), lexP, parens, prec,
    readPrec, readListPrec, readListPrecDefault)
import Data.Data
import Data.String (IsString(..))
#endif
#if __GLASGOW_HASKELL__
import GHC.Generics (Generic, Generic1)
#endif

-- Array stuff, with GHC.Arr on GHC
import Data.Array (Ix, Array)
import qualified Data.Array
#ifdef __GLASGOW_HASKELL__
import qualified GHC.Arr
#endif

import Utils.Containers.Internal.Coercions ((.#), (.^#))
-- Coercion on GHC 7.8+
#if __GLASGOW_HASKELL__ >= 708
import Data.Coerce
import qualified GHC.Exts
#else
#endif

-- Identity functor on base 4.8 (GHC 7.10+)
#if MIN_VERSION_base(4,8,0)
import Data.Functor.Identity (Identity(..))
#endif

#if !MIN_VERSION_base(4,8,0)
import Data.Word (Word)
#endif

import Utils.Containers.Internal.StrictPair (StrictPair (..), toPair)
import Control.Monad.Zip (MonadZip (..))
import Control.Monad.Fix (MonadFix (..), fix)

default ()

-- We define our own copy here, for Monoid only, even though this
-- is now a Semigroup operator in base. The essential reason is that
-- we have absolutely no use for semigroups in this module. Everything
-- that needs to sum things up requires a Monoid constraint to deal
-- with empty sequences. I'm not sure if there's a risk of walking
-- through dictionaries to reach <> from Monoid, but I see no reason
-- to risk it.
infixr 6 <>
(<>) :: Monoid m => m -> m -> m
<> :: forall m. Monoid m => m -> m -> m
(<>) = forall m. Monoid m => m -> m -> m
mappend
{-# INLINE (<>) #-}

infixr 5 `consTree`
infixl 5 `snocTree`
infixr 5 `appendTree0`

infixr 5 ><
infixr 5 <|, :<
infixl 5 |>, :>

#ifdef DEFINE_PATTERN_SYNONYMS
infixr 5 :<|
infixl 5 :|>

#if __GLASGOW_HASKELL__ >= 801
{-# COMPLETE (:<|), Empty #-}
{-# COMPLETE (:|>), Empty #-}
#endif

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

-- | A bidirectional pattern synonym viewing the front of a non-empty
-- sequence.
--
-- @since 0.5.8
pattern (:<|) :: a -> Seq a -> Seq a
pattern x $m:<| :: forall {r} {a}. Seq a -> (a -> Seq a -> r) -> ((# #) -> r) -> r
$b:<| :: forall a. a -> Seq a -> Seq a
:<| xs <- (viewl -> x :< xs)
  where
    a
x :<| Seq a
xs = a
x forall a. a -> Seq a -> Seq a
<| Seq a
xs

-- | A bidirectional pattern synonym viewing the rear of a non-empty
-- sequence.
--
-- @since 0.5.8
pattern (:|>) :: Seq a -> a -> Seq a
pattern xs $m:|> :: forall {r} {a}. Seq a -> (Seq a -> a -> r) -> ((# #) -> r) -> r
$b:|> :: forall a. Seq a -> a -> Seq a
:|> x <- (viewr -> xs :> x)
  where
    Seq a
xs :|> a
x = Seq a
xs forall a. Seq a -> a -> Seq a
|> a
x
#endif

class Sized a where
    size :: a -> Int

-- In much the same way that Sized lets us handle the
-- sizes of elements and nodes uniformly, MaybeForce lets
-- us handle their strictness (or lack thereof) uniformly.
-- We can `mseq` something and not have to worry about
-- whether it's an element or a node.
class MaybeForce a where
  maybeRwhnf :: a -> ()

mseq :: MaybeForce a => a -> b -> b
mseq :: forall a b. MaybeForce a => a -> b -> b
mseq a
a b
b = case forall a. MaybeForce a => a -> ()
maybeRwhnf a
a of () -> b
b
{-# INLINE mseq #-}

infixr 0 $!?
($!?) :: MaybeForce a => (a -> b) -> a -> b
a -> b
f $!? :: forall a b. MaybeForce a => (a -> b) -> a -> b
$!? a
a = case forall a. MaybeForce a => a -> ()
maybeRwhnf a
a of () -> a -> b
f a
a
{-# INLINE ($!?) #-}

instance MaybeForce (Elem a) where
  maybeRwhnf :: Elem a -> ()
maybeRwhnf Elem a
_ = ()
  {-# INLINE maybeRwhnf #-}

instance MaybeForce (Node a) where
  maybeRwhnf :: Node a -> ()
maybeRwhnf !Node a
_ = ()
  {-# INLINE maybeRwhnf #-}

-- A wrapper making mseq = seq
newtype ForceBox a = ForceBox a
instance MaybeForce (ForceBox a) where
  maybeRwhnf :: ForceBox a -> ()
maybeRwhnf !ForceBox a
_ = ()
instance Sized (ForceBox a) where
  size :: ForceBox a -> Int
size ForceBox a
_ = Int
1

-- | General-purpose finite sequences.
newtype Seq a = Seq (FingerTree (Elem a))

instance Functor Seq where
    fmap :: forall a b. (a -> b) -> Seq a -> Seq b
fmap = forall a b. (a -> b) -> Seq a -> Seq b
fmapSeq
#ifdef __GLASGOW_HASKELL__
    a
x <$ :: forall a b. a -> Seq b -> Seq a
<$ Seq b
s = forall a. Int -> a -> Seq a
replicate (forall a. Seq a -> Int
length Seq b
s) a
x
#endif

fmapSeq :: (a -> b) -> Seq a -> Seq b
fmapSeq :: forall a b. (a -> b) -> Seq a -> Seq b
fmapSeq a -> b
f (Seq FingerTree (Elem a)
xs) = forall a. FingerTree (Elem a) -> Seq a
Seq (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) FingerTree (Elem a)
xs)
#ifdef __GLASGOW_HASKELL__
{-# NOINLINE [1] fmapSeq #-}
{-# RULES
"fmapSeq/fmapSeq" forall f g xs . fmapSeq f (fmapSeq g xs) = fmapSeq (f . g) xs
 #-}
#endif
#if __GLASGOW_HASKELL__ >= 709
-- Safe coercions were introduced in 7.8, but did not work well with RULES yet.
{-# RULES
"fmapSeq/coerce" fmapSeq coerce = coerce
 #-}
#endif

getSeq :: Seq a -> FingerTree (Elem a)
getSeq :: forall a. Seq a -> FingerTree (Elem a)
getSeq (Seq FingerTree (Elem a)
xs) = FingerTree (Elem a)
xs

instance Foldable Seq where
    foldMap :: forall m a. Monoid m => (a -> m) -> Seq a -> m
foldMap a -> m
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# forall a. Elem a -> a
getElem) forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# forall a. Seq a -> FingerTree (Elem a)
getSeq
    foldr :: forall a b. (a -> b -> b) -> b -> Seq a -> b
foldr a -> b -> b
f b
z = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> b -> b
f forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# forall a. Elem a -> a
getElem) b
z forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# forall a. Seq a -> FingerTree (Elem a)
getSeq
    foldl :: forall b a. (b -> a -> b) -> b -> Seq a -> b
foldl b -> a -> b
f b
z = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (b -> a -> b
f forall c b a d.
Coercible c b =>
(a -> c -> d) -> (b -> c) -> a -> b -> d
.^# forall a. Elem a -> a
getElem) b
z forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# forall a. Seq a -> FingerTree (Elem a)
getSeq

#if __GLASGOW_HASKELL__
    {-# INLINABLE foldMap #-}
    {-# INLINABLE foldr #-}
    {-# INLINABLE foldl #-}
#endif

    foldr' :: forall a b. (a -> b -> b) -> b -> Seq a -> b
foldr' a -> b -> b
f b
z = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (a -> b -> b
f forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# forall a. Elem a -> a
getElem) b
z forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# forall a. Seq a -> FingerTree (Elem a)
getSeq
    foldl' :: forall b a. (b -> a -> b) -> b -> Seq a -> b
foldl' b -> a -> b
f b
z = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (b -> a -> b
f forall c b a d.
Coercible c b =>
(a -> c -> d) -> (b -> c) -> a -> b -> d
.^# forall a. Elem a -> a
getElem) b
z forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# forall a. Seq a -> FingerTree (Elem a)
getSeq

#if __GLASGOW_HASKELL__
    {-# INLINABLE foldr' #-}
    {-# INLINABLE foldl' #-}
#endif

    foldr1 :: forall a. (a -> a -> a) -> Seq a -> a
foldr1 a -> a -> a
f (Seq FingerTree (Elem a)
xs) = forall a. Elem a -> a
getElem (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Elem a -> Elem a -> Elem a
f' FingerTree (Elem a)
xs)
      where f' :: Elem a -> Elem a -> Elem a
f' (Elem a
x) (Elem a
y) = forall a. a -> Elem a
Elem (a -> a -> a
f a
x a
y)

    foldl1 :: forall a. (a -> a -> a) -> Seq a -> a
foldl1 a -> a -> a
f (Seq FingerTree (Elem a)
xs) = forall a. Elem a -> a
getElem (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Elem a -> Elem a -> Elem a
f' FingerTree (Elem a)
xs)
      where f' :: Elem a -> Elem a -> Elem a
f' (Elem a
x) (Elem a
y) = forall a. a -> Elem a
Elem (a -> a -> a
f a
x a
y)

#if MIN_VERSION_base(4,8,0)
    length :: forall a. Seq a -> Int
length = forall a. Seq a -> Int
length
    {-# INLINE length #-}
    null :: forall a. Seq a -> Bool
null   = forall a. Seq a -> Bool
null
    {-# INLINE null #-}
#endif

instance Traversable Seq where
#if __GLASGOW_HASKELL__
    {-# INLINABLE traverse #-}
#endif
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse a -> f b
_ (Seq FingerTree (Elem a)
EmptyT) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. FingerTree (Elem a) -> Seq a
Seq forall a. FingerTree a
EmptyT)
    traverse a -> f b
f' (Seq (Single (Elem a
x'))) =
        (\b
x'' -> forall a. FingerTree (Elem a) -> Seq a
Seq (forall a. a -> FingerTree a
Single (forall a. a -> Elem a
Elem b
x''))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f' a
x'
    traverse a -> f b
f' (Seq (Deep Int
s' Digit (Elem a)
pr' FingerTree (Node (Elem a))
m' Digit (Elem a)
sf')) =
        forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
            (\Digit (Elem b)
pr'' FingerTree (Node (Elem b))
m'' Digit (Elem b)
sf'' -> forall a. FingerTree (Elem a) -> Seq a
Seq (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s' Digit (Elem b)
pr'' FingerTree (Node (Elem b))
m'' Digit (Elem b)
sf''))
            (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
traverseDigitE a -> f b
f' Digit (Elem a)
pr')
            (forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
traverseTree (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node (Elem a) -> f (Node (Elem b))
traverseNodeE a -> f b
f') FingerTree (Node (Elem a))
m')
            (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
traverseDigitE a -> f b
f' Digit (Elem a)
sf')
      where
        traverseTree
            :: Applicative f
            => (Node a -> f (Node b))
            -> FingerTree (Node a)
            -> f (FingerTree (Node b))
        traverseTree :: forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
traverseTree Node a -> f (Node b)
_ FingerTree (Node a)
EmptyT = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. FingerTree a
EmptyT
        traverseTree Node a -> f (Node b)
f (Single Node a
x) = forall a. a -> FingerTree a
Single forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node a -> f (Node b)
f Node a
x
        traverseTree Node a -> f (Node b)
f (Deep Int
s Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf) =
            forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
                (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s)
                (forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
traverseDigitN Node a -> f (Node b)
f Digit (Node a)
pr)
                (forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
traverseTree (forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b)) -> Node (Node a) -> f (Node (Node b))
traverseNodeN Node a -> f (Node b)
f) FingerTree (Node (Node a))
m)
                (forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
traverseDigitN Node a -> f (Node b)
f Digit (Node a)
sf)
        traverseDigitE
            :: Applicative f
            => (a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
        traverseDigitE :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
traverseDigitE a -> f b
f (One (Elem a
a)) =
            (\b
a' -> forall a. a -> Digit a
One (forall a. a -> Elem a
Elem b
a')) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            a -> f b
f a
a
        traverseDigitE a -> f b
f (Two (Elem a
a) (Elem a
b)) =
            forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
                (\b
a' b
b' -> forall a. a -> a -> Digit a
Two (forall a. a -> Elem a
Elem b
a') (forall a. a -> Elem a
Elem b
b'))
                (a -> f b
f a
a)
                (a -> f b
f a
b)
        traverseDigitE a -> f b
f (Three (Elem a
a) (Elem a
b) (Elem a
c)) =
            forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
                (\b
a' b
b' b
c' ->
                      forall a. a -> a -> a -> Digit a
Three (forall a. a -> Elem a
Elem b
a') (forall a. a -> Elem a
Elem b
b') (forall a. a -> Elem a
Elem b
c'))
                (a -> f b
f a
a)
                (a -> f b
f a
b)
                (a -> f b
f a
c)
        traverseDigitE a -> f b
f (Four (Elem a
a) (Elem a
b) (Elem a
c) (Elem a
d)) =
            forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
                (\b
a' b
b' b
c' b
d' -> forall a. a -> a -> a -> a -> Digit a
Four (forall a. a -> Elem a
Elem b
a') (forall a. a -> Elem a
Elem b
b') (forall a. a -> Elem a
Elem b
c') (forall a. a -> Elem a
Elem b
d'))
                (a -> f b
f a
a)
                (a -> f b
f a
b)
                (a -> f b
f a
c) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 
                (a -> f b
f a
d)
        traverseDigitN
            :: Applicative f
            => (Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
        traverseDigitN :: forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
traverseDigitN Node a -> f (Node b)
f Digit (Node a)
t = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Node a -> f (Node b)
f Digit (Node a)
t
        traverseNodeE
            :: Applicative f
            => (a -> f b) -> Node (Elem a) -> f (Node (Elem b))
        traverseNodeE :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node (Elem a) -> f (Node (Elem b))
traverseNodeE a -> f b
f (Node2 Int
s (Elem a
a) (Elem a
b)) =
            forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
                (\b
a' b
b' -> forall a. Int -> a -> a -> Node a
Node2 Int
s (forall a. a -> Elem a
Elem b
a') (forall a. a -> Elem a
Elem b
b'))
                (a -> f b
f a
a)
                (a -> f b
f a
b)
        traverseNodeE a -> f b
f (Node3 Int
s (Elem a
a) (Elem a
b) (Elem a
c)) =
            forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
                (\b
a' b
b' b
c' ->
                      forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (forall a. a -> Elem a
Elem b
a') (forall a. a -> Elem a
Elem b
b') (forall a. a -> Elem a
Elem b
c'))
                (a -> f b
f a
a)
                (a -> f b
f a
b)
                (a -> f b
f a
c)
        traverseNodeN
            :: Applicative f
            => (Node a -> f (Node b)) -> Node (Node a) -> f (Node (Node b))
        traverseNodeN :: forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b)) -> Node (Node a) -> f (Node (Node b))
traverseNodeN Node a -> f (Node b)
f Node (Node a)
t = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Node a -> f (Node b)
f Node (Node a)
t

instance NFData a => NFData (Seq a) where
    rnf :: Seq a -> ()
rnf (Seq FingerTree (Elem a)
xs) = forall a. NFData a => a -> ()
rnf FingerTree (Elem a)
xs

instance Monad Seq where
    return :: forall a. a -> Seq a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Seq a
xs >>= :: forall a b. Seq a -> (a -> Seq b) -> Seq b
>>= a -> Seq b
f = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Seq b -> a -> Seq b
add forall a. Seq a
empty Seq a
xs
      where add :: Seq b -> a -> Seq b
add Seq b
ys a
x = Seq b
ys forall a. Seq a -> Seq a -> Seq a
>< a -> Seq b
f a
x
    >> :: forall a b. Seq a -> Seq b -> Seq b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

-- | @since 0.5.11
instance MonadFix Seq where
    mfix :: forall a. (a -> Seq a) -> Seq a
mfix = forall a. (a -> Seq a) -> Seq a
mfixSeq

-- This is just like the instance for lists, but we can take advantage of
-- constant-time length and logarithmic-time indexing to speed things up.
-- Using fromFunction, we make this about as lazy as we can.
mfixSeq :: (a -> Seq a) -> Seq a
mfixSeq :: forall a. (a -> Seq a) -> Seq a
mfixSeq a -> Seq a
f = forall a. Int -> (Int -> a) -> Seq a
fromFunction (forall a. Seq a -> Int
length (a -> Seq a
f forall {a}. a
err)) (\Int
k -> forall a. (a -> a) -> a
fix (\a
xk -> a -> Seq a
f a
xk forall a. Seq a -> Int -> a
`index` Int
k))
  where
    err :: a
err = forall a. HasCallStack => [Char] -> a
error [Char]
"mfix for Data.Sequence.Seq applied to strict function"

-- | @since 0.5.4
instance Applicative Seq where
    pure :: forall a. a -> Seq a
pure = forall a. a -> Seq a
singleton
    Seq a
xs *> :: forall a b. Seq a -> Seq b -> Seq b
*> Seq b
ys = forall a. Int -> Seq a -> Seq a
cycleNTimes (forall a. Seq a -> Int
length Seq a
xs) Seq b
ys
    <*> :: forall a b. Seq (a -> b) -> Seq a -> Seq b
(<*>) = forall a b. Seq (a -> b) -> Seq a -> Seq b
apSeq
#if MIN_VERSION_base(4,10,0)
    liftA2 :: forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2 = forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2Seq
#endif
    Seq a
xs <* :: forall a b. Seq a -> Seq b -> Seq a
<* Seq b
ys = forall a b. Seq a -> Seq b -> Seq a
beforeSeq Seq a
xs Seq b
ys

apSeq :: Seq (a -> b) -> Seq a -> Seq b
apSeq :: forall a b. Seq (a -> b) -> Seq a -> Seq b
apSeq Seq (a -> b)
fs xs :: Seq a
xs@(Seq FingerTree (Elem a)
xsFT) = case forall a. Seq a -> ViewL a
viewl Seq (a -> b)
fs of
  ViewL (a -> b)
EmptyL -> forall a. Seq a
empty
  a -> b
firstf :< Seq (a -> b)
fs' -> case forall a. Seq a -> ViewR a
viewr Seq (a -> b)
fs' of
    ViewR (a -> b)
EmptyR -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
firstf Seq a
xs
    Seq FingerTree (Elem (a -> b))
fs''FT :> a -> b
lastf -> case forall a. FingerTree (Elem a) -> Rigidified (Elem a)
rigidify FingerTree (Elem a)
xsFT of
         Rigidified (Elem a)
RigidEmpty -> forall a. Seq a
empty
         RigidOne (Elem a
x) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ a
x) Seq (a -> b)
fs
         RigidTwo (Elem a
x1) (Elem a
x2) ->
            forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$ forall a b.
(a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a)
-> FingerTree (Elem b)
ap2FT a -> b
firstf FingerTree (Elem (a -> b))
fs''FT a -> b
lastf (a
x1, a
x2)
         RigidThree (Elem a
x1) (Elem a
x2) (Elem a
x3) ->
            forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$ forall a b.
(a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a, a)
-> FingerTree (Elem b)
ap3FT a -> b
firstf FingerTree (Elem (a -> b))
fs''FT a -> b
lastf (a
x1, a
x2, a
x3)
         RigidFull r :: Rigid (Elem a)
r@(Rigid Int
s Digit23 (Elem a)
pr Thin (Digit23 (Elem a))
_m Digit23 (Elem a)
sf) -> forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$
               forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
* forall a. Seq a -> Int
length Seq (a -> b)
fs)
                    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
firstf) (forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem a)
pr))
                    (forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
liftA2Middle (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
firstf) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
lastf) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FingerTree (Elem (a -> b))
fs''FT Rigid (Elem a)
r)
                    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
lastf) (forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem a)
sf))
{-# NOINLINE [1] apSeq #-}

{-# RULES
"ap/fmap1" forall f xs ys . apSeq (fmapSeq f xs) ys = liftA2Seq f xs ys
"ap/fmap2" forall f gs xs . apSeq gs (fmapSeq f xs) =
                              liftA2Seq (\g x -> g (f x)) gs xs
"fmap/ap" forall f gs xs . fmapSeq f (gs `apSeq` xs) =
                             liftA2Seq (\g x -> f (g x)) gs xs
"fmap/liftA2" forall f g m n . fmapSeq f (liftA2Seq g m n) =
                       liftA2Seq (\x y -> f (g x y)) m n
"liftA2/fmap1" forall f g m n . liftA2Seq f (fmapSeq g m) n =
                       liftA2Seq (\x y -> f (g x) y) m n
"liftA2/fmap2" forall f g m n . liftA2Seq f m (fmapSeq g n) =
                       liftA2Seq (\x y -> f x (g y)) m n
 #-}

ap2FT :: (a -> b) -> FingerTree (Elem (a->b)) -> (a -> b) -> (a,a) -> FingerTree (Elem b)
ap2FT :: forall a b.
(a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a)
-> FingerTree (Elem b)
ap2FT a -> b
firstf FingerTree (Elem (a -> b))
fs a -> b
lastf (a
x,a
y) =
                 forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size FingerTree (Elem (a -> b))
fs forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
4)
                      (forall a. a -> a -> Digit a
Two (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
x) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
y))
                      (forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
2 (\(Elem a -> b
f) -> forall a. Int -> a -> a -> Node a
Node2 Int
2 (forall a. a -> Elem a
Elem (a -> b
f a
x)) (forall a. a -> Elem a
Elem (a -> b
f a
y))) FingerTree (Elem (a -> b))
fs)
                      (forall a. a -> a -> Digit a
Two (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
x) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
y))

ap3FT :: (a -> b) -> FingerTree (Elem (a->b)) -> (a -> b) -> (a,a,a) -> FingerTree (Elem b)
ap3FT :: forall a b.
(a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a, a)
-> FingerTree (Elem b)
ap3FT a -> b
firstf FingerTree (Elem (a -> b))
fs a -> b
lastf (a
x,a
y,a
z) = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size FingerTree (Elem (a -> b))
fs forall a. Num a => a -> a -> a
* Int
3 forall a. Num a => a -> a -> a
+ Int
6)
                        (forall a. a -> a -> a -> Digit a
Three (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
x) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
y) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
z))
                        (forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
3 (\(Elem a -> b
f) -> forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 (forall a. a -> Elem a
Elem (a -> b
f a
x)) (forall a. a -> Elem a
Elem (a -> b
f a
y)) (forall a. a -> Elem a
Elem (a -> b
f a
z))) FingerTree (Elem (a -> b))
fs)
                        (forall a. a -> a -> a -> Digit a
Three (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
x) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
y) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
z))

lift2FT :: (a -> b -> c) -> a -> FingerTree (Elem a) -> a -> (b,b) -> FingerTree (Elem c)
lift2FT :: forall a b c.
(a -> b -> c)
-> a -> FingerTree (Elem a) -> a -> (b, b) -> FingerTree (Elem c)
lift2FT a -> b -> c
f a
firstx FingerTree (Elem a)
xs a
lastx (b
y1,b
y2) =
                 forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
4)
                      (forall a. a -> a -> Digit a
Two (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y1) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y2))
                      (forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
2 (\(Elem a
x) -> forall a. Int -> a -> a -> Node a
Node2 Int
2 (forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y1)) (forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y2))) FingerTree (Elem a)
xs)
                      (forall a. a -> a -> Digit a
Two (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y1) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y2))

lift3FT :: (a -> b -> c) -> a -> FingerTree (Elem a) -> a -> (b,b,b) -> FingerTree (Elem c)
lift3FT :: forall a b c.
(a -> b -> c)
-> a
-> FingerTree (Elem a)
-> a
-> (b, b, b)
-> FingerTree (Elem c)
lift3FT a -> b -> c
f a
firstx FingerTree (Elem a)
xs a
lastx (b
y1,b
y2,b
y3) =
                 forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs forall a. Num a => a -> a -> a
* Int
3 forall a. Num a => a -> a -> a
+ Int
6)
                      (forall a. a -> a -> a -> Digit a
Three (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y1) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y2) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y3))
                      (forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
3 (\(Elem a
x) -> forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 (forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y1)) (forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y2)) (forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y3))) FingerTree (Elem a)
xs)
                      (forall a. a -> a -> a -> Digit a
Three (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y1) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y2) (forall a. a -> Elem a
Elem forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y3))

liftA2Seq :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2Seq :: forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2Seq a -> b -> c
f Seq a
xs ys :: Seq b
ys@(Seq FingerTree (Elem b)
ysFT) = case forall a. Seq a -> ViewL a
viewl Seq a
xs of
  ViewL a
EmptyL -> forall a. Seq a
empty
  a
firstx :< Seq a
xs' -> case forall a. Seq a -> ViewR a
viewr Seq a
xs' of
    ViewR a
EmptyR -> a -> b -> c
f a
firstx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq b
ys
    Seq FingerTree (Elem a)
xs''FT :> a
lastx -> case forall a. FingerTree (Elem a) -> Rigidified (Elem a)
rigidify FingerTree (Elem b)
ysFT of
      Rigidified (Elem b)
RigidEmpty -> forall a. Seq a
empty
      RigidOne (Elem b
y) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> b -> c
f a
x b
y) Seq a
xs
      RigidTwo (Elem b
y1) (Elem b
y2) ->
        forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$ forall a b c.
(a -> b -> c)
-> a -> FingerTree (Elem a) -> a -> (b, b) -> FingerTree (Elem c)
lift2FT a -> b -> c
f a
firstx FingerTree (Elem a)
xs''FT a
lastx (b
y1, b
y2)
      RigidThree (Elem b
y1) (Elem b
y2) (Elem b
y3) ->
        forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$ forall a b c.
(a -> b -> c)
-> a
-> FingerTree (Elem a)
-> a
-> (b, b, b)
-> FingerTree (Elem c)
lift3FT a -> b -> c
f a
firstx FingerTree (Elem a)
xs''FT a
lastx (b
y1, b
y2, b
y3)
      RigidFull r :: Rigid (Elem b)
r@(Rigid Int
s Digit23 (Elem b)
pr Thin (Digit23 (Elem b))
_m Digit23 (Elem b)
sf) -> forall a. FingerTree (Elem a) -> Seq a
Seq forall a b. (a -> b) -> a -> b
$
        forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s forall a. Num a => a -> a -> a
* forall a. Seq a -> Int
length Seq a
xs)
             (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
firstx)) (forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem b)
pr))
             (forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
liftA2Middle (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
firstx)) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
lastx)) (forall a b c. (a -> b -> c) -> a -> Elem b -> Elem c
lift_elem a -> b -> c
f) FingerTree (Elem a)
xs''FT Rigid (Elem b)
r)
             (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
lastx)) (forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem b)
sf))
  where
    lift_elem :: (a -> b -> c) -> a -> Elem b -> Elem c
#if __GLASGOW_HASKELL__ >= 708
    lift_elem :: forall a b c. (a -> b -> c) -> a -> Elem b -> Elem c
lift_elem = coerce :: forall a b. Coercible a b => a -> b
coerce
#else
    lift_elem f x (Elem y) = Elem (f x y)
#endif
{-# NOINLINE [1] liftA2Seq #-}


data Rigidified a = RigidEmpty
                  | RigidOne a
                  | RigidTwo a a
                  | RigidThree a a a
                  | RigidFull (Rigid a)
#ifdef TESTING
                  deriving Show
#endif

-- | A finger tree whose top level has only Two and/or Three digits, and whose
-- other levels have only One and Two digits. A Rigid tree is precisely what one
-- gets by unzipping/inverting a 2-3 tree, so it is precisely what we need to
-- turn a finger tree into in order to transform it into a 2-3 tree.
data Rigid a = Rigid {-# UNPACK #-} !Int !(Digit23 a) (Thin (Node a)) !(Digit23 a)
#ifdef TESTING
             deriving Show
#endif

-- | A finger tree whose digits are all ones and twos
data Thin a = EmptyTh
            | SingleTh a
            | DeepTh {-# UNPACK #-} !Int !(Digit12 a) (Thin (Node a)) !(Digit12 a)
#ifdef TESTING
            deriving Show
#endif

data Digit12 a = One12 a | Two12 a a
#ifdef TESTING
        deriving Show
#endif

-- | Sometimes, we want to emphasize that we are viewing a node as a top-level
-- digit of a 'Rigid' tree.
type Digit23 a = Node a

-- | 'liftA2Middle' does most of the hard work of computing @liftA2 f xs ys@.  It
-- produces the center part of a finger tree, with a prefix corresponding to
-- the first element of @xs@ and a suffix corresponding to its last element omitted;
-- the missing suffix and prefix are added by the caller.  For the recursive
-- call, it squashes the prefix and the suffix into the center tree. Once it
-- gets to the bottom, it turns the tree into a 2-3 tree, applies 'mapMulFT' to
-- produce the main body, and glues all the pieces together.
--
-- @f@ itself is a bit horrifying because of the nested types involved. Its
-- job is to map over the *elements* of a 2-3 tree, rather than the subtrees.
-- If we used a higher-order nested type with MPTC, we could probably use a
-- class, but as it is we have to build up @f@ explicitly through the
-- recursion.
--
-- === Description of parameters
--
-- ==== Types
--
-- @a@ remains constant through recursive calls (in the @DeepTh@ case),
-- while @b@ and @c@ do not: 'liftAMiddle' calls itself at types @Node b@ and
-- @Node c@.
--
-- ==== Values
--
-- 'liftA2Middle' is used when the original @xs :: Sequence a@ has at
-- least two elements, so it can be decomposed by taking off the first and last
-- elements:
--
-- > xs = firstx <: midxs :> lastx
--
-- - the first two arguments @ffirstx, flastx :: b -> c@ are equal to
--   @f firstx@ and @f lastx@, where @f :: a -> b -> c@ is the third argument.
--   This ensures sharing when @f@ computes some data upon being partially
--   applied to its first argument. The way @f@ gets accumulated also ensures
--   sharing for the middle section.
--
-- - the fourth argument is the middle part @midxs@, always constant.
--
-- - the last argument, a tuple of type @Rigid b@, holds all the elements of
--   @ys@, in three parts: a middle part around which the recursion is
--   structured, surrounded by a prefix and a suffix that accumulate
--   elements on the side as we walk down the middle.
--
-- === Invariants
--
-- > 1. Viewing the various trees as the lists they represent
-- >    (the types of the toList functions are given a few paragraphs below):
-- >
-- >    toListFTN result
-- >      =  (ffirstx                    <$> (toListThinN m ++ toListD sf))
-- >      ++ (f      <$> toListFTE midxs <*> (toListD pr ++ toListThinN m ++ toListD sf))
-- >      ++ (flastx                     <$> (toListD pr ++ toListThinN m))
-- >
-- > 2. s = size m + size pr + size sf
-- >
-- > 3. size (ffirstx y) = size (flastx y) = size (f x y) = size y
-- >      for any (x :: a) (y :: b)
--
-- Projecting invariant 1 on sizes, using 2 and 3 to simplify, we have the
-- following corollary.
-- It is weaker than invariant 1, but it may be easier to keep track of.
--
-- > 1a. size result = s * (size midxs + 1) + size m
--
-- In invariant 1, the types of the auxiliary functions are as follows
-- for reference:
--
-- > toListFTE   :: FingerTree (Elem a) -> [a]
-- > toListFTN   :: FingerTree (Node c) -> [c]
-- > toListThinN :: Thin (Node b) -> [b]
-- > toListD     :: Digit12 b -> [b]
liftA2Middle
  :: (b -> c)              -- ^ @ffirstx@
  -> (b -> c)              -- ^ @flastx@
  -> (a -> b -> c)         -- ^ @f@
  -> FingerTree (Elem a)   -- ^ @midxs@
  -> Rigid b               -- ^ @Rigid s pr m sf@ (@pr@: prefix, @sf@: suffix)
  -> FingerTree (Node c)

-- Not at the bottom yet

liftA2Middle :: forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
liftA2Middle
    b -> c
ffirstx
    b -> c
flastx
    a -> b -> c
f
    FingerTree (Elem a)
midxs
    (Rigid Int
s Digit23 b
pr (DeepTh Int
sm Digit12 (Digit23 b)
prm Thin (Node (Digit23 b))
mm Digit12 (Digit23 b)
sfm) Digit23 b
sf)
    -- note: size (DeepTh sm pr mm sfm) = sm = size pr + size mm + size sfm
    = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
sm forall a. Num a => a -> a -> a
+ Int
s forall a. Num a => a -> a -> a
* (forall a. Sized a => a -> Int
size FingerTree (Elem a)
midxs forall a. Num a => a -> a -> a
+ Int
1)) -- note: sm = s - size pr - size sf
           (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
ffirstx) (forall a. Digit12 a -> Digit a
digit12ToDigit Digit12 (Digit23 b)
prm))
           (forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
liftA2Middle
               (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
ffirstx)
               (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
flastx)
               (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c
f)
               FingerTree (Elem a)
midxs
               (forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (forall a. Digit23 a -> Digit12 (Digit23 a) -> Digit23 (Digit23 a)
squashL Digit23 b
pr Digit12 (Digit23 b)
prm) Thin (Node (Digit23 b))
mm (forall a. Digit12 (Node a) -> Node a -> Digit23 (Node a)
squashR Digit12 (Digit23 b)
sfm Digit23 b
sf)))
           (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
flastx) (forall a. Digit12 a -> Digit a
digit12ToDigit Digit12 (Digit23 b)
sfm))

-- At the bottom

liftA2Middle
    b -> c
ffirstx
    b -> c
flastx
    a -> b -> c
f
    FingerTree (Elem a)
midxs
    (Rigid Int
s Digit23 b
pr Thin (Digit23 b)
EmptyTh Digit23 b
sf)
    = forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep
           (forall a. a -> Digit a
One (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
ffirstx Digit23 b
sf))
           (forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
s (\(Elem a
x) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
x)) Node (Digit23 b)
converted) FingerTree (Elem a)
midxs)
           (forall a. a -> Digit a
One (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
flastx Digit23 b
pr))
   where converted :: Node (Digit23 b)
converted = forall a. Sized a => a -> a -> Node a
node2 Digit23 b
pr Digit23 b
sf

liftA2Middle
    b -> c
ffirstx
    b -> c
flastx
    a -> b -> c
f
    FingerTree (Elem a)
midxs
    (Rigid Int
s Digit23 b
pr (SingleTh Digit23 b
q) Digit23 b
sf)
    = forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep
           (forall a. a -> a -> Digit a
Two (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
ffirstx Digit23 b
q) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
ffirstx Digit23 b
sf))
           (forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
s (\(Elem a
x) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
x)) Node (Digit23 b)
converted) FingerTree (Elem a)
midxs)
           (forall a. a -> a -> Digit a
Two (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
flastx Digit23 b
pr) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
flastx Digit23 b
q))
   where converted :: Node (Digit23 b)
converted = forall a. Sized a => a -> a -> a -> Node a
node3 Digit23 b
pr Digit23 b
q Digit23 b
sf

digit12ToDigit :: Digit12 a -> Digit a
digit12ToDigit :: forall a. Digit12 a -> Digit a
digit12ToDigit (One12 a
a) = forall a. a -> Digit a
One a
a
digit12ToDigit (Two12 a
a a
b) = forall a. a -> a -> Digit a
Two a
a a
b

-- Squash the first argument down onto the left side of the second.
squashL :: Digit23 a -> Digit12 (Node a) -> Digit23 (Node a)
squashL :: forall a. Digit23 a -> Digit12 (Digit23 a) -> Digit23 (Digit23 a)
squashL Node a
m (One12 Node a
n) = forall a. Sized a => a -> a -> Node a
node2 Node a
m Node a
n
squashL Node a
m (Two12 Node a
n1 Node a
n2) = forall a. Sized a => a -> a -> a -> Node a
node3 Node a
m Node a
n1 Node a
n2

-- Squash the second argument down onto the right side of the first
squashR :: Digit12 (Node a) -> Digit23 a -> Digit23 (Node a)
squashR :: forall a. Digit12 (Node a) -> Node a -> Digit23 (Node a)
squashR (One12 Node a
n) Node a
m = forall a. Sized a => a -> a -> Node a
node2 Node a
n Node a
m
squashR (Two12 Node a
n1 Node a
n2) Node a
m = forall a. Sized a => a -> a -> a -> Node a
node3 Node a
n1 Node a
n2 Node a
m


-- | /O(m*n)/ (incremental) Takes an /O(m)/ function and a finger tree of size
-- /n/ and maps the function over the tree leaves. Unlike the usual 'fmap', the
-- function is applied to the "leaves" of the 'FingerTree' (i.e., given a
-- @FingerTree (Elem a)@, it applies the function to elements of type @Elem
-- a@), replacing the leaves with subtrees of at least the same height, e.g.,
-- @Node(Node(Elem y))@. The multiplier argument serves to make the annotations
-- match up properly.
mapMulFT :: Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT :: forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT !Int
_ a -> b
_ FingerTree a
EmptyT = forall a. FingerTree a
EmptyT
mapMulFT Int
_mul a -> b
f (Single a
a) = forall a. a -> FingerTree a
Single (a -> b
f a
a)
mapMulFT Int
mul a -> b
f (Deep Int
s Digit a
pr FingerTree (Node a)
m Digit a
sf) = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
mul forall a. Num a => a -> a -> a
* Int
s) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Digit a
pr) (forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
mul (forall a b. Int -> (a -> b) -> Node a -> Node b
mapMulNode Int
mul a -> b
f) FingerTree (Node a)
m) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Digit a
sf)

mapMulNode :: Int -> (a -> b) -> Node a -> Node b
mapMulNode :: forall a b. Int -> (a -> b) -> Node a -> Node b
mapMulNode Int
mul a -> b
f (Node2 Int
s a
a a
b)   = forall a. Int -> a -> a -> Node a
Node2 (Int
mul forall a. Num a => a -> a -> a
* Int
s) (a -> b
f a
a) (a -> b
f a
b)
mapMulNode Int
mul a -> b
f (Node3 Int
s a
a a
b a
c) = forall a. Int -> a -> a -> a -> Node a
Node3 (Int
mul forall a. Num a => a -> a -> a
* Int
s) (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c)

-- | /O(log n)/ (incremental) Takes the extra flexibility out of a 'FingerTree'
-- to make it a genuine 2-3 finger tree. The result of 'rigidify' will have
-- only two and three digits at the top level and only one and two
-- digits elsewhere. If the tree has fewer than four elements, 'rigidify'
-- will simply extract them, and will not build a tree.
rigidify :: FingerTree (Elem a) -> Rigidified (Elem a)
-- The patterns below just fix up the top level of the tree; 'rigidify'
-- delegates the hard work to 'thin'.

rigidify :: forall a. FingerTree (Elem a) -> Rigidified (Elem a)
rigidify FingerTree (Elem a)
EmptyT = forall a. Rigidified a
RigidEmpty

rigidify (Single Elem a
q) = forall a. a -> Rigidified a
RigidOne Elem a
q

-- The left digit is Two or Three
rigidify (Deep Int
s (Two Elem a
a Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf) = forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) FingerTree (Node (Elem a))
m Digit (Elem a)
sf
rigidify (Deep Int
s (Three Elem a
a Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf) = forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) FingerTree (Node (Elem a))
m Digit (Elem a)
sf

-- The left digit is Four
rigidify (Deep Int
s (Four Elem a
a Elem a
b Elem a
c Elem a
d) FingerTree (Node (Elem a))
m Digit (Elem a)
sf) = forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node (Elem a))
m) Digit (Elem a)
sf

-- The left digit is One
rigidify (Deep Int
s (One Elem a
a) FingerTree (Node (Elem a))
m Digit (Elem a)
sf) = case forall a. Sized a => FingerTree a -> ViewLTree a
viewLTree FingerTree (Node (Elem a))
m of
   ConsLTree (Node2 Int
_ Elem a
b Elem a
c) FingerTree (Node (Elem a))
m' -> forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) FingerTree (Node (Elem a))
m' Digit (Elem a)
sf
   ConsLTree (Node3 Int
_ Elem a
b Elem a
c Elem a
d) FingerTree (Node (Elem a))
m' -> forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node (Elem a))
m') Digit (Elem a)
sf
   ViewLTree (Node (Elem a))
EmptyLTree -> case Digit (Elem a)
sf of
     One Elem a
b -> forall a. a -> a -> Rigidified a
RigidTwo Elem a
a Elem a
b
     Two Elem a
b Elem a
c -> forall a. a -> a -> a -> Rigidified a
RigidThree Elem a
a Elem a
b Elem a
c
     Three Elem a
b Elem a
c Elem a
d -> forall a. Rigid a -> Rigidified a
RigidFull forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) forall a. Thin a
EmptyTh (forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d)
     Four Elem a
b Elem a
c Elem a
d Elem a
e -> forall a. Rigid a -> Rigidified a
RigidFull forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) forall a. Thin a
EmptyTh (forall a. Sized a => a -> a -> Node a
node2 Elem a
d Elem a
e)

-- | /O(log n)/ (incremental) Takes a tree whose left side has been rigidified
-- and finishes the job.
rigidifyRight :: Int -> Digit23 (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> Rigidified (Elem a)

-- The right digit is Two, Three, or Four
rigidifyRight :: forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s Node (Elem a)
pr FingerTree (Node (Elem a))
m (Two Elem a
a Elem a
b) = forall a. Rigid a -> Rigidified a
RigidFull forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Node (Elem a)
pr (forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node (Elem a))
m) (forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b)
rigidifyRight Int
s Node (Elem a)
pr FingerTree (Node (Elem a))
m (Three Elem a
a Elem a
b Elem a
c) = forall a. Rigid a -> Rigidified a
RigidFull forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Node (Elem a)
pr (forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node (Elem a))
m) (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c)
rigidifyRight Int
s Node (Elem a)
pr FingerTree (Node (Elem a))
m (Four Elem a
a Elem a
b Elem a
c Elem a
d) = forall a. Rigid a -> Rigidified a
RigidFull forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Node (Elem a)
pr (forall a. Sized a => FingerTree a -> Thin a
thin forall a b. (a -> b) -> a -> b
$ FingerTree (Node (Elem a))
m forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d)

-- The right digit is One
rigidifyRight Int
s Node (Elem a)
pr FingerTree (Node (Elem a))
m (One Elem a
e) = case forall a. Sized a => FingerTree a -> ViewRTree a
viewRTree FingerTree (Node (Elem a))
m of
    SnocRTree FingerTree (Node (Elem a))
m' (Node2 Int
_ Elem a
a Elem a
b) -> forall a. Rigid a -> Rigidified a
RigidFull forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Node (Elem a)
pr (forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node (Elem a))
m') (forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
e)
    SnocRTree FingerTree (Node (Elem a))
m' (Node3 Int
_ Elem a
a Elem a
b Elem a
c) -> forall a. Rigid a -> Rigidified a
RigidFull forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Node (Elem a)
pr (forall a. Sized a => FingerTree a -> Thin a
thin forall a b. (a -> b) -> a -> b
$ FingerTree (Node (Elem a))
m' forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
e)
    ViewRTree (Node (Elem a))
EmptyRTree -> case Node (Elem a)
pr of
      Node2 Int
_ Elem a
a Elem a
b -> forall a. a -> a -> a -> Rigidified a
RigidThree Elem a
a Elem a
b Elem a
e
      Node3 Int
_ Elem a
a Elem a
b Elem a
c -> forall a. Rigid a -> Rigidified a
RigidFull forall a b. (a -> b) -> a -> b
$ forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) forall a. Thin a
EmptyTh (forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
e)

-- | /O(log n)/ (incremental) Rejigger a finger tree so the digits are all ones
-- and twos.
thin :: Sized a => FingerTree a -> Thin a
-- Note that 'thin12' will produce a 'DeepTh' constructor immediately before
-- recursively calling 'thin'.
thin :: forall a. Sized a => FingerTree a -> Thin a
thin FingerTree a
EmptyT = forall a. Thin a
EmptyTh
thin (Single a
a) = forall a. a -> Thin a
SingleTh a
a
thin (Deep Int
s Digit a
pr FingerTree (Node a)
m Digit a
sf) =
  case Digit a
pr of
    One a
a -> forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s (forall a. a -> Digit12 a
One12 a
a) FingerTree (Node a)
m Digit a
sf
    Two a
a a
b -> forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s (forall a. a -> a -> Digit12 a
Two12 a
a a
b) FingerTree (Node a)
m Digit a
sf
    Three a
a a
b a
c  -> forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s (forall a. a -> Digit12 a
One12 a
a) (forall a. Sized a => a -> a -> Node a
node2 a
b a
c forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
m) Digit a
sf
    Four a
a a
b a
c a
d -> forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s (forall a. a -> a -> Digit12 a
Two12 a
a a
b) (forall a. Sized a => a -> a -> Node a
node2 a
c a
d forall a. Sized a => a -> FingerTree a -> FingerTree a
`consTree` FingerTree (Node a)
m) Digit a
sf

thin12 :: Sized a => Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 :: forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s Digit12 a
pr FingerTree (Node a)
m (One a
a) = forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node a)
m) (forall a. a -> Digit12 a
One12 a
a)
thin12 Int
s Digit12 a
pr FingerTree (Node a)
m (Two a
a a
b) = forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node a)
m) (forall a. a -> a -> Digit12 a
Two12 a
a a
b)
thin12 Int
s Digit12 a
pr FingerTree (Node a)
m (Three a
a a
b a
c) = forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (forall a. Sized a => FingerTree a -> Thin a
thin forall a b. (a -> b) -> a -> b
$ FingerTree (Node a)
m forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` forall a. Sized a => a -> a -> Node a
node2 a
a a
b) (forall a. a -> Digit12 a
One12 a
c)
thin12 Int
s Digit12 a
pr FingerTree (Node a)
m (Four a
a a
b a
c a
d) = forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (forall a. Sized a => FingerTree a -> Thin a
thin forall a b. (a -> b) -> a -> b
$ FingerTree (Node a)
m forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` forall a. Sized a => a -> a -> Node a
node2 a
a a
b) (forall a. a -> a -> Digit12 a
Two12 a
c a
d)

-- | \( O(n) \). Intersperse an element between the elements of a sequence.
--
-- @
-- intersperse a empty = empty
-- intersperse a (singleton x) = singleton x
-- intersperse a (fromList [x,y]) = fromList [x,a,y]
-- intersperse a (fromList [x,y,z]) = fromList [x,a,y,a,z]
-- @
--
-- @since 0.5.8
intersperse :: a -> Seq a -> Seq a
intersperse :: forall a. a -> Seq a -> Seq a
intersperse a
y Seq a
xs = case forall a. Seq a -> ViewL a
viewl Seq a
xs of
  ViewL a
EmptyL -> forall a. Seq a
empty
  a
p :< Seq a
ps -> a
p forall a. a -> Seq a -> Seq a
<| (Seq a
ps forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> (forall a b. a -> b -> a
const a
y forall a. a -> Seq a -> Seq a
<| forall a. a -> Seq a
singleton forall a. a -> a
id))
-- We used to use
--
-- intersperse y xs = drop 1 $ xs <**> (const y <| singleton id)
--
-- but if length xs = ((maxBound :: Int) `quot` 2) + 1 then
--
-- length (xs <**> (const y <| singleton id)) will wrap around to negative
-- and the drop won't work. The new implementation can produce a result
-- right up to maxBound :: Int

instance MonadPlus Seq where
    mzero :: forall a. Seq a
mzero = forall a. Seq a
empty
    mplus :: forall a. Seq a -> Seq a -> Seq a
mplus = forall a. Seq a -> Seq a -> Seq a
(><)

-- | @since 0.5.4
instance Alternative Seq where
    empty :: forall a. Seq a
empty = forall a. Seq a
empty
    <|> :: forall a. Seq a -> Seq a -> Seq a
(<|>) = forall a. Seq a -> Seq a -> Seq a
(><)

instance Eq a => Eq (Seq a) where
    Seq a
xs == :: Seq a -> Seq a -> Bool
== Seq a
ys = forall a. Seq a -> Int
length Seq a
xs forall a. Eq a => a -> a -> Bool
== forall a. Seq a -> Int
length Seq a
ys Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
ys

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

#ifdef TESTING
instance Show a => Show (Seq a) where
    showsPrec p (Seq x) = showsPrec p x
#else
instance Show a => Show (Seq a) where
    showsPrec :: Int -> Seq a -> ShowS
showsPrec Int
p Seq a
xs = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
        [Char] -> ShowS
showString [Char]
"fromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs)
#endif

#if MIN_VERSION_base(4,9,0)
-- | @since 0.5.9
instance Show1 Seq where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Seq a -> ShowS
liftShowsPrec Int -> a -> ShowS
_shwsPrc [a] -> ShowS
shwList Int
p Seq a
xs = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
        [Char] -> ShowS
showString [Char]
"fromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
shwList (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs)

-- | @since 0.5.9
instance Eq1 Seq where
    liftEq :: forall a b. (a -> b -> Bool) -> Seq a -> Seq b -> Bool
liftEq a -> b -> Bool
eq Seq a
xs Seq b
ys = forall a. Seq a -> Int
length Seq a
xs forall a. Eq a => a -> a -> Bool
== forall a. Seq a -> Int
length Seq 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. Foldable t => t a -> [a]
toList Seq a
xs) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq b
ys)

-- | @since 0.5.9
instance Ord1 Seq where
    liftCompare :: forall a b. (a -> b -> Ordering) -> Seq a -> Seq b -> Ordering
liftCompare a -> b -> Ordering
cmp Seq a
xs Seq b
ys = forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq b
ys)
#endif

instance Read a => Read (Seq a) where
#ifdef __GLASGOW_HASKELL__
    readPrec :: ReadPrec (Seq 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 [Char]
"fromList" <- ReadPrec Lexeme
lexP
        [a]
xs <- forall a. Read a => ReadPrec a
readPrec
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> Seq a
fromList [a]
xs)

    readListPrec :: ReadPrec [Seq a]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault
#else
    readsPrec p = readParen (p > 10) $ \ r -> do
        ("fromList",s) <- lex r
        (xs,t) <- reads s
        return (fromList xs,t)
#endif

#if MIN_VERSION_base(4,9,0)
-- | @since 0.5.9
instance Read1 Seq where
  liftReadsPrec :: forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Seq 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
$ \[Char]
r -> do
    ([Char]
"fromList",[Char]
s) <- ReadS [Char]
lex [Char]
r
    ([a]
xs,[Char]
t) <- ReadS [a]
readLst [Char]
s
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. [a] -> Seq a
fromList [a]
xs, [Char]
t)
#endif

instance Monoid (Seq a) where
    mempty :: Seq a
mempty = forall a. Seq a
empty
#if MIN_VERSION_base(4,9,0)
    mappend :: Seq a -> Seq a -> Seq a
mappend = forall a. Semigroup a => a -> a -> a
(Semigroup.<>)
#else
    mappend = (><)
#endif

#if MIN_VERSION_base(4,9,0)
-- | @since 0.5.7
instance Semigroup.Semigroup (Seq a) where
    <> :: Seq a -> Seq a -> Seq a
(<>)    = forall a. Seq a -> Seq a -> Seq a
(><)
    stimes :: forall b. Integral b => b -> Seq a -> Seq a
stimes = forall a. Int -> Seq a -> Seq a
cycleNTimes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
#endif

INSTANCE_TYPEABLE1(Seq)

#if __GLASGOW_HASKELL__
instance Data a => Data (Seq a) where
    gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Seq a -> c (Seq a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z Seq a
s    = case forall a. Seq a -> ViewL a
viewl Seq a
s of
        ViewL a
EmptyL  -> forall g. g -> c g
z forall a. Seq a
empty
        a
x :< Seq a
xs -> forall g. g -> c g
z forall a. a -> Seq a -> Seq 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 (Seq a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c   = case Constr -> Int
constrIndex Constr
c of
        Int
1 -> forall r. r -> c r
z forall a. Seq a
empty
        Int
2 -> 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 -> Seq a
(<|)))
        Int
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"

    toConstr :: Seq a -> Constr
toConstr Seq a
xs
      | forall a. Seq a -> Bool
null Seq a
xs     = Constr
emptyConstr
      | Bool
otherwise   = Constr
consConstr

    dataTypeOf :: Seq a -> DataType
dataTypeOf Seq a
_    = DataType
seqDataType

    dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Seq 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

emptyConstr, consConstr :: Constr
emptyConstr :: Constr
emptyConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
seqDataType [Char]
"empty" [] Fixity
Prefix
consConstr :: Constr
consConstr  = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
seqDataType [Char]
"<|" [] Fixity
Infix

seqDataType :: DataType
seqDataType :: DataType
seqDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Data.Sequence.Seq" [Constr
emptyConstr, Constr
consConstr]
#endif

-- Finger trees

data FingerTree a
    = EmptyT
    | Single a
    | Deep {-# UNPACK #-} !Int !(Digit a) (FingerTree (Node a)) !(Digit a)
#ifdef TESTING
    deriving Show
#endif

#ifdef __GLASGOW_HASKELL__
-- | @since 0.6.1
deriving instance Generic1 FingerTree

-- | @since 0.6.1
deriving instance Generic (FingerTree a)
#endif

instance Sized a => Sized (FingerTree a) where
    {-# SPECIALIZE instance Sized (FingerTree (Elem a)) #-}
    {-# SPECIALIZE instance Sized (FingerTree (Node a)) #-}
    size :: FingerTree a -> Int
size FingerTree a
EmptyT             = Int
0
    size (Single a
x)         = forall a. Sized a => a -> Int
size a
x
    size (Deep Int
v Digit a
_ FingerTree (Node a)
_ Digit a
_)     = Int
v

instance Foldable FingerTree where
    foldMap :: forall m a. Monoid m => (a -> m) -> FingerTree a -> m
foldMap a -> m
_ FingerTree a
EmptyT = forall a. Monoid a => a
mempty
    foldMap a -> m
f' (Single a
x') = a -> m
f' a
x'
    foldMap a -> m
f' (Deep Int
_ Digit a
pr' FingerTree (Node a)
m' Digit a
sf') = 
        forall m a. Monoid m => (a -> m) -> Digit a -> m
foldMapDigit a -> m
f' Digit a
pr' forall m. Monoid m => m -> m -> m
<>
        forall m a. Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
foldMapTree (forall m a. Monoid m => (a -> m) -> Node a -> m
foldMapNode a -> m
f') FingerTree (Node a)
m' forall m. Monoid m => m -> m -> m
<>
        forall m a. Monoid m => (a -> m) -> Digit a -> m
foldMapDigit a -> m
f' Digit a
sf'
      where
        foldMapTree :: Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
        foldMapTree :: forall m a. Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
foldMapTree Node a -> m
_ FingerTree (Node a)
EmptyT = forall a. Monoid a => a
mempty
        foldMapTree Node a -> m
f (Single Node a
x) = Node a -> m
f Node a
x
        foldMapTree Node a -> m
f (Deep Int
_ Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf) = 
            forall m a. Monoid m => (Node a -> m) -> Digit (Node a) -> m
foldMapDigitN Node a -> m
f Digit (Node a)
pr forall m. Monoid m => m -> m -> m
<>
            forall m a. Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
foldMapTree (forall m a. Monoid m => (Node a -> m) -> Node (Node a) -> m
foldMapNodeN Node a -> m
f) FingerTree (Node (Node a))
m forall m. Monoid m => m -> m -> m
<>
            forall m a. Monoid m => (Node a -> m) -> Digit (Node a) -> m
foldMapDigitN Node a -> m
f Digit (Node a)
sf

        foldMapDigit :: Monoid m => (a -> m) -> Digit a -> m
        foldMapDigit :: forall m a. Monoid m => (a -> m) -> Digit a -> m
foldMapDigit a -> m
f Digit a
t = forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit forall m. Monoid m => m -> m -> m
(<>) a -> m
f Digit a
t

        foldMapDigitN :: Monoid m => (Node a -> m) -> Digit (Node a) -> m
        foldMapDigitN :: forall m a. Monoid m => (Node a -> m) -> Digit (Node a) -> m
foldMapDigitN Node a -> m
f Digit (Node a)
t = forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit forall m. Monoid m => m -> m -> m
(<>) Node a -> m
f Digit (Node a)
t

        foldMapNode :: Monoid m => (a -> m) -> Node a -> m
        foldMapNode :: forall m a. Monoid m => (a -> m) -> Node a -> m
foldMapNode a -> m
f Node a
t = forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode forall m. Monoid m => m -> m -> m
(<>) a -> m
f Node a
t

        foldMapNodeN :: Monoid m => (Node a -> m) -> Node (Node a) -> m
        foldMapNodeN :: forall m a. Monoid m => (Node a -> m) -> Node (Node a) -> m
foldMapNodeN Node a -> m
f Node (Node a)
t = forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode forall m. Monoid m => m -> m -> m
(<>) Node a -> m
f Node (Node a)
t
#if __GLASGOW_HASKELL__
    {-# INLINABLE foldMap #-}
#endif

    foldr :: forall a b. (a -> b -> b) -> b -> FingerTree a -> b
foldr a -> b -> b
_ b
z' FingerTree a
EmptyT = b
z'
    foldr a -> b -> b
f' b
z' (Single a
x') = a
x' a -> b -> b
`f'` b
z'
    foldr a -> b -> b
f' b
z' (Deep Int
_ Digit a
pr' FingerTree (Node a)
m' Digit a
sf') =
        forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit a -> b -> b
f' (forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree (forall a b. (a -> b -> b) -> Node a -> b -> b
foldrNode a -> b -> b
f') (forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit a -> b -> b
f' b
z' Digit a
sf') FingerTree (Node a)
m') Digit a
pr'
      where
        foldrTree :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
        foldrTree :: forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree Node a -> b -> b
_ b
z FingerTree (Node a)
EmptyT = b
z
        foldrTree Node a -> b -> b
f b
z (Single Node a
x) = Node a
x Node a -> b -> b
`f` b
z
        foldrTree Node a -> b -> b
f b
z (Deep Int
_ Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf) =
            forall a b. (Node a -> b -> b) -> b -> Digit (Node a) -> b
foldrDigitN Node a -> b -> b
f (forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree (forall a b. (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN Node a -> b -> b
f) (forall a b. (Node a -> b -> b) -> b -> Digit (Node a) -> b
foldrDigitN Node a -> b -> b
f b
z Digit (Node a)
sf) FingerTree (Node (Node a))
m) Digit (Node a)
pr

        foldrDigit :: (a -> b -> b) -> b -> Digit a -> b
        foldrDigit :: forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit a -> b -> b
f b
z Digit a
t = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z Digit a
t

        foldrDigitN :: (Node a -> b -> b) -> b -> Digit (Node a) -> b
        foldrDigitN :: forall a b. (Node a -> b -> b) -> b -> Digit (Node a) -> b
foldrDigitN Node a -> b -> b
f b
z Digit (Node a)
t = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Node a -> b -> b
f b
z Digit (Node a)
t

        foldrNode :: (a -> b -> b) -> Node a -> b -> b
        foldrNode :: forall a b. (a -> b -> b) -> Node a -> b -> b
foldrNode a -> b -> b
f Node a
t b
z = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z Node a
t

        foldrNodeN :: (Node a -> b -> b) -> Node (Node a) -> b -> b
        foldrNodeN :: forall a b. (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN Node a -> b -> b
f Node (Node a)
t b
z = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Node a -> b -> b
f b
z Node (Node a)
t
    {-# INLINE foldr #-}


    foldl :: forall b a. (b -> a -> b) -> b -> FingerTree a -> b
foldl b -> a -> b
_ b
z' FingerTree a
EmptyT = b
z'
    foldl b -> a -> b
f' b
z' (Single a
x') = b
z' b -> a -> b
`f'` a
x'
    foldl b -> a -> b
f' b
z' (Deep Int
_ Digit a
pr' FingerTree (Node a)
m' Digit a
sf') =
        forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit b -> a -> b
f' (forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree (forall b a. (b -> a -> b) -> b -> Node a -> b
foldlNode b -> a -> b
f') (forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit b -> a -> b
f' b
z' Digit a
pr') FingerTree (Node a)
m') Digit a
sf'
      where
        foldlTree :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
        foldlTree :: forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree b -> Node a -> b
_ b
z FingerTree (Node a)
EmptyT = b
z
        foldlTree b -> Node a -> b
f b
z (Single Node a
x) = b
z b -> Node a -> b
`f` Node a
x
        foldlTree b -> Node a -> b
f b
z (Deep Int
_ Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf) =
            forall b a. (b -> Node a -> b) -> b -> Digit (Node a) -> b
foldlDigitN b -> Node a -> b
f (forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree (forall b a. (b -> Node a -> b) -> b -> Node (Node a) -> b
foldlNodeN b -> Node a -> b
f) (forall b a. (b -> Node a -> b) -> b -> Digit (Node a) -> b
foldlDigitN b -> Node a -> b
f b
z Digit (Node a)
pr) FingerTree (Node (Node a))
m) Digit (Node a)
sf

        foldlDigit :: (b -> a -> b) -> b -> Digit a -> b
        foldlDigit :: forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit b -> a -> b
f b
z Digit a
t = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z Digit a
t

        foldlDigitN :: (b -> Node a -> b) -> b -> Digit (Node a) -> b
        foldlDigitN :: forall b a. (b -> Node a -> b) -> b -> Digit (Node a) -> b
foldlDigitN b -> Node a -> b
f b
z Digit (Node a)
t = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> Node a -> b
f b
z Digit (Node a)
t

        foldlNode :: (b -> a -> b) -> b -> Node a -> b
        foldlNode :: forall b a. (b -> a -> b) -> b -> Node a -> b
foldlNode b -> a -> b
f b
z Node a
t = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z Node a
t

        foldlNodeN :: (b -> Node a -> b) -> b -> Node (Node a) -> b
        foldlNodeN :: forall b a. (b -> Node a -> b) -> b -> Node (Node a) -> b
foldlNodeN b -> Node a -> b
f b
z Node (Node a)
t = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> Node a -> b
f b
z Node (Node a)
t
    {-# INLINE foldl #-}

    foldr' :: forall a b. (a -> b -> b) -> b -> FingerTree a -> b
foldr' a -> b -> b
_ b
z' FingerTree a
EmptyT = b
z'
    foldr' a -> b -> b
f' b
z' (Single a
x') = a -> b -> b
f' a
x' b
z'
    foldr' a -> b -> b
f' b
z' (Deep Int
_ Digit a
pr' FingerTree (Node a)
m' Digit a
sf') =
        (forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit' a -> b -> b
f' forall a b. (a -> b) -> a -> b
$! (forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree' (forall a b. (a -> b -> b) -> Node a -> b -> b
foldrNode' a -> b -> b
f') forall a b. (a -> b) -> a -> b
$! (forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit' a -> b -> b
f' b
z') Digit a
sf') FingerTree (Node a)
m') Digit a
pr'
      where
        foldrTree' :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
        foldrTree' :: forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree' Node a -> b -> b
_ b
z FingerTree (Node a)
EmptyT = b
z
        foldrTree' Node a -> b -> b
f b
z (Single Node a
x) = Node a -> b -> b
f Node a
x forall a b. (a -> b) -> a -> b
$! b
z
        foldrTree' Node a -> b -> b
f b
z (Deep Int
_ Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf) =
            (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' Node a -> b -> b
f forall a b. (a -> b) -> a -> b
$! (forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree' (forall a b. (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN' Node a -> b -> b
f) forall a b. (a -> b) -> a -> b
$! (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' Node a -> b -> b
f forall a b. (a -> b) -> a -> b
$! b
z) Digit (Node a)
sf) FingerTree (Node (Node a))
m) Digit (Node a)
pr

        foldrDigit' :: (a -> b -> b) -> b -> Digit a -> b
        foldrDigit' :: forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit' a -> b -> b
f b
z Digit a
t = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' a -> b -> b
f b
z Digit a
t

        foldrNode' :: (a -> b -> b) -> Node a -> b -> b
        foldrNode' :: forall a b. (a -> b -> b) -> Node a -> b -> b
foldrNode' a -> b -> b
f Node a
t b
z = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' a -> b -> b
f b
z Node a
t

        foldrNodeN' :: (Node a -> b -> b) -> Node (Node a) -> b -> b
        foldrNodeN' :: forall a b. (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN' Node a -> b -> b
f Node (Node a)
t b
z = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' Node a -> b -> b
f b
z Node (Node a)
t
    {-# INLINE foldr' #-}

    foldl' :: forall b a. (b -> a -> b) -> b -> FingerTree a -> b
foldl' b -> a -> b
_ b
z' FingerTree a
EmptyT = b
z'
    foldl' b -> a -> b
f' b
z' (Single a
x') = b -> a -> b
f' b
z' a
x'
    foldl' b -> a -> b
f' b
z' (Deep Int
_ Digit a
pr' FingerTree (Node a)
m' Digit a
sf') =
        (forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit' b -> a -> b
f' forall a b. (a -> b) -> a -> b
$!
         (forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree' (forall b a. (b -> a -> b) -> b -> Node a -> b
foldlNode' b -> a -> b
f') forall a b. (a -> b) -> a -> b
$! (forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit' b -> a -> b
f' b
z') Digit a
pr') FingerTree (Node a)
m')
            Digit a
sf'
      where
        foldlTree' :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
        foldlTree' :: forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree' b -> Node a -> b
_ b
z FingerTree (Node a)
EmptyT = b
z
        foldlTree' b -> Node a -> b
f b
z (Single Node a
xs) = b -> Node a -> b
f b
z Node a
xs
        foldlTree' b -> Node a -> b
f b
z (Deep Int
_ Digit (Node a)
pr FingerTree (Node (Node a))
m Digit (Node a)
sf) =
            (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> Node a -> b
f forall a b. (a -> b) -> a -> b
$! (forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree' (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> Node a -> b
f) forall a b. (a -> b) -> a -> b
$! forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> Node a -> b
f b
z Digit (Node a)
pr) FingerTree (Node (Node a))
m) Digit (Node a)
sf

        foldlDigit' :: (b -> a -> b) -> b -> Digit a -> b
        foldlDigit' :: forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit' b -> a -> b
f b
z Digit a
t = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> a -> b
f b
z Digit a
t

        foldlNode' :: (b -> a -> b) -> b -> Node a -> b
        foldlNode' :: forall b a. (b -> a -> b) -> b -> Node a -> b
foldlNode' b -> a -> b
f b
z Node a
t = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> a -> b
f b
z Node a
t
    {-# INLINE foldl' #-}

    foldr1 :: forall a. (a -> a -> a) -> FingerTree a -> a
foldr1 a -> a -> a
_ FingerTree a
EmptyT = forall a. HasCallStack => [Char] -> a
error [Char]
"foldr1: empty sequence"
    foldr1 a -> a -> a
_ (Single a
x) = a
x
    foldr1 a -> a -> a
f (Deep Int
_ Digit a
pr FingerTree (Node a)
m Digit a
sf) =
        forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
f (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
f)) (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 a -> a -> a
f Digit a
sf) FingerTree (Node a)
m) Digit a
pr

    foldl1 :: forall a. (a -> a -> a) -> FingerTree a -> a
foldl1 a -> a -> a
_ FingerTree a
EmptyT = forall a. HasCallStack => [Char] -> a
error [Char]
"foldl1: empty sequence"
    foldl1 a -> a -> a
_ (Single a
x) = a
x
    foldl1 a -> a -> a
f (Deep Int
_ Digit a
pr FingerTree (Node a)
m Digit a
sf) =
        forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
f (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
f) (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 a -> a -> a
f Digit a
pr) FingerTree (Node a)
m) Digit a
sf

instance Functor FingerTree where
    fmap :: forall a b. (a -> b) -> FingerTree a -> FingerTree b
fmap a -> b
_ FingerTree a
EmptyT = forall a. FingerTree a
EmptyT
    fmap a -> b
f (Single a
x) = forall a. a -> FingerTree a
Single (a -> b
f a
x)
    fmap a -> b
f (Deep Int
v Digit a
pr FingerTree (Node a)
m Digit a
sf) =
        forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
v (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Digit a
pr) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) FingerTree (Node a)
m) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Digit a
sf)

instance Traversable FingerTree where
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FingerTree a -> f (FingerTree b)
traverse a -> f b
_ FingerTree a
EmptyT = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. FingerTree a
EmptyT
    traverse a -> f b
f (Single a
x) = forall a. a -> FingerTree a
Single forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
    traverse a -> f b
f (Deep Int
v Digit a
pr FingerTree (Node a)
m Digit a
sf) =
        forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
v) (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Digit a
pr) (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) FingerTree (Node a)
m)
            (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Digit a
sf)

instance NFData a => NFData (FingerTree a) where
    rnf :: FingerTree a -> ()
rnf FingerTree a
EmptyT = ()
    rnf (Single a
x) = forall a. NFData a => a -> ()
rnf a
x
    rnf (Deep Int
_ Digit a
pr FingerTree (Node a)
m Digit a
sf) = forall a. NFData a => a -> ()
rnf Digit a
pr seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Digit a
sf seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf FingerTree (Node a)
m

{-# INLINE deep #-}
deep            :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep :: forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep Digit a
pr FingerTree (Node a)
m Digit a
sf    =  forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (forall a. Sized a => a -> Int
size Digit a
pr forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size FingerTree (Node a)
m forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size Digit a
sf) Digit a
pr FingerTree (Node a)
m Digit a
sf

{-# INLINE pullL #-}
pullL :: Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL :: forall a. Int -> FingerTree (Node a) -> Digit a -> FingerTree a
pullL Int
s FingerTree (Node a)
m Digit a
sf = case forall a. Sized a => FingerTree a -> ViewLTree a
viewLTree FingerTree (Node a)
m of
    ViewLTree (Node a)
EmptyLTree          -> forall a. Int -> Digit a -> FingerTree a
digitToTree' Int
s Digit a
sf
    ConsLTree Node a
pr FingerTree (Node a)
m'     -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (forall a. Node a -> Digit a
nodeToDigit Node a
pr) FingerTree (Node a)
m' Digit a
sf

{-# INLINE pullR #-}
pullR :: Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR :: forall a. Int -> Digit a -> FingerTree (Node a) -> FingerTree a
pullR Int
s Digit a
pr FingerTree (Node a)
m = case forall a. Sized a => FingerTree a -> ViewRTree a
viewRTree FingerTree (Node a)
m of
    ViewRTree (Node a)
EmptyRTree          -> forall a. Int -> Digit a -> FingerTree a
digitToTree' Int
s Digit a
pr
    SnocRTree FingerTree (Node a)
m' Node a
sf     -> forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit a
pr FingerTree (Node a)
m' (forall a. Node a -> Digit a
nodeToDigit Node a
sf)

-- Digits

data Digit a
    = One a
    | Two a a
    | Three a a a
    | Four a a a a
#ifdef TESTING
    deriving Show
#endif

#ifdef __GLASGOW_HASKELL__
-- | @since 0.6.1
deriving instance Generic1 Digit

-- | @since 0.6.1
deriving instance Generic (Digit a)
#endif

foldDigit :: (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit :: forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit b -> b -> b
_     a -> b
f (One a
a) = a -> b
f a
a
foldDigit b -> b -> b
(<+>) a -> b
f (Two a
a a
b) = a -> b
f a
a b -> b -> b
<+> a -> b
f a
b
foldDigit b -> b -> b
(<+>) a -> b
f (Three a
a a
b a
c) = a -> b
f a
a b -> b -> b
<+> a -> b
f a
b b -> b -> b
<+> a -> b
f a
c
foldDigit b -> b -> b
(<+>) a -> b
f (Four a
a a
b a
c a
d) = a -> b
f a
a b -> b -> b
<+> a -> b
f a
b b -> b -> b
<+> a -> b
f a
c b -> b -> b
<+> a -> b
f a
d
{-# INLINE foldDigit #-}

instance Foldable Digit where
    foldMap :: forall m a. Monoid m => (a -> m) -> Digit a -> m
foldMap = forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit forall m. Monoid m => m -> m -> m
mappend

    foldr :: forall a b. (a -> b -> b) -> b -> Digit a -> b
foldr a -> b -> b
f b
z (One a
a) = a
a a -> b -> b
`f` b
z
    foldr a -> b -> b
f b
z (Two a
a a
b) = a
a a -> b -> b
`f` (a
b a -> b -> b
`f` b
z)
    foldr a -> b -> b
f b
z (Three a
a a
b a
c) = a
a a -> b -> b
`f` (a
b a -> b -> b
`f` (a
c a -> b -> b
`f` b
z))
    foldr a -> b -> b
f b
z (Four a
a a
b a
c a
d) = a
a a -> b -> b
`f` (a
b a -> b -> b
`f` (a
c a -> b -> b
`f` (a
d a -> b -> b
`f` b
z)))
    {-# INLINE foldr #-}

    foldl :: forall b a. (b -> a -> b) -> b -> Digit a -> b
foldl b -> a -> b
f b
z (One a
a) = b
z b -> a -> b
`f` a
a
    foldl b -> a -> b
f b
z (Two a
a a
b) = (b
z b -> a -> b
`f` a
a) b -> a -> b
`f` a
b
    foldl b -> a -> b
f b
z (Three a
a a
b a
c) = ((b
z b -> a -> b
`f` a
a) b -> a -> b
`f` a
b) b -> a -> b
`f` a
c
    foldl b -> a -> b
f b
z (Four a
a a
b a
c a
d) = (((b
z b -> a -> b
`f` a
a) b -> a -> b
`f` a
b) b -> a -> b
`f` a
c) b -> a -> b
`f` a
d
    {-# INLINE foldl #-}

    foldr' :: forall a b. (a -> b -> b) -> b -> Digit a -> b
foldr' a -> b -> b
f b
z (One a
a) = a -> b -> b
f a
a b
z
    foldr' a -> b -> b
f b
z (Two a
a a
b) = a -> b -> b
f a
a forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b b
z
    foldr' a -> b -> b
f b
z (Three a
a a
b a
c) = a -> b -> b
f a
a forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
c b
z
    foldr' a -> b -> b
f b
z (Four a
a a
b a
c a
d) = a -> b -> b
f a
a forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
c forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
d b
z
    {-# INLINE foldr' #-}

    foldl' :: forall b a. (b -> a -> b) -> b -> Digit a -> b
foldl' b -> a -> b
f b
z (One a
a) = b -> a -> b
f b
z a
a
    foldl' b -> a -> b
f b
z (Two a
a a
b) = (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b
    foldl' b -> a -> b
f b
z (Three a
a a
b a
c) = (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b) a
c
    foldl' b -> a -> b
f b
z (Four a
a a
b a
c a
d) = (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b) a
c) a
d
    {-# INLINE foldl' #-}

    foldr1 :: forall a. (a -> a -> a) -> Digit a -> a
foldr1 a -> a -> a
_ (One a
a) = a
a
    foldr1 a -> a -> a
f (Two a
a a
b) = a
a a -> a -> a
`f` a
b
    foldr1 a -> a -> a
f (Three a
a a
b a
c) = a
a a -> a -> a
`f` (a
b a -> a -> a
`f` a
c)
    foldr1 a -> a -> a
f (Four a
a a
b a
c a
d) = a
a a -> a -> a
`f` (a
b a -> a -> a
`f` (a
c a -> a -> a
`f` a
d))

    foldl1 :: forall a. (a -> a -> a) -> Digit a -> a
foldl1 a -> a -> a
_ (One a
a) = a
a
    foldl1 a -> a -> a
f (Two a
a a
b) = a
a a -> a -> a
`f` a
b
    foldl1 a -> a -> a
f (Three a
a a
b a
c) = (a
a a -> a -> a
`f` a
b) a -> a -> a
`f` a
c
    foldl1 a -> a -> a
f (Four a
a a
b a
c a
d) = ((a
a a -> a -> a
`f` a
b) a -> a -> a
`f` a
c) a -> a -> a
`f` a
d

instance Functor Digit where
    {-# INLINE fmap #-}
    fmap :: forall a b. (a -> b) -> Digit a -> Digit b
fmap a -> b
f (One a
a) = forall a. a -> Digit a
One (a -> b
f a
a)
    fmap a -> b
f (Two a
a a
b) = forall a. a -> a -> Digit a
Two (a -> b
f a
a) (a -> b
f a
b)
    fmap a -> b
f (Three a
a a
b a
c) = forall a. a -> a -> a -> Digit a
Three (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c)
    fmap a -> b
f (Four a
a a
b a
c a
d) = forall a. a -> a -> a -> a -> Digit a
Four (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c) (a -> b
f a
d)

instance Traversable Digit where
    {-# INLINE traverse #-}
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Digit a -> f (Digit b)
traverse a -> f b
f (One a
a) = forall a. a -> Digit a
One forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
    traverse a -> f b
f (Two a
a a
b) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> a -> Digit a
Two (a -> f b
f a
a) (a -> f b
f a
b)
    traverse a -> f b
f (Three a
a a
b a
c) = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 forall a. a -> a -> a -> Digit a
Three (a -> f b
f a
a) (a -> f b
f a
b) (a -> f b
f a
c)
    traverse a -> f b
f (Four a
a a
b a
c a
d) = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 forall a. a -> a -> a -> a -> Digit a
Four (a -> f b
f a
a) (a -> f b
f a
b) (a -> f b
f a
c) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
d

instance NFData a => NFData (Digit a) where
    rnf :: Digit a -> ()
rnf (One a
a) = forall a. NFData a => a -> ()
rnf a
a
    rnf (Two a
a a
b) = forall a. NFData a => a -> ()
rnf a
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
b
    rnf (Three a
a a
b a
c) = forall a. NFData a => a -> ()
rnf a
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
c
    rnf (Four a
a a
b a
c a
d) = forall a. NFData a => a -> ()
rnf a
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
c seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
d

instance Sized a => Sized (Digit a) where
    {-# INLINE size #-}
    size :: Digit a -> Int
size = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall a. Num a => a -> a -> a
(+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Sized a => a -> Int
size

{-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
{-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-}
digitToTree     :: Sized a => Digit a -> FingerTree a
digitToTree :: forall a. Sized a => Digit a -> FingerTree a
digitToTree (One a
a) = forall a. a -> FingerTree a
Single a
a
digitToTree (Two a
a a
b) = forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (forall a. a -> Digit a
One a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One a
b)
digitToTree (Three a
a a
b a
c) = forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (forall a. a -> a -> Digit a
Two a
a a
b) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One a
c)
digitToTree (Four a
a a
b a
c a
d) = forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (forall a. a -> a -> Digit a
Two a
a a
b) forall a. FingerTree a
EmptyT (forall a. a -> a -> Digit a
Two a
c a
d)

-- | Given the size of a digit and the digit itself, efficiently converts
-- it to a FingerTree.
digitToTree' :: Int -> Digit a -> FingerTree a
digitToTree' :: forall a. Int -> Digit a -> FingerTree a
digitToTree' Int
n (Four a
a a
b a
c a
d) = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n (forall a. a -> a -> Digit a
Two a
a a
b) forall a. FingerTree a
EmptyT (forall a. a -> a -> Digit a
Two a
c a
d)
digitToTree' Int
n (Three a
a a
b a
c) = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n (forall a. a -> a -> Digit a
Two a
a a
b) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One a
c)
digitToTree' Int
n (Two a
a a
b) = forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n (forall a. a -> Digit a
One a
a) forall a. FingerTree a
EmptyT (forall a. a -> Digit a
One a
b)
digitToTree' !Int
_n (One a
a) = forall a. a -> FingerTree a
Single a
a

-- Nodes

data Node a
    = Node2 {-# UNPACK #-} !Int a a
    | Node3 {-# UNPACK #-} !Int a a a
#ifdef TESTING
    deriving Show
#endif

#ifdef __GLASGOW_HASKELL__
-- | @since 0.6.1
deriving instance Generic1 Node

-- | @since 0.6.1
deriving instance Generic (Node a)
#endif

foldNode :: (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode :: forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode b -> b -> b
(<+>) a -> b
f (Node2 Int
_ a
a a
b) = a -> b
f a
a b -> b -> b
<+> a -> b
f a
b
foldNode b -> b -> b
(<+>) a -> b
f (Node3 Int
_ a
a a
b a
c) = a -> b
f a
a b -> b -> b
<+> a -> b
f a
b b -> b -> b
<+> a -> b
f a
c
{-# INLINE foldNode #-}

instance Foldable Node where
    foldMap :: forall m a. Monoid m => (a -> m) -> Node a -> m
foldMap = forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode forall m. Monoid m => m -> m -> m
mappend

    foldr :: forall a b. (a -> b -> b) -> b -> Node a -> b
foldr a -> b -> b
f b
z (Node2 Int
_ a
a a
b) = a
a a -> b -> b
`f` (a
b a -> b -> b
`f` b
z)
    foldr a -> b -> b
f b
z (Node3 Int
_ a
a a
b a
c) = a
a a -> b -> b
`f` (a
b a -> b -> b
`f` (a
c a -> b -> b
`f` b
z))
    {-# INLINE foldr #-}

    foldl :: forall b a. (b -> a -> b) -> b -> Node a -> b
foldl b -> a -> b
f b
z (Node2 Int
_ a
a a
b) = (b
z b -> a -> b
`f` a
a) b -> a -> b
`f` a
b
    foldl b -> a -> b
f b
z (Node3 Int
_ a
a a
b a
c) = ((b
z b -> a -> b
`f` a
a) b -> a -> b
`f` a
b) b -> a -> b
`f` a
c
    {-# INLINE foldl #-}

    foldr' :: forall a b. (a -> b -> b) -> b -> Node a -> b
foldr' a -> b -> b
f b
z (Node2 Int
_ a
a a
b) = a -> b -> b
f a
a forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b b
z
    foldr' a -> b -> b
f b
z (Node3 Int
_ a
a a
b a
c) = a -> b -> b
f a
a forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
c b
z
    {-# INLINE foldr' #-}

    foldl' :: forall b a. (b -> a -> b) -> b -> Node a -> b
foldl' b -> a -> b
f b
z (Node2 Int
_ a
a a
b) = (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b
    foldl' b -> a -> b
f b
z (Node3 Int
_ a
a a
b a
c) = (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f forall a b. (a -> b) -> a -> b
$! b -> a -> b
f b
z a
a) a
b) a
c
    {-# INLINE foldl' #-}

instance Functor Node where
    {-# INLINE fmap #-}
    fmap :: forall a b. (a -> b) -> Node a -> Node b
fmap a -> b
f (Node2 Int
v a
a a
b) = forall a. Int -> a -> a -> Node a
Node2 Int
v (a -> b
f a
a) (a -> b
f a
b)
    fmap a -> b
f (Node3 Int
v a
a a
b a
c) = forall a. Int -> a -> a -> a -> Node a
Node3 Int
v (a -> b
f a
a) (a -> b
f a
b) (a -> b
f a
c)

instance Traversable Node where
    {-# INLINE traverse #-}
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node a -> f (Node b)
traverse a -> f b
f (Node2 Int
v a
a a
b) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall a. Int -> a -> a -> Node a
Node2 Int
v) (a -> f b
f a
a) (a -> f b
f a
b)
    traverse a -> f b
f (Node3 Int
v a
a a
b a
c) = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (forall a. Int -> a -> a -> a -> Node a
Node3 Int
v) (a -> f b
f a
a) (a -> f b
f a
b) (a -> f b
f a
c)

instance NFData a => NFData (Node a) where
    rnf :: Node a -> ()
rnf (Node2 Int
_ a
a a
b) = forall a. NFData a => a -> ()
rnf a
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
b
    rnf (Node3 Int
_ a
a a
b a
c) = forall a. NFData a => a -> ()
rnf a
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf a
c

instance Sized (Node a) where
    size :: Node a -> Int
size (Node2 Int
v a
_ a
_)      = Int
v
    size (Node3 Int
v a
_ a
_ a
_)    = Int
v

{-# INLINE node2 #-}
node2           :: Sized a => a -> a -> Node a
node2 :: forall a. Sized a => a -> a -> Node a
node2 a
a a
b       =  forall a. Int -> a -> a -> Node a
Node2 (forall a. Sized a => a -> Int
size a
a forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b) a
a a
b

{-# INLINE node3 #-}
node3           :: Sized a => a -> a -> a -> Node a
node3 :: forall a. Sized a => a -> a -> a -> Node a
node3 a
a a
b a
c     =  forall a. Int -> a -> a -> a -> Node a
Node3 (forall a. Sized a => a -> Int
size a
a forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
b forall a. Num a => a -> a -> a
+ forall a. Sized a => a -> Int
size a
c) a
a a
b a
c

nodeToDigit :: Node a -> Digit a
nodeToDigit :: forall a. Node a -> Digit a
nodeToDigit (Node2 Int
_ a
a a
b) = forall a. a -> a -> Digit a
Two a
a a
b
nodeToDigit (Node3 Int
_ a
a a
b a
c) = forall a. a -> a -> a -> Digit a
Three a
a a
b a
c

-- Elements

newtype Elem a  =  Elem { forall a. Elem a -> a
getElem :: a }
#ifdef TESTING
    deriving Show
#endif

#ifdef __GLASGOW_HASKELL__
-- | @since 0.6.1
deriving instance Generic1 Elem

-- | @since 0.6.1
deriving instance Generic (Elem a)
#endif

instance Sized (Elem a) where
    size :: Elem a -> Int
size Elem a
_ = Int
1

instance Functor Elem where
#if __GLASGOW_HASKELL__ >= 708
-- This cuts the time for <*> by around a fifth.
    fmap :: forall a b. (a -> b) -> Elem a -> Elem b
fmap = coerce :: forall a b. Coercible a b => a -> b
coerce
#else
    fmap f (Elem x) = Elem (f x)
#endif

instance Foldable Elem where
    foldr :: forall a b. (a -> b -> b) -> b -> Elem a -> b
foldr a -> b -> b
f b
z (Elem a
x) = a -> b -> b
f a
x b
z
#if __GLASGOW_HASKELL__ >= 708
    foldMap :: forall m a. Monoid m => (a -> m) -> Elem a -> m
foldMap = coerce :: forall a b. Coercible a b => a -> b
coerce
    foldl :: forall b a. (b -> a -> b) -> b -> Elem a -> b
foldl = coerce :: forall a b. Coercible a b => a -> b
coerce
    foldl' :: forall b a. (b -> a -> b) -> b -> Elem a -> b
foldl' = coerce :: forall a b. Coercible a b => a -> b
coerce
#else
    foldMap f (Elem x) = f x
    foldl f z (Elem x) = f z x
    foldl' f z (Elem x) = f z x
#endif

instance Traversable Elem where
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Elem a -> f (Elem b)
traverse a -> f b
f (Elem a
x) = forall a. a -> Elem a
Elem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

instance NFData a => NFData (Elem a) where
    rnf :: Elem a -> ()
rnf (Elem a
x) = forall a. NFData a => a -> ()
rnf a
x

-------------------------------------------------------
-- Applicative construction
-------------------------------------------------------
#if !MIN_VERSION_base(4,8,0)
newtype Identity a = Identity {runIdentity :: a}

instance Functor Identity where
    fmap f (Identity x) = Identity (f x)

instance Applicative Identity where
    pure = Identity
    Identity f <*> Identity x = Identity (f x)
#endif

-- | 'applicativeTree' takes an Applicative-wrapped construction of a
-- piece of a FingerTree, assumed to always have the same size (which
-- is put in the second argument), and replicates it as many times as
-- specified.  This is a generalization of 'replicateA', which itself
-- is a generalization of many Data.Sequence methods.
{-# SPECIALIZE applicativeTree :: Int -> Int -> State s a -> State s (FingerTree a) #-}
{-# SPECIALIZE applicativeTree :: Int -> Int -> Identity a -> Identity (FingerTree a) #-}
-- Special note: the Identity specialization automatically does node sharing,
-- reducing memory usage of the resulting tree to /O(log n)/.
applicativeTree :: Applicative f => Int -> Int -> f a -> f (FingerTree a)
applicativeTree :: forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree Int
n !Int
mSize f a
m = case Int
n of
    Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. FingerTree a
EmptyT
    Int
1 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> FingerTree a
Single f a
m
    Int
2 -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
one forall {a}. f (FingerTree a)
emptyTree f (Digit a)
one
    Int
3 -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
two forall {a}. f (FingerTree a)
emptyTree f (Digit a)
one
    Int
4 -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
two forall {a}. f (FingerTree a)
emptyTree f (Digit a)
two
    Int
5 -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
three forall {a}. f (FingerTree a)
emptyTree f (Digit a)
two
    Int
6 -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
three forall {a}. f (FingerTree a)
emptyTree f (Digit a)
three
    Int
_ -> case Int
n forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
3 of
           (Int
q,Int
0) -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
three (forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree (Int
q forall a. Num a => a -> a -> a
- Int
2) Int
mSize' f (Node a)
n3) f (Digit a)
three
           (Int
q,Int
1) -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
two (forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree (Int
q forall a. Num a => a -> a -> a
- Int
1) Int
mSize' f (Node a)
n3) f (Digit a)
two
           (Int
q,Int
_) -> f (Digit a)
-> f (FingerTree (Node a)) -> f (Digit a) -> f (FingerTree a)
deepA f (Digit a)
three (forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f a -> f (FingerTree a)
applicativeTree (Int
q forall a. Num a => a -> a -> a
- Int
1) Int
mSize' f (Node a)
n3) f (Digit a)
two
      where !mSize' :: Int
mSize' = Int
3 forall a. Num a => a -> a -> a
* Int
mSize
            n3 :: f (Node a)
n3 = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (forall a. Int -> a -> a -> a -> Node a
Node3 Int
mSize') f a
m f a
m f a
m
  where
    one :: f (Digit a)
one = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Digit a
One f a
m
    two :: f (Digit a)
two = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> a -> Digit a
Two f a
m f a
m
    three :: f (Digit a)
three = forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -&g