{-# LANGUAGE CPP #-}
#include "containers.h"
{-# LANGUAGE BangPatterns #-}
#if __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
#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 Utils.Containers.Internal.Prelude hiding (
    Functor(..),
#if MIN_VERSION_base(4,11,0)
    (<>),
#endif
    (<$>), Monoid,
    null, length, lookup, take, drop, splitAt,
    scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3,
    unzip, takeWhile, dropWhile, iterate, reverse, filter, mapM, sum, all)
import Prelude ()
import Control.Applicative ((<$>), (<**>),  Alternative,
                            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 (foldr', toList)
import qualified Data.Foldable as F

import qualified Data.Semigroup as Semigroup
import Data.Functor.Classes
import Data.Traversable

-- 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(..))
import qualified Language.Haskell.TH.Syntax as TH
-- See Note [ Template Haskell Dependencies ]
import Language.Haskell.TH ()
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 ((.#), (.^#))
import Data.Coerce
import qualified GHC.Exts

import Data.Functor.Identity (Identity(..))

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
(<>) = 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 :|>

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

-- | 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 a -> Seq a -> Seq a
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 Seq a -> a -> Seq a
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 a -> ()
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 a -> ()
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))

#ifdef __GLASGOW_HASKELL__
-- | @since 0.6.6
instance TH.Lift a => TH.Lift (Seq a) where
#  if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: forall (m :: * -> *). Quote m => Seq a -> Code m (Seq a)
liftTyped Seq a
t = [|| FingerTree a -> Seq a
forall a. FingerTree a -> Seq a
coerceFT FingerTree a
z ||]
#  else
  lift t = [| coerceFT z |]
#  endif
    where
      -- We rebalance the sequence to use only 3-nodes before lifting its
      -- underlying finger tree. This should minimize the size and depth of the
      -- tree generated at run-time. It also reduces the size of the splice,
      -- but I don't know how that affects the size of the resulting Core once
      -- all the types are added.
      Seq FingerTree (Elem a)
ft = (() -> a -> a) -> Seq () -> Seq a -> Seq a
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith ((a -> () -> a) -> () -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> () -> a
forall a b. a -> b -> a
const) (Int -> () -> Seq ()
forall a. Int -> a -> Seq a
replicate (Seq a -> Int
forall a. Seq a -> Int
length Seq a
t) ()) Seq a
t

      -- We remove the 'Elem' constructors to reduce the size of the splice
      -- and the number of types and coercions in the generated Core. Instead
      -- of, say,
      --
      --   Seq (Deep 3 (Two (Elem 1) (Elem 2)) EmptyT (One (Elem 3)))
      --
      -- we generate
      --
      --   coerceFT (Deep 3 (Two 1 2)) EmptyT (One 3)
      z :: FingerTree a
      z :: FingerTree a
z = FingerTree (Elem a) -> FingerTree a
forall a b. Coercible a b => a -> b
coerce FingerTree (Elem a)
ft

-- | We use this to help the types work out for splices in the
-- Lift instance. Things get a bit yucky otherwise.
coerceFT :: FingerTree a -> Seq a
coerceFT :: forall a. FingerTree a -> Seq a
coerceFT = FingerTree a -> Seq a
forall a b. Coercible a b => a -> b
coerce

#endif

instance Functor Seq where
    fmap :: forall a b. (a -> b) -> Seq a -> Seq b
fmap = (a -> b) -> Seq a -> Seq b
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 = Int -> a -> Seq a
forall a. Int -> a -> Seq a
replicate (Seq b -> Int
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) = FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq ((Elem a -> Elem b) -> FingerTree (Elem a) -> FingerTree (Elem b)
forall a b. (a -> b) -> FingerTree a -> FingerTree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Elem a -> Elem b
forall a b. (a -> b) -> Elem a -> Elem b
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
"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 = (Elem a -> m) -> FingerTree (Elem a) -> m
forall m a. Monoid m => (a -> m) -> FingerTree a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f (a -> m) -> (Elem a -> a) -> Elem a -> m
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Elem a -> a
forall a. Elem a -> a
getElem) (FingerTree (Elem a) -> m)
-> (Seq a -> FingerTree (Elem a)) -> Seq a -> m
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Seq a -> FingerTree (Elem a)
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 = (Elem a -> b -> b) -> b -> FingerTree (Elem a) -> b
forall a b. (a -> b -> b) -> b -> FingerTree a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> b -> b
f (a -> b -> b) -> (Elem a -> a) -> Elem a -> b -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Elem a -> a
forall a. Elem a -> a
getElem) b
z (FingerTree (Elem a) -> b)
-> (Seq a -> FingerTree (Elem a)) -> Seq a -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Seq a -> FingerTree (Elem a)
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 = (b -> Elem a -> b) -> b -> FingerTree (Elem a) -> b
forall b a. (b -> a -> b) -> b -> FingerTree a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (b -> a -> b
f (b -> a -> b) -> (Elem a -> a) -> b -> Elem a -> b
forall c b a d.
Coercible c b =>
(a -> c -> d) -> (b -> c) -> a -> b -> d
.^# Elem a -> a
forall a. Elem a -> a
getElem) b
z (FingerTree (Elem a) -> b)
-> (Seq a -> FingerTree (Elem a)) -> Seq a -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Seq a -> FingerTree (Elem a)
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 = (Elem a -> b -> b) -> b -> FingerTree (Elem a) -> b
forall a b. (a -> b -> b) -> b -> FingerTree a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (a -> b -> b
f (a -> b -> b) -> (Elem a -> a) -> Elem a -> b -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Elem a -> a
forall a. Elem a -> a
getElem) b
z (FingerTree (Elem a) -> b)
-> (Seq a -> FingerTree (Elem a)) -> Seq a -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Seq a -> FingerTree (Elem a)
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 = (b -> Elem a -> b) -> b -> FingerTree (Elem a) -> b
forall b a. (b -> a -> b) -> b -> FingerTree a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (b -> a -> b
f (b -> a -> b) -> (Elem a -> a) -> b -> Elem a -> b
forall c b a d.
Coercible c b =>
(a -> c -> d) -> (b -> c) -> a -> b -> d
.^# Elem a -> a
forall a. Elem a -> a
getElem) b
z (FingerTree (Elem a) -> b)
-> (Seq a -> FingerTree (Elem a)) -> Seq a -> b
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Seq a -> FingerTree (Elem a)
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) = Elem a -> a
forall a. Elem a -> a
getElem ((Elem a -> Elem a -> Elem a) -> FingerTree (Elem a) -> Elem a
forall a. (a -> a -> a) -> FingerTree a -> a
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) = a -> Elem a
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) = Elem a -> a
forall a. Elem a -> a
getElem ((Elem a -> Elem a -> Elem a) -> FingerTree (Elem a) -> Elem a
forall a. (a -> a -> a) -> FingerTree a -> a
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) = a -> Elem a
forall a. a -> Elem a
Elem (a -> a -> a
f a
x a
y)

    length :: forall a. Seq a -> Int
length = Seq a -> Int
forall a. Seq a -> Int
length
    {-# INLINE length #-}
    null :: forall a. Seq a -> Bool
null   = Seq a -> Bool
forall a. Seq a -> Bool
null
    {-# INLINE null #-}

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) = Seq b -> f (Seq b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem b)
forall a. FingerTree a
EmptyT)
    traverse a -> f b
f' (Seq (Single (Elem a
x'))) =
        (\b
x'' -> FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (Elem b -> FingerTree (Elem b)
forall a. a -> FingerTree a
Single (b -> Elem b
forall a. a -> Elem a
Elem b
x''))) (b -> Seq b) -> f b -> f (Seq b)
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')) =
        (Digit (Elem b)
 -> FingerTree (Node (Elem b)) -> Digit (Elem b) -> Seq b)
-> f (Digit (Elem b))
-> f (FingerTree (Node (Elem b)))
-> f (Digit (Elem b))
-> f (Seq b)
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'' -> FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (Int
-> Digit (Elem b)
-> FingerTree (Node (Elem b))
-> Digit (Elem b)
-> FingerTree (Elem b)
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''))
            ((a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
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')
            ((Node (Elem a) -> f (Node (Elem b)))
-> FingerTree (Node (Elem a)) -> f (FingerTree (Node (Elem b)))
forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
traverseTree ((a -> f b) -> Node (Elem a) -> f (Node (Elem b))
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')
            ((a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))
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 = FingerTree (Node b) -> f (FingerTree (Node b))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FingerTree (Node b)
forall a. FingerTree a
EmptyT
        traverseTree Node a -> f (Node b)
f (Single Node a
x) = Node b -> FingerTree (Node b)
forall a. a -> FingerTree a
Single (Node b -> FingerTree (Node b))
-> f (Node b) -> f (FingerTree (Node b))
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) =
            (Digit (Node b)
 -> FingerTree (Node (Node b))
 -> Digit (Node b)
 -> FingerTree (Node b))
-> f (Digit (Node b))
-> f (FingerTree (Node (Node b)))
-> f (Digit (Node b))
-> f (FingerTree (Node b))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
                (Int
-> Digit (Node b)
-> FingerTree (Node (Node b))
-> Digit (Node b)
-> FingerTree (Node b)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s)
                ((Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
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)
                ((Node (Node a) -> f (Node (Node b)))
-> FingerTree (Node (Node a)) -> f (FingerTree (Node (Node b)))
forall (f :: * -> *) a b.
Applicative f =>
(Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
traverseTree ((Node a -> f (Node b)) -> Node (Node a) -> f (Node (Node b))
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)
                ((Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
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' -> Elem b -> Digit (Elem b)
forall a. a -> Digit a
One (b -> Elem b
forall a. a -> Elem a
Elem b
a')) (b -> Digit (Elem b)) -> f b -> f (Digit (Elem b))
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)) =
            (b -> b -> Digit (Elem b)) -> f b -> f b -> f (Digit (Elem b))
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
                (\b
a' b
b' -> Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> Digit a
Two (b -> Elem b
forall a. a -> Elem a
Elem b
a') (b -> Elem b
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)) =
            (b -> b -> b -> Digit (Elem b))
-> f b -> f b -> f b -> f (Digit (Elem b))
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' ->
                      Elem b -> Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> a -> Digit a
Three (b -> Elem b
forall a. a -> Elem a
Elem b
a') (b -> Elem b
forall a. a -> Elem a
Elem b
b') (b -> Elem 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)) =
            (b -> b -> b -> b -> Digit (Elem b))
-> f b -> f b -> f b -> f (b -> Digit (Elem b))
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' -> Elem b -> Elem b -> Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> a -> a -> Digit a
Four (b -> Elem b
forall a. a -> Elem a
Elem b
a') (b -> Elem b
forall a. a -> Elem a
Elem b
b') (b -> Elem b
forall a. a -> Elem a
Elem b
c') (b -> Elem b
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) f (b -> Digit (Elem b)) -> f b -> f (Digit (Elem b))
forall a b. f (a -> b) -> f a -> f b
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 = (Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Digit a -> f (Digit 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)) =
            (b -> b -> Node (Elem b)) -> f b -> f b -> f (Node (Elem b))
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
                (\b
a' b
b' -> Int -> Elem b -> Elem b -> Node (Elem b)
forall a. Int -> a -> a -> Node a
Node2 Int
s (b -> Elem b
forall a. a -> Elem a
Elem b
a') (b -> Elem b
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)) =
            (b -> b -> b -> Node (Elem b))
-> f b -> f b -> f b -> f (Node (Elem b))
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' ->
                      Int -> Elem b -> Elem b -> Elem b -> Node (Elem b)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
s (b -> Elem b
forall a. a -> Elem a
Elem b
a') (b -> Elem b
forall a. a -> Elem a
Elem b
b') (b -> Elem 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 = (Node a -> f (Node b)) -> Node (Node a) -> f (Node (Node b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node a -> f (Node 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) = FingerTree (Elem a) -> ()
forall a. NFData a => a -> ()
rnf FingerTree (Elem a)
xs

instance Monad Seq where
    return :: forall a. a -> Seq a
return = a -> Seq a
forall a. a -> Seq a
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 = (Seq b -> a -> Seq b) -> Seq b -> Seq a -> Seq b
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Seq b -> a -> Seq b
add Seq b
forall a. Seq a
empty Seq a
xs
      where add :: Seq b -> a -> Seq b
add Seq b
ys a
x = Seq b
ys Seq b -> Seq b -> Seq b
forall a. Seq a -> Seq a -> Seq a
>< a -> Seq b
f a
x
    >> :: forall a b. Seq a -> Seq b -> Seq b
(>>) = Seq a -> Seq b -> Seq b
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 = (a -> Seq a) -> Seq a
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 = Int -> (Int -> a) -> Seq a
forall a. Int -> (Int -> a) -> Seq a
fromFunction (Seq a -> Int
forall a. Seq a -> Int
length (a -> Seq a
f a
forall {a}. a
err)) (\Int
k -> (a -> a) -> a
forall a. (a -> a) -> a
fix (\a
xk -> a -> Seq a
f a
xk Seq a -> Int -> a
forall a. Seq a -> Int -> a
`index` Int
k))
  where
    err :: a
err = [Char] -> a
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 = a -> Seq a
forall a. a -> Seq a
singleton
    Seq a
xs *> :: forall a b. Seq a -> Seq b -> Seq b
*> Seq b
ys = Int -> Seq b -> Seq b
forall a. Int -> Seq a -> Seq a
cycleNTimes (Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs) Seq b
ys
    <*> :: forall a b. Seq (a -> b) -> Seq a -> Seq b
(<*>) = Seq (a -> b) -> Seq a -> Seq b
forall a b. Seq (a -> b) -> Seq a -> Seq b
apSeq
    liftA2 :: forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2 = (a -> b -> c) -> Seq a -> Seq b -> Seq c
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
liftA2Seq
    Seq a
xs <* :: forall a b. Seq a -> Seq b -> Seq a
<* Seq b
ys = Seq a -> Seq b -> Seq a
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 Seq (a -> b) -> ViewL (a -> b)
forall a. Seq a -> ViewL a
viewl Seq (a -> b)
fs of
  ViewL (a -> b)
EmptyL -> Seq b
forall a. Seq a
empty
  a -> b
firstf :< Seq (a -> b)
fs' -> case Seq (a -> b) -> ViewR (a -> b)
forall a. Seq a -> ViewR a
viewr Seq (a -> b)
fs' of
    ViewR (a -> b)
EmptyR -> (a -> b) -> Seq a -> Seq b
forall a b. (a -> b) -> Seq a -> Seq b
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 FingerTree (Elem a) -> Rigidified (Elem a)
forall a. FingerTree (Elem a) -> Rigidified (Elem a)
rigidify FingerTree (Elem a)
xsFT of
         Rigidified (Elem a)
RigidEmpty -> Seq b
forall a. Seq a
empty
         RigidOne (Elem a
x) -> ((a -> b) -> b) -> Seq (a -> b) -> Seq b
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
x) Seq (a -> b)
fs
         RigidTwo (Elem a
x1) (Elem a
x2) ->
            FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem b) -> Seq b) -> FingerTree (Elem b) -> Seq b
forall a b. (a -> b) -> a -> b
$ (a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a)
-> FingerTree (Elem 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) ->
            FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem b) -> Seq b) -> FingerTree (Elem b) -> Seq b
forall a b. (a -> b) -> a -> b
$ (a -> b)
-> FingerTree (Elem (a -> b))
-> (a -> b)
-> (a, a, a)
-> FingerTree (Elem 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) -> FingerTree (Elem b) -> Seq b
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem b) -> Seq b) -> FingerTree (Elem b) -> Seq b
forall a b. (a -> b) -> a -> b
$
               Int
-> Digit (Elem b)
-> FingerTree (Node (Elem b))
-> Digit (Elem b)
-> FingerTree (Elem b)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* Seq (a -> b) -> Int
forall a. Seq a -> Int
length Seq (a -> b)
fs)
                    ((Elem a -> Elem b) -> Digit (Elem a) -> Digit (Elem b)
forall a b. (a -> b) -> Digit a -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Elem a -> Elem b
forall a b. (a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
firstf) (Digit23 (Elem a) -> Digit (Elem a)
forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem a)
pr))
                    ((Elem a -> Elem b)
-> (Elem a -> Elem b)
-> ((a -> b) -> Elem a -> Elem b)
-> FingerTree (Elem (a -> b))
-> Rigid (Elem a)
-> FingerTree (Node (Elem b))
forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
liftA2Middle ((a -> b) -> Elem a -> Elem b
forall a b. (a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
firstf) ((a -> b) -> Elem a -> Elem b
forall a b. (a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
lastf) (a -> b) -> Elem a -> Elem b
forall a b. (a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FingerTree (Elem (a -> b))
fs''FT Rigid (Elem a)
r)
                    ((Elem a -> Elem b) -> Digit (Elem a) -> Digit (Elem b)
forall a b. (a -> b) -> Digit a -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Elem a -> Elem b
forall a b. (a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
lastf) (Digit23 (Elem a) -> Digit (Elem a)
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) =
                 Int
-> Digit (Elem b)
-> FingerTree (Node (Elem b))
-> Digit (Elem b)
-> FingerTree (Elem b)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (FingerTree (Elem (a -> b)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem (a -> b))
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
                      (Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> Digit a
Two (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
x) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
y))
                      (Int
-> (Elem (a -> b) -> Node (Elem b))
-> FingerTree (Elem (a -> b))
-> FingerTree (Node (Elem b))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
2 (\(Elem a -> b
f) -> Int -> Elem b -> Elem b -> Node (Elem b)
forall a. Int -> a -> a -> Node a
Node2 Int
2 (b -> Elem b
forall a. a -> Elem a
Elem (a -> b
f a
x)) (b -> Elem b
forall a. a -> Elem a
Elem (a -> b
f a
y))) FingerTree (Elem (a -> b))
fs)
                      (Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> Digit a
Two (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
x) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
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) = Int
-> Digit (Elem b)
-> FingerTree (Node (Elem b))
-> Digit (Elem b)
-> FingerTree (Elem b)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (FingerTree (Elem (a -> b)) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem (a -> b))
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6)
                        (Elem b -> Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> a -> Digit a
Three (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
x) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
y) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
firstf a
z))
                        (Int
-> (Elem (a -> b) -> Node (Elem b))
-> FingerTree (Elem (a -> b))
-> FingerTree (Node (Elem b))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
3 (\(Elem a -> b
f) -> Int -> Elem b -> Elem b -> Elem b -> Node (Elem b)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 (b -> Elem b
forall a. a -> Elem a
Elem (a -> b
f a
x)) (b -> Elem b
forall a. a -> Elem a
Elem (a -> b
f a
y)) (b -> Elem b
forall a. a -> Elem a
Elem (a -> b
f a
z))) FingerTree (Elem (a -> b))
fs)
                        (Elem b -> Elem b -> Elem b -> Digit (Elem b)
forall a. a -> a -> a -> Digit a
Three (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
x) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
forall a b. (a -> b) -> a -> b
$ a -> b
lastf a
y) (b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> b -> Elem b
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) =
                 Int
-> Digit (Elem c)
-> FingerTree (Node (Elem c))
-> Digit (Elem c)
-> FingerTree (Elem c)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
                      (Elem c -> Elem c -> Digit (Elem c)
forall a. a -> a -> Digit a
Two (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y1) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y2))
                      (Int
-> (Elem a -> Node (Elem c))
-> FingerTree (Elem a)
-> FingerTree (Node (Elem c))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
2 (\(Elem a
x) -> Int -> Elem c -> Elem c -> Node (Elem c)
forall a. Int -> a -> a -> Node a
Node2 Int
2 (c -> Elem c
forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y1)) (c -> Elem c
forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y2))) FingerTree (Elem a)
xs)
                      (Elem c -> Elem c -> Digit (Elem c)
forall a. a -> a -> Digit a
Two (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y1) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
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) =
                 Int
-> Digit (Elem c)
-> FingerTree (Node (Elem c))
-> Digit (Elem c)
-> FingerTree (Elem c)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6)
                      (Elem c -> Elem c -> Elem c -> Digit (Elem c)
forall a. a -> a -> a -> Digit a
Three (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y1) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y2) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
firstx b
y3))
                      (Int
-> (Elem a -> Node (Elem c))
-> FingerTree (Elem a)
-> FingerTree (Node (Elem c))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
3 (\(Elem a
x) -> Int -> Elem c -> Elem c -> Elem c -> Node (Elem c)
forall a. Int -> a -> a -> a -> Node a
Node3 Int
3 (c -> Elem c
forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y1)) (c -> Elem c
forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y2)) (c -> Elem c
forall a. a -> Elem a
Elem (a -> b -> c
f a
x b
y3))) FingerTree (Elem a)
xs)
                      (Elem c -> Elem c -> Elem c -> Digit (Elem c)
forall a. a -> a -> a -> Digit a
Three (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y1) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
lastx b
y2) (c -> Elem c
forall a. a -> Elem a
Elem (c -> Elem c) -> c -> Elem c
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 Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
xs of
  ViewL a
EmptyL -> Seq c
forall a. Seq a
empty
  a
firstx :< Seq a
xs' -> case Seq a -> ViewR a
forall a. Seq a -> ViewR a
viewr Seq a
xs' of
    ViewR a
EmptyR -> a -> b -> c
f a
firstx (b -> c) -> Seq b -> Seq c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq b
ys
    Seq FingerTree (Elem a)
xs''FT :> a
lastx -> case FingerTree (Elem b) -> Rigidified (Elem b)
forall a. FingerTree (Elem a) -> Rigidified (Elem a)
rigidify FingerTree (Elem b)
ysFT of
      Rigidified (Elem b)
RigidEmpty -> Seq c
forall a. Seq a
empty
      RigidOne (Elem b
y) -> (a -> c) -> Seq a -> Seq c
forall a b. (a -> b) -> Seq a -> Seq b
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) ->
        FingerTree (Elem c) -> Seq c
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem c) -> Seq c) -> FingerTree (Elem c) -> Seq c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c)
-> a -> FingerTree (Elem a) -> a -> (b, b) -> FingerTree (Elem c)
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) ->
        FingerTree (Elem c) -> Seq c
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem c) -> Seq c) -> FingerTree (Elem c) -> Seq c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c)
-> a
-> FingerTree (Elem a)
-> a
-> (b, b, b)
-> FingerTree (Elem c)
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) -> FingerTree (Elem c) -> Seq c
forall a. FingerTree (Elem a) -> Seq a
Seq (FingerTree (Elem c) -> Seq c) -> FingerTree (Elem c) -> Seq c
forall a b. (a -> b) -> a -> b
$
        Int
-> Digit (Elem c)
-> FingerTree (Node (Elem c))
-> Digit (Elem c)
-> FingerTree (Elem c)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs)
             ((Elem b -> Elem c) -> Digit (Elem b) -> Digit (Elem c)
forall a b. (a -> b) -> Digit a -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> c) -> Elem b -> Elem c
forall a b. (a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
firstx)) (Digit23 (Elem b) -> Digit (Elem b)
forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem b)
pr))
             ((Elem b -> Elem c)
-> (Elem b -> Elem c)
-> (a -> Elem b -> Elem c)
-> FingerTree (Elem a)
-> Rigid (Elem b)
-> FingerTree (Node (Elem c))
forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
liftA2Middle ((b -> c) -> Elem b -> Elem c
forall a b. (a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
firstx)) ((b -> c) -> Elem b -> Elem c
forall a b. (a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
lastx)) ((a -> b -> c) -> a -> Elem b -> Elem c
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)
             ((Elem b -> Elem c) -> Digit (Elem b) -> Digit (Elem c)
forall a b. (a -> b) -> Digit a -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> c) -> Elem b -> Elem c
forall a b. (a -> b) -> Elem a -> Elem b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
lastx)) (Digit23 (Elem b) -> Digit (Elem b)
forall a. Node a -> Digit a
nodeToDigit Digit23 (Elem b)
sf))
  where
    lift_elem :: (a -> b -> c) -> a -> Elem b -> Elem c
#ifdef __GLASGOW_HASKELL__
    lift_elem :: forall a b c. (a -> b -> c) -> a -> Elem b -> Elem c
lift_elem = (a -> b -> c) -> a -> Elem b -> Elem c
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
    = Int
-> Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
sm Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
midxs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) -- note: sm = s - size pr - size sf
           ((Digit23 b -> Node c) -> Digit (Digit23 b) -> Digit (Node c)
forall a b. (a -> b) -> Digit a -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> c) -> Digit23 b -> Node c
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
ffirstx) (Digit12 (Digit23 b) -> Digit (Digit23 b)
forall a. Digit12 a -> Digit a
digit12ToDigit Digit12 (Digit23 b)
prm))
           ((Digit23 b -> Node c)
-> (Digit23 b -> Node c)
-> (a -> Digit23 b -> Node c)
-> FingerTree (Elem a)
-> Rigid (Digit23 b)
-> FingerTree (Node (Node c))
forall b c a.
(b -> c)
-> (b -> c)
-> (a -> b -> c)
-> FingerTree (Elem a)
-> Rigid b
-> FingerTree (Node c)
liftA2Middle
               ((b -> c) -> Digit23 b -> Node c
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
ffirstx)
               ((b -> c) -> Digit23 b -> Node c
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
flastx)
               ((b -> c) -> Digit23 b -> Node c
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> c) -> Digit23 b -> Node c)
-> (a -> b -> c) -> a -> Digit23 b -> Node c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c
f)
               FingerTree (Elem a)
midxs
               (Int
-> Node (Digit23 b)
-> Thin (Node (Digit23 b))
-> Node (Digit23 b)
-> Rigid (Digit23 b)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (Digit23 b -> Digit12 (Digit23 b) -> Node (Digit23 b)
forall a. Digit23 a -> Digit12 (Digit23 a) -> Digit23 (Digit23 a)
squashL Digit23 b
pr Digit12 (Digit23 b)
prm) Thin (Node (Digit23 b))
mm (Digit12 (Digit23 b) -> Digit23 b -> Node (Digit23 b)
forall a. Digit12 (Node a) -> Node a -> Digit23 (Node a)
squashR Digit12 (Digit23 b)
sfm Digit23 b
sf)))
           ((Digit23 b -> Node c) -> Digit (Digit23 b) -> Digit (Node c)
forall a b. (a -> b) -> Digit a -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> c) -> Digit23 b -> Node c
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
flastx) (Digit12 (Digit23 b) -> Digit (Digit23 b)
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)
    = Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep
           (Node c -> Digit (Node c)
forall a. a -> Digit a
One ((b -> c) -> Digit23 b -> Node c
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
ffirstx Digit23 b
sf))
           (Int
-> (Elem a -> Node (Node c))
-> FingerTree (Elem a)
-> FingerTree (Node (Node c))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
s (\(Elem a
x) -> (Digit23 b -> Node c) -> Node (Digit23 b) -> Node (Node c)
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> c) -> Digit23 b -> Node c
forall a b. (a -> b) -> Node a -> Node b
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)
           (Node c -> Digit (Node c)
forall a. a -> Digit a
One ((b -> c) -> Digit23 b -> Node c
forall a b. (a -> b) -> Node a -> Node b
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 = Digit23 b -> Digit23 b -> Node (Digit23 b)
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)
    = Digit (Node c)
-> FingerTree (Node (Node c))
-> Digit (Node c)
-> FingerTree (Node c)
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep
           (Node c -> Node c -> Digit (Node c)
forall a. a -> a -> Digit a
Two ((b -> c) -> Digit23 b -> Node c
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
ffirstx Digit23 b
q) ((b -> c) -> Digit23 b -> Node c
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
ffirstx Digit23 b
sf))
           (Int
-> (Elem a -> Node (Node c))
-> FingerTree (Elem a)
-> FingerTree (Node (Node c))
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
s (\(Elem a
x) -> (Digit23 b -> Node c) -> Node (Digit23 b) -> Node (Node c)
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> c) -> Digit23 b -> Node c
forall a b. (a -> b) -> Node a -> Node b
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)
           (Node c -> Node c -> Digit (Node c)
forall a. a -> a -> Digit a
Two ((b -> c) -> Digit23 b -> Node c
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
flastx Digit23 b
pr) ((b -> c) -> Digit23 b -> Node c
forall a b. (a -> b) -> Node a -> Node b
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 = Digit23 b -> Digit23 b -> Digit23 b -> Node (Digit23 b)
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) = a -> Digit a
forall a. a -> Digit a
One a
a
digit12ToDigit (Two12 a
a a
b) = a -> a -> Digit a
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) = Node a -> Node a -> Node (Node a)
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) = Node a -> Node a -> Node a -> Node (Node a)
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 = Node a -> Node a -> Node (Node a)
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 = Node a -> Node a -> Node a -> Node (Node a)
forall a. Sized a => a -> a -> a -> Node a
node3 Node a
n1 Node a
n2 Node a
m


-- | \(O(mn)\) (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 = FingerTree b
forall a. FingerTree a
EmptyT
mapMulFT Int
_mul a -> b
f (Single a
a) = b -> FingerTree b
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) = Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Int
mul Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) ((a -> b) -> Digit a -> Digit b
forall a b. (a -> b) -> Digit a -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Digit a
pr) (Int
-> (Node a -> Node b) -> FingerTree (Node a) -> FingerTree (Node b)
forall a b. Int -> (a -> b) -> FingerTree a -> FingerTree b
mapMulFT Int
mul (Int -> (a -> b) -> Node a -> Node b
forall a b. Int -> (a -> b) -> Node a -> Node b
mapMulNode Int
mul a -> b
f) FingerTree (Node a)
m) ((a -> b) -> Digit a -> Digit b
forall a b. (a -> b) -> Digit a -> Digit b
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)   = Int -> b -> b -> Node b
forall a. Int -> a -> a -> Node a
Node2 (Int
mul Int -> Int -> Int
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) = Int -> b -> b -> b -> Node b
forall a. Int -> a -> a -> a -> Node a
Node3 (Int
mul Int -> Int -> Int
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 = Rigidified (Elem a)
forall a. Rigidified a
RigidEmpty

rigidify (Single Elem a
q) = Elem a -> Rigidified (Elem a)
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) = Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (Elem a -> Elem a -> Node (Elem a)
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) = Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (Elem a -> Elem a -> Elem a -> Node (Elem a)
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) = Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d Node (Elem a)
-> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
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 FingerTree (Node (Elem a)) -> ViewLTree (Node (Elem a))
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' -> Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (Elem a -> Elem a -> Elem a -> Node (Elem a)
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' -> Int
-> Node (Elem a)
-> FingerTree (Node (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
forall a.
Int
-> Digit23 (Elem a)
-> FingerTree (Digit23 (Elem a))
-> Digit (Elem a)
-> Rigidified (Elem a)
rigidifyRight Int
s (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
c Elem a
d Node (Elem a)
-> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
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 -> Elem a -> Elem a -> Rigidified (Elem a)
forall a. a -> a -> Rigidified a
RigidTwo Elem a
a Elem a
b
     Two Elem a
b Elem a
c -> Elem a -> Elem a -> Elem a -> Rigidified (Elem a)
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 -> Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Node (Elem a)
-> Thin (Node (Elem a))
-> Node (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) Thin (Node (Elem a))
forall a. Thin a
EmptyTh (Elem a -> Elem a -> Node (Elem a)
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 -> Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Node (Elem a)
-> Thin (Node (Elem a))
-> Node (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (Elem a -> Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> a -> Node a
node3 Elem a
a Elem a
b Elem a
c) Thin (Node (Elem a))
forall a. Thin a
EmptyTh (Elem a -> Elem a -> Node (Elem a)
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) = Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Node (Elem a)
-> Thin (Node (Elem a))
-> Node (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Node (Elem a)
pr (FingerTree (Node (Elem a)) -> Thin (Node (Elem a))
forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node (Elem a))
m) (Elem a -> Elem a -> Node (Elem a)
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) = Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Node (Elem a)
-> Thin (Node (Elem a))
-> Node (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Node (Elem a)
pr (FingerTree (Node (Elem a)) -> Thin (Node (Elem a))
forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node (Elem a))
m) (Elem a -> Elem a -> Elem a -> Node (Elem a)
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) = Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Node (Elem a)
-> Thin (Node (Elem a))
-> Node (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Node (Elem a)
pr (FingerTree (Node (Elem a)) -> Thin (Node (Elem a))
forall a. Sized a => FingerTree a -> Thin a
thin (FingerTree (Node (Elem a)) -> Thin (Node (Elem a)))
-> FingerTree (Node (Elem a)) -> Thin (Node (Elem a))
forall a b. (a -> b) -> a -> b
$ FingerTree (Node (Elem a))
m FingerTree (Node (Elem a))
-> Node (Elem a) -> FingerTree (Node (Elem a))
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (Elem a -> Elem a -> Node (Elem a)
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 FingerTree (Node (Elem a)) -> ViewRTree (Node (Elem a))
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) -> Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Node (Elem a)
-> Thin (Node (Elem a))
-> Node (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Node (Elem a)
pr (FingerTree (Node (Elem a)) -> Thin (Node (Elem a))
forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node (Elem a))
m') (Elem a -> Elem a -> Elem a -> Node (Elem a)
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) -> Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Node (Elem a)
-> Thin (Node (Elem a))
-> Node (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s Node (Elem a)
pr (FingerTree (Node (Elem a)) -> Thin (Node (Elem a))
forall a. Sized a => FingerTree a -> Thin a
thin (FingerTree (Node (Elem a)) -> Thin (Node (Elem a)))
-> FingerTree (Node (Elem a)) -> Thin (Node (Elem a))
forall a b. (a -> b) -> a -> b
$ FingerTree (Node (Elem a))
m' FingerTree (Node (Elem a))
-> Node (Elem a) -> FingerTree (Node (Elem a))
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) (Elem a -> Elem a -> Node (Elem a)
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 -> Elem a -> Elem a -> Elem a -> Rigidified (Elem a)
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 -> Rigid (Elem a) -> Rigidified (Elem a)
forall a. Rigid a -> Rigidified a
RigidFull (Rigid (Elem a) -> Rigidified (Elem a))
-> Rigid (Elem a) -> Rigidified (Elem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Node (Elem a)
-> Thin (Node (Elem a))
-> Node (Elem a)
-> Rigid (Elem a)
forall a.
Int -> Digit23 a -> Thin (Digit23 a) -> Digit23 a -> Rigid a
Rigid Int
s (Elem a -> Elem a -> Node (Elem a)
forall a. Sized a => a -> a -> Node a
node2 Elem a
a Elem a
b) Thin (Node (Elem a))
forall a. Thin a
EmptyTh (Elem a -> Elem a -> Node (Elem a)
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 = Thin a
forall a. Thin a
EmptyTh
thin (Single a
a) = a -> Thin 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 -> Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s (a -> Digit12 a
forall a. a -> Digit12 a
One12 a
a) FingerTree (Node a)
m Digit a
sf
    Two a
a a
b -> Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s (a -> a -> Digit12 a
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  -> Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s (a -> Digit12 a
forall a. a -> Digit12 a
One12 a
a) (a -> a -> Node a
forall a. Sized a => a -> a -> Node a
node2 a
b a
c Node a -> FingerTree (Node a) -> FingerTree (Node a)
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 -> Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
forall a.
Sized a =>
Int -> Digit12 a -> FingerTree (Node a) -> Digit a -> Thin a
thin12 Int
s (a -> a -> Digit12 a
forall a. a -> a -> Digit12 a
Two12 a
a a
b) (a -> a -> Node a
forall a. Sized a => a -> a -> Node a
node2 a
c a
d Node a -> FingerTree (Node a) -> FingerTree (Node a)
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) = Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (FingerTree (Node a) -> Thin (Node a)
forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node a)
m) (a -> Digit12 a
forall a. a -> Digit12 a
One12 a
a)
thin12 Int
s Digit12 a
pr FingerTree (Node a)
m (Two a
a a
b) = Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (FingerTree (Node a) -> Thin (Node a)
forall a. Sized a => FingerTree a -> Thin a
thin FingerTree (Node a)
m) (a -> a -> Digit12 a
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) = Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (FingerTree (Node a) -> Thin (Node a)
forall a. Sized a => FingerTree a -> Thin a
thin (FingerTree (Node a) -> Thin (Node a))
-> FingerTree (Node a) -> Thin (Node a)
forall a b. (a -> b) -> a -> b
$ FingerTree (Node a)
m FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` a -> a -> Node a
forall a. Sized a => a -> a -> Node a
node2 a
a a
b) (a -> Digit12 a
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) = Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
forall a. Int -> Digit12 a -> Thin (Node a) -> Digit12 a -> Thin a
DeepTh Int
s Digit12 a
pr (FingerTree (Node a) -> Thin (Node a)
forall a. Sized a => FingerTree a -> Thin a
thin (FingerTree (Node a) -> Thin (Node a))
-> FingerTree (Node a) -> Thin (Node a)
forall a b. (a -> b) -> a -> b
$ FingerTree (Node a)
m FingerTree (Node a) -> Node a -> FingerTree (Node a)
forall a. Sized a => FingerTree a -> a -> FingerTree a
`snocTree` a -> a -> Node a
forall a. Sized a => a -> a -> Node a
node2 a
a a
b) (a -> a -> Digit12 a
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 Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
xs of
  ViewL a
EmptyL -> Seq a
forall a. Seq a
empty
  a
p :< Seq a
ps -> a
p a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| (Seq a
ps Seq a -> Seq (a -> a) -> Seq a
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> (a -> a -> a
forall a b. a -> b -> a
const a
y (a -> a) -> Seq (a -> a) -> Seq (a -> a)
forall a. a -> Seq a -> Seq a
<| (a -> a) -> Seq (a -> a)
forall a. a -> Seq a
singleton a -> a
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 = Seq a
forall a. Seq a
empty
    mplus :: forall a. Seq a -> Seq a -> Seq a
mplus = Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
(><)

-- | @since 0.5.4
instance Alternative Seq where
    empty :: forall a. Seq a
empty = Seq a
forall a. Seq a
empty
    <|> :: forall a. Seq a -> Seq a -> Seq 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 = Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Seq a -> Int
forall a. Seq a -> Int
length Seq a
ys Bool -> Bool -> Bool
&& Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== Seq a -> [a]
forall a. Seq a -> [a]
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 = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs) (Seq a -> [a]
forall a. Seq a -> [a]
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        [Char] -> ShowS
showString [Char]
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
forall a. Show a => a -> ShowS
shows (Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs)
#endif

-- | @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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        [Char] -> ShowS
showString [Char]
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
shwList (Seq a -> [a]
forall a. Seq a -> [a]
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 = Seq a -> Int
forall a. Seq a -> Int
length Seq a
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Seq b -> Int
forall a. Seq a -> Int
length Seq b
ys Bool -> Bool -> Bool
&& (a -> b -> Bool) -> [a] -> [b] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq (Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs) (Seq b -> [b]
forall a. Seq a -> [a]
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 = (a -> b -> Ordering) -> [a] -> [b] -> Ordering
forall a b. (a -> b -> Ordering) -> [a] -> [b] -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp (Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs) (Seq b -> [b]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq b
ys)

instance Read a => Read (Seq a) where
#ifdef __GLASGOW_HASKELL__
    readPrec :: ReadPrec (Seq a)
readPrec = ReadPrec (Seq a) -> ReadPrec (Seq a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (Seq a) -> ReadPrec (Seq a))
-> ReadPrec (Seq a) -> ReadPrec (Seq a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Seq a) -> ReadPrec (Seq a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (Seq a) -> ReadPrec (Seq a))
-> ReadPrec (Seq a) -> ReadPrec (Seq a)
forall a b. (a -> b) -> a -> b
$ do
        Ident "fromList" <- ReadPrec Lexeme
lexP
        xs <- readPrec
        return (fromList xs)

    readListPrec :: ReadPrec [Seq a]
readListPrec = ReadPrec [Seq a]
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

-- | @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 = Bool -> ReadS (Seq a) -> ReadS (Seq a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (Seq a) -> ReadS (Seq a)) -> ReadS (Seq a) -> ReadS (Seq a)
forall a b. (a -> b) -> a -> b
$ \[Char]
r -> do
    ("fromList",s) <- ReadS [Char]
lex [Char]
r
    (xs,t) <- readLst s
    pure (fromList xs, t)

instance Monoid (Seq a) where
    mempty :: Seq a
mempty = Seq a
forall a. Seq a
empty
    mappend :: Seq a -> Seq a -> Seq a
mappend = Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)

-- | @since 0.5.7
instance Semigroup.Semigroup (Seq a) where
    <> :: Seq a -> Seq a -> Seq a
(<>)    = 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 = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
cycleNTimes (Int -> Seq a -> Seq a) -> (b -> Int) -> b -> Seq a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

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

    toConstr :: Seq a -> Constr
toConstr Seq a
xs
      | Seq a -> Bool
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     = c (t a) -> Maybe (c (Seq a))
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 c (t a)
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)

-- | @since 0.6.6
deriving instance TH.Lift a => TH.Lift (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)         = a -> Int
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 = m
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') =
        (a -> m) -> Digit a -> m
forall m a. Monoid m => (a -> m) -> Digit a -> m
foldMapDigit a -> m
f' Digit a
pr' m -> m -> m
forall m. Monoid m => m -> m -> m
<>
        (Node a -> m) -> FingerTree (Node a) -> m
forall m a. Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
foldMapTree ((a -> m) -> Node a -> m
forall m a. Monoid m => (a -> m) -> Node a -> m
foldMapNode a -> m
f') FingerTree (Node a)
m' m -> m -> m
forall m. Monoid m => m -> m -> m
<>
        (a -> m) -> Digit a -> 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 = m
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) =
            (Node a -> m) -> Digit (Node a) -> m
forall m a. Monoid m => (Node a -> m) -> Digit (Node a) -> m
foldMapDigitN Node a -> m
f Digit (Node a)
pr m -> m -> m
forall m. Monoid m => m -> m -> m
<>
            (Node (Node a) -> m) -> FingerTree (Node (Node a)) -> m
forall m a. Monoid m => (Node a -> m) -> FingerTree (Node a) -> m
foldMapTree ((Node a -> m) -> Node (Node a) -> m
forall m a. Monoid m => (Node a -> m) -> Node (Node a) -> m
foldMapNodeN Node a -> m
f) FingerTree (Node (Node a))
m m -> m -> m
forall m. Monoid m => m -> m -> m
<>
            (Node a -> m) -> Digit (Node a) -> 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 = (m -> m -> m) -> (a -> m) -> Digit a -> m
forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit m -> m -> m
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 = (m -> m -> m) -> (Node a -> m) -> Digit (Node a) -> m
forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit m -> m -> m
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 = (m -> m -> m) -> (a -> m) -> Node a -> m
forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode m -> m -> m
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 = (m -> m -> m) -> (Node a -> m) -> Node (Node a) -> m
forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode m -> m -> m
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') =
        (a -> b -> b) -> b -> Digit a -> b
forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit a -> b -> b
f' ((Node a -> b -> b) -> b -> FingerTree (Node a) -> b
forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree ((a -> b -> b) -> Node a -> b -> b
forall a b. (a -> b -> b) -> Node a -> b -> b
foldrNode a -> b -> b
f') ((a -> b -> b) -> b -> Digit 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
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) =
            (Node a -> b -> b) -> b -> Digit (Node a) -> b
forall a b. (Node a -> b -> b) -> b -> Digit (Node a) -> b
foldrDigitN Node a -> b -> b
f ((Node (Node a) -> b -> b) -> b -> FingerTree (Node (Node a)) -> b
forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree ((Node a -> b -> b) -> Node (Node a) -> b -> b
forall a b. (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN Node a -> b -> b
f) ((Node a -> b -> b) -> b -> Digit (Node a) -> b
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 = (a -> b -> b) -> b -> Digit a -> b
forall a b. (a -> b -> b) -> b -> Digit a -> b
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 = (Node a -> b -> b) -> b -> Digit (Node a) -> b
forall a b. (a -> b -> b) -> b -> Digit a -> b
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 = (a -> b -> b) -> b -> Node a -> b
forall a b. (a -> b -> b) -> b -> Node a -> b
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 = (Node a -> b -> b) -> b -> Node (Node a) -> b
forall a b. (a -> b -> b) -> b -> Node a -> b
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') =
        (b -> a -> b) -> b -> Digit a -> b
forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit b -> a -> b
f' ((b -> Node a -> b) -> b -> FingerTree (Node a) -> b
forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree ((b -> a -> b) -> b -> Node a -> b
forall b a. (b -> a -> b) -> b -> Node a -> b
foldlNode b -> a -> b
f') ((b -> a -> b) -> b -> Digit 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
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) =
            (b -> Node a -> b) -> b -> Digit (Node a) -> b
forall b a. (b -> Node a -> b) -> b -> Digit (Node a) -> b
foldlDigitN b -> Node a -> b
f ((b -> Node (Node a) -> b) -> b -> FingerTree (Node (Node a)) -> b
forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree ((b -> Node a -> b) -> b -> Node (Node a) -> b
forall b a. (b -> Node a -> b) -> b -> Node (Node a) -> b
foldlNodeN b -> Node a -> b
f) ((b -> Node a -> b) -> b -> Digit (Node a) -> b
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 = (b -> a -> b) -> b -> Digit a -> b
forall b a. (b -> a -> b) -> b -> Digit a -> b
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 = (b -> Node a -> b) -> b -> Digit (Node a) -> b
forall b a. (b -> a -> b) -> b -> Digit 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)
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 = (b -> a -> b) -> b -> Node a -> b
forall b a. (b -> a -> b) -> b -> Node a -> b
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 = (b -> Node a -> b) -> b -> Node (Node a) -> b
forall b a. (b -> a -> b) -> b -> Node a -> b
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') =
        ((a -> b -> b) -> b -> Digit a -> b
forall a b. (a -> b -> b) -> b -> Digit a -> b
foldrDigit' a -> b -> b
f' (b -> Digit a -> b) -> b -> Digit a -> b
forall a b. (a -> b) -> a -> b
$! ((Node a -> b -> b) -> b -> FingerTree (Node a) -> b
forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree' ((a -> b -> b) -> Node a -> b -> b
forall a b. (a -> b -> b) -> Node a -> b -> b
foldrNode' a -> b -> b
f') (b -> FingerTree (Node a) -> b) -> b -> FingerTree (Node a) -> b
forall a b. (a -> b) -> a -> b
$! ((a -> b -> b) -> b -> Digit 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 (b -> b) -> b -> b
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) =
            ((Node a -> b -> b) -> b -> Digit (Node a) -> b
forall a b. (a -> b -> b) -> b -> Digit a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' Node a -> b -> b
f (b -> Digit (Node a) -> b) -> b -> Digit (Node a) -> b
forall a b. (a -> b) -> a -> b
$! ((Node (Node a) -> b -> b) -> b -> FingerTree (Node (Node a)) -> b
forall a b. (Node a -> b -> b) -> b -> FingerTree (Node a) -> b
foldrTree' ((Node a -> b -> b) -> Node (Node a) -> b -> b
forall a b. (Node a -> b -> b) -> Node (Node a) -> b -> b
foldrNodeN' Node a -> b -> b
f) (b -> FingerTree (Node (Node a)) -> b)
-> b -> FingerTree (Node (Node a)) -> b
forall a b. (a -> b) -> a -> b
$! ((Node a -> b -> b) -> b -> Digit (Node a) -> b
forall a b. (a -> b -> b) -> b -> Digit a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' Node a -> b -> b
f (b -> Digit (Node a) -> b) -> b -> Digit (Node a) -> b
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 = (a -> b -> b) -> b -> Digit a -> b
forall a b. (a -> b -> b) -> b -> Digit a -> b
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 = (a -> b -> b) -> b -> Node a -> b
forall a b. (a -> b -> b) -> b -> Node a -> b
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 = (Node a -> b -> b) -> b -> Node (Node a) -> b
forall a b. (a -> b -> b) -> b -> Node a -> b
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') =
        ((b -> a -> b) -> b -> Digit a -> b
forall b a. (b -> a -> b) -> b -> Digit a -> b
foldlDigit' b -> a -> b
f' (b -> Digit a -> b) -> b -> Digit a -> b
forall a b. (a -> b) -> a -> b
$!
         ((b -> Node a -> b) -> b -> FingerTree (Node a) -> b
forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree' ((b -> a -> b) -> b -> Node a -> b
forall b a. (b -> a -> b) -> b -> Node a -> b
foldlNode' b -> a -> b
f') (b -> FingerTree (Node a) -> b) -> b -> FingerTree (Node a) -> b
forall a b. (a -> b) -> a -> b
$! ((b -> a -> b) -> b -> Digit 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) =
            ((b -> Node a -> b) -> b -> Digit (Node a) -> b
forall b a. (b -> a -> b) -> b -> Digit a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> Node a -> b
f (b -> Digit (Node a) -> b) -> b -> Digit (Node a) -> b
forall a b. (a -> b) -> a -> b
$! ((b -> Node (Node a) -> b) -> b -> FingerTree (Node (Node a)) -> b
forall b a. (b -> Node a -> b) -> b -> FingerTree (Node a) -> b
foldlTree' ((b -> Node a -> b) -> b -> Node (Node a) -> b
forall b a. (b -> a -> b) -> b -> Node a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> Node a -> b
f) (b -> FingerTree (Node (Node a)) -> b)
-> b -> FingerTree (Node (Node a)) -> b
forall a b. (a -> b) -> a -> b
$! (b -> Node a -> b) -> b -> Digit (Node a) -> b
forall b a. (b -> a -> b) -> b -> Digit 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 = (b -> a -> b) -> b -> Digit a -> b
forall b a. (b -> a -> b) -> b -> Digit a -> b
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 = (b -> a -> b) -> b -> Node a -> b
forall b a. (b -> a -> b) -> b -> Node a -> b
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 = [Char] -> a
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) =
        (a -> a -> a) -> a -> Digit a -> a
forall a b. (a -> b -> b) -> b -> Digit a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
f ((Node a -> a -> a) -> a -> FingerTree (Node a) -> a
forall a b. (a -> b -> b) -> b -> FingerTree a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> Node a -> a) -> Node a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> a -> a) -> a -> Node a -> a
forall a b. (a -> b -> b) -> b -> Node a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
f)) ((a -> a -> a) -> Digit a -> a
forall a. (a -> a -> a) -> Digit a -> a
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 = [Char] -> a
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) =
        (a -> a -> a) -> a -> Digit a -> a
forall b a. (b -> a -> b) -> b -> Digit a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
f ((a -> Node a -> a) -> a -> FingerTree (Node a) -> a
forall b a. (b -> a -> b) -> b -> FingerTree a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((a -> a -> a) -> a -> Node a -> a
forall b a. (b -> a -> b) -> b -> Node a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a -> a -> a
f) ((a -> a -> a) -> Digit a -> a
forall a. (a -> a -> a) -> Digit a -> a
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 = FingerTree b
forall a. FingerTree a
EmptyT
    fmap a -> b
f (Single a
x) = b -> FingerTree b
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) =
        Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
v ((a -> b) -> Digit a -> Digit b
forall a b. (a -> b) -> Digit a -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Digit a
pr) ((Node a -> Node b) -> FingerTree (Node a) -> FingerTree (Node b)
forall a b. (a -> b) -> FingerTree a -> FingerTree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Node a -> Node b
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) FingerTree (Node a)
m) ((a -> b) -> Digit a -> Digit b
forall a b. (a -> b) -> Digit a -> Digit b
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 = FingerTree b -> f (FingerTree b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FingerTree b
forall a. FingerTree a
EmptyT
    traverse a -> f b
f (Single a
x) = b -> FingerTree b
forall a. a -> FingerTree a
Single (b -> FingerTree b) -> f b -> f (FingerTree b)
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) =
        (Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b)
-> f (Digit b)
-> f (FingerTree (Node b))
-> f (Digit b)
-> f (FingerTree b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (Int -> Digit b -> FingerTree (Node b) -> Digit b -> FingerTree b
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
v) ((a -> f b) -> Digit a -> f (Digit b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Digit a -> f (Digit b)
traverse a -> f b
f Digit a
pr) ((Node a -> f (Node b))
-> FingerTree (Node a) -> f (FingerTree (Node b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FingerTree a -> f (FingerTree b)
traverse ((a -> f b) -> Node a -> f (Node b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node a -> f (Node b)
traverse a -> f b
f) FingerTree (Node a)
m)
            ((a -> f b) -> Digit a -> f (Digit b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Digit a -> f (Digit 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) = a -> ()
forall a. NFData a => a -> ()
rnf a
x
    rnf (Deep Int
_ Digit a
pr FingerTree (Node a)
m Digit a
sf) = Digit a -> ()
forall a. NFData a => a -> ()
rnf Digit a
pr () -> () -> ()
forall a b. a -> b -> b
`seq` Digit a -> ()
forall a. NFData a => a -> ()
rnf Digit a
sf () -> () -> ()
forall a b. a -> b -> b
`seq` FingerTree (Node a) -> ()
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    =  Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep (Digit a -> Int
forall a. Sized a => a -> Int
size Digit a
pr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FingerTree (Node a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node a)
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Digit a -> Int
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 FingerTree (Node a) -> ViewLTree (Node a)
forall a. Sized a => FingerTree a -> ViewLTree a
viewLTree FingerTree (Node a)
m of
    ViewLTree (Node a)
EmptyLTree          -> Int -> Digit a -> FingerTree a
forall a. Int -> Digit a -> FingerTree a
digitToTree' Int
s Digit a
sf
    ConsLTree Node a
pr FingerTree (Node a)
m'     -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s (Node a -> Digit a
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 FingerTree (Node a) -> ViewRTree (Node a)
forall a. Sized a => FingerTree a -> ViewRTree a
viewRTree FingerTree (Node a)
m of
    ViewRTree (Node a)
EmptyRTree          -> Int -> Digit a -> FingerTree a
forall a. Int -> Digit a -> FingerTree a
digitToTree' Int
s Digit a
pr
    SnocRTree FingerTree (Node a)
m' Node a
sf     -> Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
s Digit a
pr FingerTree (Node a)
m' (Node a -> Digit a
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)

-- | @since 0.6.6
deriving instance TH.Lift a => TH.Lift (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 = (m -> m -> m) -> (a -> m) -> Digit a -> m
forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit m -> m -> m
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 (b -> b) -> b -> b
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 (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b (b -> b) -> b -> 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 (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
c (b -> b) -> b -> b
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 (b -> a -> b) -> b -> a -> b
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 (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f (b -> a -> b) -> b -> a -> b
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 (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f (b -> a -> b) -> b -> a -> b
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) = b -> Digit b
forall a. a -> Digit a
One (a -> b
f a
a)
    fmap a -> b
f (Two a
a a
b) = b -> b -> Digit 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) = b -> b -> b -> Digit b
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) = b -> b -> b -> b -> Digit b
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) = b -> Digit b
forall a. a -> Digit a
One (b -> Digit b) -> f b -> f (Digit b)
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) = (b -> b -> Digit b) -> f b -> f b -> f (Digit b)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> Digit b
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) = (b -> b -> b -> Digit b) -> f b -> f b -> f b -> f (Digit b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 b -> b -> b -> Digit b
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) = (b -> b -> b -> b -> Digit b)
-> f b -> f b -> f b -> f (b -> Digit b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 b -> b -> b -> b -> Digit b
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) f (b -> Digit b) -> f b -> f (Digit b)
forall a b. f (a -> b) -> f a -> f b
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) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
    rnf (Two a
a a
b) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
b
    rnf (Three a
a a
b a
c) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
b () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
c
    rnf (Four a
a a
b a
c a
d) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
b () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
c () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
d

instance Sized a => Sized (Digit a) where
    {-# INLINE size #-}
    size :: Digit a -> Int
size = (Int -> Int -> Int) -> Digit Int -> Int
forall a. (a -> a -> a) -> Digit a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Digit Int -> Int) -> (Digit a -> Digit Int) -> Digit a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Int) -> Digit a -> Digit Int
forall a b. (a -> b) -> Digit a -> Digit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Int
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) = a -> FingerTree a
forall a. a -> FingerTree a
Single a
a
digitToTree (Two a
a a
b) = Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (a -> Digit a
forall a. a -> Digit a
One a
a) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One a
b)
digitToTree (Three a
a a
b a
c) = Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One a
c)
digitToTree (Four a
a a
b a
c a
d) = Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Sized a =>
Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
deep (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> a -> Digit a
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) = Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
c a
d)
digitToTree' Int
n (Three a
a a
b a
c) = Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n (a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One a
c)
digitToTree' Int
n (Two a
a a
b) = Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
forall a.
Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
Deep Int
n (a -> Digit a
forall a. a -> Digit a
One a
a) FingerTree (Node a)
forall a. FingerTree a
EmptyT (a -> Digit a
forall a. a -> Digit a
One a
b)
digitToTree' !Int
_n (One a
a) = a -> FingerTree 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)

-- | @since 0.6.6
deriving instance TH.Lift a => TH.Lift (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 = (m -> m -> m) -> (a -> m) -> Node a -> m
forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode m -> m -> m
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 (b -> b) -> b -> b
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 (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
b (b -> b) -> b -> 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 (b -> a -> b) -> b -> a -> b
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 (b -> a -> b) -> b -> a -> b
forall a b. (a -> b) -> a -> b
$! (b -> a -> b
f (b -> a -> b) -> b -> a -> b
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) = Int -> b -> b -> Node 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) = Int -> b -> b -> b -> Node b
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) = (b -> b -> Node b) -> f b -> f b -> f (Node b)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (Int -> b -> b -> Node b
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) = (b -> b -> b -> Node b) -> f b -> f b -> f b -> f (Node b)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (Int -> b -> b -> b -> Node b
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) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
b
    rnf (Node3 Int
_ a
a a
b a
c) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
b () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
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       =  Int -> a -> a -> Node a
forall a. Int -> a -> a -> Node a
Node2 (a -> Int
forall a. Sized a => a -> Int
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
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     =  Int -> a -> a -> a -> Node a
forall a. Int -> a -> a -> a -> Node a
Node3 (a -> Int
forall a. Sized a => a -> Int
size a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Sized a => a -> Int
size a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
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) = a -> a -> Digit a
forall a. a -> a -> Digit a
Two a
a a
b
nodeToDigit (Node3 Int
_ a
a a
b a
c) = a -> a -> a -> Digit a
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
#ifdef __GLASGOW_HASKELL__
-- This cuts the time for <*> by around a fifth.
    fmap :: forall a b. (a -> b) -> Elem a -> Elem b
fmap = (a -> b) -> Elem a -> Elem b
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
#ifdef __GLASGOW_HASKELL__
    foldMap :: forall m a. Monoid m => (a -> m) -> Elem a -> m
foldMap = (a -> m) -> Elem a -> m
forall a b. Coercible a b => a -> b
coerce
    foldl :: forall b a. (b -> a -> b) -> b -> Elem a -> b
foldl = (b -> a -> b) -> b -> Elem a -> b
forall a b. Coercible a b => a -> b
coerce
    foldl' :: forall b a. (b -> a -> b) -> b -> Elem a -> b
foldl' = (b -> a -> b) -> b -> Elem a -> b
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) = b -> Elem b
forall a. a -> Elem a
Elem (b -> Elem b) -> f b -> f (Elem b)
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) = a -> ()
forall a. NFData a => a -> ()
rnf a
x

-------------------------------------------------------
-- Applicative construction
-------------------------------------------------------

-- | '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 -> FingerTree a -> f (FingerTree a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FingerTree a
forall a. FingerTree a
EmptyT
    Int
1 -> (a -> FingerTree a) -> f a -> f (FingerTree a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> FingerTree a
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 f (FingerTree (Node a))
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 f (FingerTree (Node a))
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