{-# LANGUAGE BangPatterns           #-}
{-# LANGUAGE CPP                    #-}
{-# LANGUAGE DeriveTraversable      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE PatternSynonyms        #-}
{-# LANGUAGE RoleAnnotations        #-}
{-# LANGUAGE Safe                   #-}
{-# LANGUAGE StandaloneDeriving     #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE ViewPatterns           #-}

-- Strict instance has to be orphan.
-- (we cannot define strict and lazy versions in the same module).
{-# OPTIONS_GHC -Wno-orphans #-}

module Data.SkewList.Lazy.Internal (
    SkewList (Cons_, Cons, Nil), Tree (..),
    -- * Construction
    empty,
    singleton,
    cons,
    append,
    -- * Indexing
    (!),
    (!?),
    uncons,
    length,
    null,
    -- * Conversions
    toList,
    fromList,
    -- * Folding
    foldMap,
    foldMap',
    foldr,
    foldl',
    -- ** Indexed
    ifoldMap,
    ifoldr,
    -- * Mapping
    adjust,
    map,
    -- ** Indexed
    imap,
    itraverse,
    -- * Debug
    valid,
    explicitShow,
    explicitShowsPrec,
) where

import Prelude
       (Bool (..), Eq ((==)), Functor (..), Int, Maybe (..), Num (..), Ord (..),
       Show (..), ShowS, String, error, fromIntegral, otherwise, seq, showChar,
       showParen, showString, ($), (&&), (.))

import Control.Applicative (Applicative (..), (<$>))
import Control.DeepSeq     (NFData (..))
import Data.Bits           (popCount, unsafeShiftL, unsafeShiftR, (.|.))
import Data.Hashable       (Hashable (..))
import Data.Monoid         (Monoid (..))
import Data.Semigroup      (Semigroup (..))
import Data.Strict.Classes (Strict (..))
import Data.Word           (Word)
import GHC.Stack           (HasCallStack)

import qualified Data.Foldable    as I (Foldable (..))
import qualified Data.List        as L
import qualified Data.Traversable as I (Traversable (..))
import qualified Test.QuickCheck  as QC

import qualified Data.Foldable.WithIndex    as WI (FoldableWithIndex (..))
import qualified Data.Functor.WithIndex     as WI (FunctorWithIndex (..))
import qualified Data.Traversable.WithIndex as WI (TraversableWithIndex (..))

import qualified Data.SkewList.Strict.Internal as Strict
import qualified TrustworthyCompat             as TC

-- $setup
-- >>> import Prelude (Int, ($), (<>), (==), Bool (..), error)
-- >>> import Data.Char (toUpper)
-- >>> import Data.Hashable (hash)

-------------------------------------------------------------------------------
-- Type
-------------------------------------------------------------------------------

-- | List with efficient random access.
--
-- Implemented using skewed binary.
--
-- Strict spine, lazy elements variant:
--
-- >>> length $ fromList [True, error "bar"]
-- 2
--
data SkewList a
    = Nil

    -- | Internal constructor. If you use it, maintain invariants (see 'valid').
    | Cons_
        {-# UNPACK #-} !Word -- ^ size of the head tree
        !(Tree a)
        !(SkewList a)
  deriving (SkewList a -> SkewList a -> Bool
forall a. Eq a => SkewList a -> SkewList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SkewList a -> SkewList a -> Bool
$c/= :: forall a. Eq a => SkewList a -> SkewList a -> Bool
== :: SkewList a -> SkewList a -> Bool
$c== :: forall a. Eq a => SkewList a -> SkewList a -> Bool
Eq, forall a b. a -> SkewList b -> SkewList a
forall a b. (a -> b) -> SkewList a -> SkewList b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SkewList b -> SkewList a
$c<$ :: forall a b. a -> SkewList b -> SkewList a
fmap :: forall a b. (a -> b) -> SkewList a -> SkewList b
$cfmap :: forall a b. (a -> b) -> SkewList a -> SkewList b
Functor, Functor SkewList
Foldable SkewList
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => SkewList (m a) -> m (SkewList a)
forall (f :: * -> *) a.
Applicative f =>
SkewList (f a) -> f (SkewList a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SkewList a -> m (SkewList b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SkewList a -> f (SkewList b)
sequence :: forall (m :: * -> *) a. Monad m => SkewList (m a) -> m (SkewList a)
$csequence :: forall (m :: * -> *) a. Monad m => SkewList (m a) -> m (SkewList a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SkewList a -> m (SkewList b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SkewList a -> m (SkewList b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
SkewList (f a) -> f (SkewList a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SkewList (f a) -> f (SkewList a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SkewList a -> f (SkewList b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SkewList a -> f (SkewList b)
I.Traversable)

type role SkewList representational

-- |
-- This instance provides total ordering, but this ordering /is not lexicographic/.
-- I.e. it is different order than on ordinary lists.
deriving instance Ord a => Ord (SkewList a)

-- | A complete binary tree (completeness not enforced)
data Tree a
    = Lf a
    | Nd a !(Tree a) !(Tree a)
  deriving (Tree a -> Tree a -> Bool
forall a. Eq a => Tree a -> Tree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tree a -> Tree a -> Bool
$c/= :: forall a. Eq a => Tree a -> Tree a -> Bool
== :: Tree a -> Tree a -> Bool
$c== :: forall a. Eq a => Tree a -> Tree a -> Bool
Eq, Tree a -> Tree a -> Bool
Tree a -> Tree a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Tree a)
forall a. Ord a => Tree a -> Tree a -> Bool
forall a. Ord a => Tree a -> Tree a -> Ordering
forall a. Ord a => Tree a -> Tree a -> Tree a
min :: Tree a -> Tree a -> Tree a
$cmin :: forall a. Ord a => Tree a -> Tree a -> Tree a
max :: Tree a -> Tree a -> Tree a
$cmax :: forall a. Ord a => Tree a -> Tree a -> Tree a
>= :: Tree a -> Tree a -> Bool
$c>= :: forall a. Ord a => Tree a -> Tree a -> Bool
> :: Tree a -> Tree a -> Bool
$c> :: forall a. Ord a => Tree a -> Tree a -> Bool
<= :: Tree a -> Tree a -> Bool
$c<= :: forall a. Ord a => Tree a -> Tree a -> Bool
< :: Tree a -> Tree a -> Bool
$c< :: forall a. Ord a => Tree a -> Tree a -> Bool
compare :: Tree a -> Tree a -> Ordering
$ccompare :: forall a. Ord a => Tree a -> Tree a -> Ordering
Ord, Int -> Tree a -> ShowS
forall a. Show a => Int -> Tree a -> ShowS
forall a. Show a => [Tree a] -> ShowS
forall a. Show a => Tree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tree a] -> ShowS
$cshowList :: forall a. Show a => [Tree a] -> ShowS
show :: Tree a -> String
$cshow :: forall a. Show a => Tree a -> String
showsPrec :: Int -> Tree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Tree a -> ShowS
Show, forall a b. a -> Tree b -> Tree a
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Tree b -> Tree a
$c<$ :: forall a b. a -> Tree b -> Tree a
fmap :: forall a b. (a -> b) -> Tree a -> Tree b
$cfmap :: forall a b. (a -> b) -> Tree a -> Tree b
Functor, Functor Tree
Foldable Tree
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Tree (m a) -> m (Tree a)
forall (f :: * -> *) a. Applicative f => Tree (f a) -> f (Tree a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tree a -> m (Tree b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tree a -> f (Tree b)
sequence :: forall (m :: * -> *) a. Monad m => Tree (m a) -> m (Tree a)
$csequence :: forall (m :: * -> *) a. Monad m => Tree (m a) -> m (Tree a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tree a -> m (Tree b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Tree a -> m (Tree b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Tree (f a) -> f (Tree a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Tree (f a) -> f (Tree a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tree a -> f (Tree b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tree a -> f (Tree b)
I.Traversable)

-------------------------------------------------------------------------------
-- Validity
-------------------------------------------------------------------------------

-- | Check invariants.
--
-- * Trees are stored in increasing order.
--
-- * Only first two trees can have the same size.
--
-- * Tree sizes should be of form @2^n - 1@.
--
-- * Trees should be balanced.
--
valid :: SkewList a -> Bool
valid :: forall a. SkewList a -> Bool
valid SkewList a
Nil                            = Bool
True
valid (Cons_ Word
s  Tree a
t SkewList a
Nil)               = forall a. Word -> Tree a -> Bool
validTree Word
s Tree a
t
valid (Cons_ Word
s1 Tree a
t1 (Cons_ Word
s2 Tree a
t2 SkewList a
xs)) =
    Word
s1 forall a. Ord a => a -> a -> Bool
<= Word
s2 Bool -> Bool -> Bool
&& forall a. Word -> Tree a -> Bool
validTree Word
s1 Tree a
t1 Bool -> Bool -> Bool
&& forall a. Word -> Tree a -> Bool
validTree Word
s2 Tree a
t2 Bool -> Bool -> Bool
&& forall a. Word -> SkewList a -> Bool
valid' Word
s2 SkewList a
xs

valid' :: Word -> SkewList a -> Bool
valid' :: forall a. Word -> SkewList a -> Bool
valid' Word
_ SkewList a
Nil            = Bool
True
valid' Word
p (Cons_ Word
s Tree a
t SkewList a
xs) = Word
p forall a. Ord a => a -> a -> Bool
< Word
s Bool -> Bool -> Bool
&& forall a. Word -> Tree a -> Bool
validTree Word
s Tree a
t Bool -> Bool -> Bool
&& forall a. Word -> SkewList a -> Bool
valid' Word
s SkewList a
xs

validTree
    :: Word
    -> Tree a
    -> Bool
validTree :: forall a. Word -> Tree a -> Bool
validTree Word
size Tree a
tree = forall a. Bits a => a -> Int
popCount (Word
size forall a. Num a => a -> a -> a
+ Word
1) forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& forall a. Word -> Tree a -> Bool
go Word
size Tree a
tree
  where
    go :: Word -> Tree a -> Bool
go Word
1 (Lf a
_)     = Bool
True
    go Word
_ (Lf a
_)     = Bool
False
    go Word
n (Nd a
_ Tree a
l Tree a
r) = Word -> Tree a -> Bool
go Word
n' Tree a
l Bool -> Bool -> Bool
&& Word -> Tree a -> Bool
go Word
n' Tree a
r where n' :: Word
n' = Word -> Word
sizeDown Word
n

-------------------------------------------------------------------------------
-- Size helpers
-------------------------------------------------------------------------------

sizeDown :: Word -> Word
sizeDown :: Word -> Word
sizeDown Word
n = forall a. Bits a => a -> Int -> a
unsafeShiftR Word
n Int
1
{-# INLINE sizeDown #-}

-- | Double plus one. @sizeUp n = 2 * n + 1@.
sizeUp :: Word -> Word
sizeUp :: Word -> Word
sizeUp Word
n = forall a. Bits a => a -> Int -> a
unsafeShiftL Word
n Int
1 forall a. Bits a => a -> a -> a
.|. Word
1

-------------------------------------------------------------------------------
-- Patterns
-------------------------------------------------------------------------------

-- | 'Cons' and 'Nil' form complete pattern match.
pattern Cons :: a -> SkewList a -> SkewList a
pattern $bCons :: forall a. a -> SkewList a -> SkewList a
$mCons :: forall {r} {a}.
SkewList a -> (a -> SkewList a -> r) -> ((# #) -> r) -> r
Cons x xs <- (uncons -> Just (x, xs))
  where Cons a
x SkewList a
xs = forall a. a -> SkewList a -> SkewList a
cons a
x SkewList a
xs

{-# COMPLETE Cons, Nil #-}

-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------

instance I.Foldable SkewList where
    foldMap :: forall m a. Monoid m => (a -> m) -> SkewList a -> m
foldMap = forall m a. Monoid m => (a -> m) -> SkewList a -> m
foldMap

#if MIN_VERSION_base(4,13,0)
    foldMap' :: forall m a. Monoid m => (a -> m) -> SkewList a -> m
foldMap' = forall m a. Monoid m => (a -> m) -> SkewList a -> m
foldMap'
#endif

    foldr :: forall a b. (a -> b -> b) -> b -> SkewList a -> b
foldr   = forall a b. (a -> b -> b) -> b -> SkewList a -> b
foldr
    foldl' :: forall b a. (b -> a -> b) -> b -> SkewList a -> b
foldl'  = forall b a. (b -> a -> b) -> b -> SkewList a -> b
foldl'

    length :: forall a. SkewList a -> Int
length = forall a. SkewList a -> Int
length
    null :: forall a. SkewList a -> Bool
null   = forall a. SkewList a -> Bool
null

    sum :: forall a. Num a => SkewList a -> a
sum     = forall a. Num a => SkewList a -> a
sum
    product :: forall a. Num a => SkewList a -> a
product = forall a. Num a => SkewList a -> a
product

instance I.Foldable Tree where
    foldMap :: forall m a. Monoid m => (a -> m) -> Tree a -> m
foldMap = forall m a. Semigroup m => (a -> m) -> Tree a -> m
foldMapTree
    foldr :: forall a b. (a -> b -> b) -> b -> Tree a -> b
foldr   = forall a b. (a -> b -> b) -> b -> Tree a -> b
foldrTree
    null :: forall a. Tree a -> Bool
null Tree a
_  = Bool
False

instance NFData a => NFData (SkewList a) where
    rnf :: SkewList a -> ()
rnf SkewList a
Nil            = ()
    rnf (Cons_ Word
_ Tree a
t SkewList a
xs) = forall a. NFData a => a -> ()
rnf Tree a
t seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf SkewList a
xs

instance NFData a => NFData (Tree a) where
    rnf :: Tree a -> ()
rnf (Lf a
a)     = forall a. NFData a => a -> ()
rnf a
a
    rnf (Nd a
x Tree a
l Tree a
r) = forall a. NFData a => a -> ()
rnf a
x seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Tree a
l seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Tree a
r

-- | The hash value are different then for an ordinary list:
--
-- >>> hash (fromList "foobar") == hash "foobar"
-- False
--
-- >>> hash (fromList "foo", fromList "bar") == hash (fromList "foobar", fromList "")
-- False
--
instance Hashable a => Hashable (SkewList a) where
    hashWithSalt :: Int -> SkewList a -> Int
hashWithSalt Int
salt SkewList a
Nil            = Int
salt
        forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0 :: Int)
    hashWithSalt Int
salt (Cons_ Word
s Tree a
t SkewList a
xs) = Int
salt
        forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word
s   -- s /= 1, acts as "constructor tag"
        forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Tree a
t
        forall a. Hashable a => Int -> a -> Int
`hashWithSalt` SkewList a
xs

instance Hashable a => Hashable (Tree a) where
    hashWithSalt :: Int -> Tree a -> Int
hashWithSalt = forall b a. (b -> a -> b) -> b -> Tree a -> b
foldlTree' forall a. Hashable a => Int -> a -> Int
hashWithSalt

-- |
--
-- >>> fromList "abc" <> fromList "xyz"
-- "abcxyz"
--
instance Semigroup (SkewList a) where
    <> :: SkewList a -> SkewList a -> SkewList a
(<>) = forall a. SkewList a -> SkewList a -> SkewList a
append

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

instance WI.FunctorWithIndex Int SkewList where
    imap :: forall a b. (Int -> a -> b) -> SkewList a -> SkewList b
imap = forall a b. (Int -> a -> b) -> SkewList a -> SkewList b
imap

instance WI.FoldableWithIndex Int SkewList where
    ifoldMap :: forall m a. Monoid m => (Int -> a -> m) -> SkewList a -> m
ifoldMap = forall m a. Monoid m => (Int -> a -> m) -> SkewList a -> m
ifoldMap
    ifoldr :: forall a b. (Int -> a -> b -> b) -> b -> SkewList a -> b
ifoldr   = forall a b. (Int -> a -> b -> b) -> b -> SkewList a -> b
ifoldr

instance WI.TraversableWithIndex Int SkewList where
    itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> SkewList a -> f (SkewList b)
itraverse = forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> SkewList a -> f (SkewList b)
itraverse

-------------------------------------------------------------------------------
-- Showing
-------------------------------------------------------------------------------

instance Show a => Show (SkewList a) where
    showsPrec :: Int -> SkewList a -> ShowS
showsPrec Int
d SkewList a
xs = forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (forall a. SkewList a -> [a]
toList SkewList a
xs)

explicitShow :: Show a => SkewList a -> String
explicitShow :: forall a. Show a => SkewList a -> String
explicitShow SkewList a
xs = forall a. Show a => Int -> SkewList a -> ShowS
explicitShowsPrec Int
0 SkewList a
xs String
""

explicitShowsPrec :: Show a => Int -> SkewList a -> ShowS
explicitShowsPrec :: forall a. Show a => Int -> SkewList a -> ShowS
explicitShowsPrec Int
_ SkewList a
Nil             = String -> ShowS
showString String
"Nil"
explicitShowsPrec Int
d (Cons_ Word
s Tree a
t SkewList a
Nil) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
    forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Cons_ "
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word
s
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Tree a
t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" Nil"
explicitShowsPrec Int
d (Cons_ Word
s Tree a
t SkewList a
xs)  = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
0)
    forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Cons_ "
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word
s
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Tree a
t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" $ "
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> SkewList a -> ShowS
explicitShowsPrec Int
0 SkewList a
xs

-------------------------------------------------------------------------------
-- Construction
-------------------------------------------------------------------------------

-- | Empty 'SkewList'.
--
-- >>> empty :: SkewList Int
-- []
--
empty :: SkewList a
empty :: forall a. SkewList a
empty = forall a. SkewList a
Nil

-- | Single element 'SkewList'.
--
-- >>> singleton True
-- [True]
--
singleton :: a -> SkewList a
singleton :: forall a. a -> SkewList a
singleton a
x = forall a. Word -> Tree a -> SkewList a -> SkewList a
Cons_ Word
1 (forall a. a -> Tree a
Lf a
x) forall a. SkewList a
Nil

-- |
--
-- >>> cons 'x' (fromList "foo")
-- "xfoo"
--
cons :: a -> SkewList a -> SkewList a
cons :: forall a. a -> SkewList a -> SkewList a
cons a
x (Cons_ Word
s1 Tree a
t1 (Cons_ Word
s2 Tree a
t2 SkewList a
xs)) | Word
s1 forall a. Eq a => a -> a -> Bool
== Word
s2 = forall a. Word -> Tree a -> SkewList a -> SkewList a
Cons_ (Word -> Word
sizeUp Word
s1) (forall a. a -> Tree a -> Tree a -> Tree a
Nd a
x Tree a
t1 Tree a
t2) SkewList a
xs
cons a
x SkewList a
xs                                        = forall a. Word -> Tree a -> SkewList a -> SkewList a
Cons_ Word
1           (forall a. a -> Tree a
Lf a
x)       SkewList a
xs

-- |
--
-- >>> append (fromList "foo") (fromList "bar")
-- "foobar"
--
append :: SkewList a -> SkewList a -> SkewList a
-- append xs ys = foldr cons ys xs
append :: forall a. SkewList a -> SkewList a -> SkewList a
append SkewList a
Nil            SkewList a
ys = SkewList a
ys
append (Cons_ Word
s Tree a
t SkewList a
xs) SkewList a
ys = forall a. Word -> Tree a -> SkewList a -> SkewList a
appendTree Word
s Tree a
t (forall a. SkewList a -> SkewList a -> SkewList a
append SkewList a
xs SkewList a
ys)

appendTree :: Word -> Tree a -> SkewList a -> SkewList a
appendTree :: forall a. Word -> Tree a -> SkewList a -> SkewList a
appendTree !Word
_   (Lf a
x)     SkewList a
xs
                = forall a. a -> SkewList a -> SkewList a
cons a
x SkewList a
xs
appendTree Word
s1 t :: Tree a
t@(Nd a
x Tree a
l Tree a
r) xs :: SkewList a
xs@(Cons_ Word
s2 Tree a
_ (Cons_ Word
s3 Tree a
_ SkewList a
_))
    | Word
s2 forall a. Eq a => a -> a -> Bool
== Word
s3  = forall a. a -> SkewList a -> SkewList a
cons a
x (forall a. Word -> Tree a -> SkewList a -> SkewList a
appendTree Word
s' Tree a
l (forall a. Word -> Tree a -> SkewList a -> SkewList a
appendTree Word
s' Tree a
r SkewList a
xs))
    | Word
s1 forall a. Ord a => a -> a -> Bool
<= Word
s2  = forall a. Word -> Tree a -> SkewList a -> SkewList a
Cons_ Word
s1 Tree a
t SkewList a
xs
    | Bool
otherwise = forall a. a -> SkewList a -> SkewList a
cons a
x (forall a. Word -> Tree a -> SkewList a -> SkewList a
appendTree Word
s' Tree a
l (forall a. Word -> Tree a -> SkewList a -> SkewList a
appendTree Word
s' Tree a
r SkewList a
xs))
  where
    s' :: Word
s' = Word -> Word
sizeDown Word
s1
appendTree Word
s1 t :: Tree a
t@(Nd a
x Tree a
l Tree a
r) xs :: SkewList a
xs@(Cons_ Word
s2 Tree a
_ SkewList a
Nil)
    | Word
s1 forall a. Ord a => a -> a -> Bool
<= Word
s2  = forall a. Word -> Tree a -> SkewList a -> SkewList a
Cons_ Word
s1 Tree a
t SkewList a
xs
    | Bool
otherwise = forall a. a -> SkewList a -> SkewList a
cons a
x (forall a. Word -> Tree a -> SkewList a -> SkewList a
appendTree Word
s' Tree a
l (forall a. Word -> Tree a -> SkewList a -> SkewList a
appendTree Word
s' Tree a
r SkewList a
xs))
  where
    s' :: Word
s' = Word -> Word
sizeDown Word
s1
appendTree Word
s1 Tree a
t SkewList a
Nil
                = forall a. Word -> Tree a -> SkewList a -> SkewList a
Cons_ Word
s1 Tree a
t forall a. SkewList a
Nil

-------------------------------------------------------------------------------
-- Indexing
-------------------------------------------------------------------------------

infixl 9 !, !?

-- | List index.
--
-- >>> fromList ['a'..'f'] ! 0
-- 'a'
--
-- >>> fromList ['a'..'f'] ! 5
-- 'f'
--
-- >>> fromList ['a'..'f'] ! 6
-- *** Exception: SkewList.!
-- CallStack (from HasCallStack):
--   error...
--   !, called at <interactive>...
--
(!) :: HasCallStack => SkewList a -> Int -> a
! :: forall a. HasCallStack => SkewList a -> Int -> a
(!) SkewList a
t Int
i
    | Int
i forall a. Ord a => a -> a -> Bool
< Int
0     = forall {a}. a
err
    | Bool
otherwise = forall a. a -> SkewList a -> Word -> a
unsafeIndex forall {a}. a
err SkewList a
t (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
  where
    err :: a
err = forall a. HasCallStack => String -> a
error String
"SkewList.!"

unsafeIndex :: a -> SkewList a -> Word -> a
unsafeIndex :: forall a. a -> SkewList a -> Word -> a
unsafeIndex a
d SkewList a
Nil            !Word
_ = a
d
unsafeIndex a
d (Cons_ Word
s Tree a
t SkewList a
xs) !Word
i
    | Word
i forall a. Ord a => a -> a -> Bool
< Word
s     = forall a. a -> Word -> Word -> Tree a -> a
unsafeIndexTree a
d Word
s Word
i Tree a
t
    | Bool
otherwise = forall a. a -> SkewList a -> Word -> a
unsafeIndex a
d SkewList a
xs (Word
i forall a. Num a => a -> a -> a
- Word
s)

unsafeIndexTree
    :: a       -- ^ default value
    -> Word    -- ^ tree size
    -> Word    -- ^ index
    -> Tree a  -- ^ tree
    -> a
unsafeIndexTree :: forall a. a -> Word -> Word -> Tree a -> a
unsafeIndexTree a
_ !Word
_ !Word
0 (Lf a
x)       = a
x
unsafeIndexTree a
d  Word
_  Word
_ (Lf a
_)       = a
d
unsafeIndexTree a
_  Word
_  Word
0 (Nd a
x Tree a
_ Tree a
_)   = a
x
unsafeIndexTree a
d  Word
s  Word
i (Nd a
_ Tree a
t1 Tree a
t2)
    | Word
i forall a. Ord a => a -> a -> Bool
<= Word
s'   = forall a. a -> Word -> Word -> Tree a -> a
unsafeIndexTree a
d Word
s' (Word
i forall a. Num a => a -> a -> a
- Word
1)      Tree a
t1
    | Bool
otherwise = forall a. a -> Word -> Word -> Tree a -> a
unsafeIndexTree a
d Word
s' (Word
i forall a. Num a => a -> a -> a
- Word
1 forall a. Num a => a -> a -> a
- Word
s') Tree a
t2
  where
    s' :: Word
s' = Word -> Word
sizeDown Word
s

-- | safe list index.
--
-- >>> fromList ['a'..'f'] !? 0
-- Just 'a'
--
-- >>> fromList ['a'..'f'] !? 5
-- Just 'f'
--
-- >>> fromList ['a'..'f'] !? 6
-- Nothing
--
(!?) :: SkewList a -> Int -> Maybe a
!? :: forall a. SkewList a -> Int -> Maybe a
(!?) SkewList a
t Int
i
    | Int
i forall a. Ord a => a -> a -> Bool
< Int
0     = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. SkewList a -> Word -> Maybe a
safeIndex SkewList a
t (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)

safeIndex :: SkewList a -> Word -> Maybe a
safeIndex :: forall a. SkewList a -> Word -> Maybe a
safeIndex SkewList a
Nil            !Word
_ = forall a. Maybe a
Nothing
safeIndex (Cons_ Word
s Tree a
t SkewList a
xs) !Word
i
    | Word
i forall a. Ord a => a -> a -> Bool
< Word
s     = forall a. Word -> Word -> Tree a -> Maybe a
safeIndexTree Word
s Word
i Tree a
t
    | Bool
otherwise = forall a. SkewList a -> Word -> Maybe a
safeIndex SkewList a
xs (Word
i forall a. Num a => a -> a -> a
- Word
s)

safeIndexTree
    :: Word    -- ^ tree size
    -> Word    -- ^ index
    -> Tree a  -- ^ tree
    -> Maybe a
safeIndexTree :: forall a. Word -> Word -> Tree a -> Maybe a
safeIndexTree !Word
_ !Word
0 (Lf a
x)       = forall a. a -> Maybe a
Just a
x
safeIndexTree  Word
_  Word
_ (Lf a
_)       = forall a. Maybe a
Nothing
safeIndexTree  Word
_  Word
0 (Nd a
x Tree a
_ Tree a
_)   = forall a. a -> Maybe a
Just a
x
safeIndexTree  Word
s  Word
i (Nd a
_ Tree a
t1 Tree a
t2)
    | Word
i forall a. Ord a => a -> a -> Bool
<= Word
s'   = forall a. Word -> Word -> Tree a -> Maybe a
safeIndexTree Word
s' (Word
i forall a. Num a => a -> a -> a
- Word
1)      Tree a
t1
    | Bool
otherwise = forall a. Word -> Word -> Tree a -> Maybe a
safeIndexTree Word
s' (Word
i forall a. Num a => a -> a -> a
- Word
1 forall a. Num a => a -> a -> a
- Word
s') Tree a
t2
  where
    s' :: Word
s' = Word -> Word
sizeDown Word
s

-- | Inverse of 'cons'.
--
-- >>> uncons (fromList ['a'..'f'])
-- Just ('a',"bcdef")
--
-- >>> uncons Nil
-- Nothing
--
uncons :: SkewList a -> Maybe (a, SkewList a)
uncons :: forall a. SkewList a -> Maybe (a, SkewList a)
uncons SkewList a
Nil                        = forall a. Maybe a
Nothing
uncons (Cons_  Word
_ (Lf a
x)       SkewList a
xs) = forall a. a -> Maybe a
Just (a
x, SkewList a
xs)
uncons (Cons_  Word
s (Nd a
x Tree a
t1 Tree a
t2) SkewList a
xs) = forall a. a -> Maybe a
Just (a
x, forall a. Word -> Tree a -> SkewList a -> SkewList a
Cons_ Word
s' Tree a
t1 (forall a. Word -> Tree a -> SkewList a -> SkewList a
Cons_ Word
s' Tree a
t2 SkewList a
xs)) where s' :: Word
s' = Word -> Word
sizeDown Word
s

-- | Length, /O(log n)/.
length :: SkewList a -> Int
length :: forall a. SkewList a -> Int
length = forall {t} {a}. Num t => t -> SkewList a -> t
go Int
0 where
    go :: t -> SkewList a -> t
go !t
n SkewList a
Nil            = t
n
    go  t
n (Cons_ Word
s Tree a
_ SkewList a
xs) = let !n' :: t
n' = t
n forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
s in t -> SkewList a -> t
go t
n' SkewList a
xs

-- | Is the list empty? /O(1)/.
null :: SkewList a -> Bool
null :: forall a. SkewList a -> Bool
null SkewList a
Nil           = Bool
True
null (Cons_ Word
_ Tree a
_ SkewList a
_) = Bool
False

-------------------------------------------------------------------------------
-- Conversions
-------------------------------------------------------------------------------

instance TC.IsList (SkewList a) where
    type Item (SkewList a) = a
    toList :: SkewList a -> [Item (SkewList a)]
toList   = forall a. SkewList a -> [a]
toList
    fromList :: [Item (SkewList a)] -> SkewList a
fromList = forall a. [a] -> SkewList a
fromList

-- | Convert 'SkewList' to ordinary list.
toList :: SkewList a -> [a]
toList :: forall a. SkewList a -> [a]
toList SkewList a
Nil            = []
toList (Cons_ Word
_ Tree a
t SkewList a
xs) = forall a. Tree a -> [a] -> [a]
toListTree Tree a
t (forall a. SkewList a -> [a]
toList SkewList a
xs)

toListTree :: Tree a -> [a] -> [a]
toListTree :: forall a. Tree a -> [a] -> [a]
toListTree (Lf a
x)       [a]
zs = a
x forall a. a -> [a] -> [a]
: [a]
zs
toListTree (Nd a
x Tree a
xs Tree a
ys) [a]
zs = a
x forall a. a -> [a] -> [a]
: forall a. Tree a -> [a] -> [a]
toListTree Tree a
xs (forall a. Tree a -> [a] -> [a]
toListTree Tree a
ys [a]
zs)

-- | Convert ordinary list to 'SkewList'.
--
-- >>> fromList ['a' .. 'f']
-- "abcdef"
--
-- >>> explicitShow $ fromList ['a' .. 'f']
-- "Cons_ 3 (Nd 'a' (Lf 'b') (Lf 'c')) $ Cons_ 3 (Nd 'd' (Lf 'e') (Lf 'f')) Nil"
--
-- >>> explicitShow $ fromList ['a' .. 'e']
-- "Cons_ 1 (Lf 'a') $ Cons_ 1 (Lf 'b') $ Cons_ 3 (Nd 'c' (Lf 'd') (Lf 'e')) Nil"
--
fromList :: [a] -> SkewList a
fromList :: forall a. [a] -> SkewList a
fromList = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr forall a. a -> SkewList a -> SkewList a
cons forall a. SkewList a
empty

-------------------------------------------------------------------------------
-- Folding
-------------------------------------------------------------------------------

-- | 'I.foldMap'.
foldMap :: Monoid m => (a -> m) -> SkewList a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SkewList a -> m
foldMap a -> m
_ SkewList a
Nil            = forall a. Monoid a => a
mempty
foldMap a -> m
f (Cons_ Word
_ Tree a
t SkewList a
xs) = forall m a. Semigroup m => (a -> m) -> Tree a -> m
foldMapTree a -> m
f Tree a
t forall a. Semigroup a => a -> a -> a
<> forall m a. Monoid m => (a -> m) -> SkewList a -> m
foldMap a -> m
f SkewList a
xs

foldMapTree :: Semigroup m => (a -> m) -> Tree a -> m
foldMapTree :: forall m a. Semigroup m => (a -> m) -> Tree a -> m
foldMapTree a -> m
f (Lf a
x)     = a -> m
f a
x
foldMapTree a -> m
f (Nd a
x Tree a
l Tree a
r) = a -> m
f a
x forall a. Semigroup a => a -> a -> a
<> forall m a. Semigroup m => (a -> m) -> Tree a -> m
foldMapTree a -> m
f Tree a
l forall a. Semigroup a => a -> a -> a
<> forall m a. Semigroup m => (a -> m) -> Tree a -> m
foldMapTree a -> m
f Tree a
r

-- | Strict 'foldMap'.
foldMap' :: Monoid m => (a -> m) -> SkewList a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> SkewList a -> m
foldMap' a -> m
_ SkewList a
Nil            = forall a. Monoid a => a
mempty
foldMap' a -> m
f (Cons_ Word
_ Tree a
t SkewList a
xs) =
    m
a forall a. Semigroup a => a -> a -> a
<> m
b
  where
    !a :: m
a = forall m a. Semigroup m => (a -> m) -> Tree a -> m
foldMapTree' a -> m
f Tree a
t
    !b :: m
b = forall m a. Monoid m => (a -> m) -> SkewList a -> m
foldMap' a -> m
f SkewList a
xs

foldMapTree' :: Semigroup m => (a -> m) -> Tree a -> m
foldMapTree' :: forall m a. Semigroup m => (a -> m) -> Tree a -> m
foldMapTree' a -> m
f (Lf a
x) = a -> m
f a
x
foldMapTree' a -> m
f (Nd a
x Tree a
l Tree a
r) =
    m
xl forall a. Semigroup a => a -> a -> a
<> m
r'
  where
    !x' :: m
x' = a -> m
f a
x
    !l' :: m
l' = forall m a. Semigroup m => (a -> m) -> Tree a -> m
foldMapTree' a -> m
f Tree a
l
    !r' :: m
r' = forall m a. Semigroup m => (a -> m) -> Tree a -> m
foldMapTree' a -> m
f Tree a
r
    !xl :: m
xl = m
x' forall a. Semigroup a => a -> a -> a
<> m
l'

-- | Right fold.
foldr :: (a -> b -> b) -> b -> SkewList a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SkewList a -> b
foldr a -> b -> b
_ b
z SkewList a
Nil            = b
z
foldr a -> b -> b
f b
z (Cons_ Word
_ Tree a
t SkewList a
xs) = forall a b. (a -> b -> b) -> b -> Tree a -> b
foldrTree a -> b -> b
f (forall a b. (a -> b -> b) -> b -> SkewList a -> b
foldr a -> b -> b
f b
z SkewList a
xs) Tree a
t

foldrTree :: (a -> b -> b) -> b -> Tree a -> b
foldrTree :: forall a b. (a -> b -> b) -> b -> Tree a -> b
foldrTree a -> b -> b
f b
z (Lf a
x) = a -> b -> b
f a
x b
z
foldrTree a -> b -> b
f b
z (Nd a
x Tree a
l Tree a
r) = a -> b -> b
f a
x (forall a b. (a -> b -> b) -> b -> Tree a -> b
foldrTree a -> b -> b
f (forall a b. (a -> b -> b) -> b -> Tree a -> b
foldrTree a -> b -> b
f b
z Tree a
r) Tree a
l)

-- | Strict left fold.
foldl' :: (b -> a -> b) -> b -> SkewList a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> SkewList a -> b
foldl' b -> a -> b
_  b
z SkewList a
Nil           = b
z
foldl' b -> a -> b
f b
z (Cons_ Word
_ Tree a
t SkewList a
xs) = forall b a. (b -> a -> b) -> b -> SkewList a -> b
foldl' b -> a -> b
f b
z' SkewList a
xs
  where
    !z' :: b
z' = forall b a. (b -> a -> b) -> b -> Tree a -> b
foldlTree' b -> a -> b
f b
z Tree a
t

foldlTree' :: (b -> a -> b) -> b -> Tree a -> b
foldlTree' :: forall b a. (b -> a -> b) -> b -> Tree a -> b
foldlTree' b -> a -> b
f b
z (Lf a
x)     = b -> a -> b
f b
z a
x
foldlTree' b -> a -> b
f b
z (Nd a
x Tree a
l Tree a
r) = forall b a. (b -> a -> b) -> b -> Tree a -> b
foldlTree' b -> a -> b
f b
l' Tree a
r
  where
    !x' :: b
x' = b -> a -> b
f b
z a
x
    !l' :: b
l' = forall b a. (b -> a -> b) -> b -> Tree a -> b
foldlTree' b -> a -> b
f b
x' Tree a
l

sum :: Num a => SkewList a -> a
sum :: forall a. Num a => SkewList a -> a
sum = forall b a. (b -> a -> b) -> b -> SkewList a -> b
foldl' forall a. Num a => a -> a -> a
(+) a
0

product :: Num a => SkewList a -> a
product :: forall a. Num a => SkewList a -> a
product = forall b a. (b -> a -> b) -> b -> SkewList a -> b
foldl' forall a. Num a => a -> a -> a
(*) a
1

-------------------------------------------------------------------------------
-- Indexed Folding
-------------------------------------------------------------------------------

-- | Indexed 'I.foldMap'.
ifoldMap :: Monoid m => (Int -> a -> m) -> SkewList a -> m
ifoldMap :: forall m a. Monoid m => (Int -> a -> m) -> SkewList a -> m
ifoldMap = forall m a. Monoid m => Int -> (Int -> a -> m) -> SkewList a -> m
ifoldMapOff Int
0

ifoldMapOff :: Monoid m => Int -> (Int -> a -> m) -> SkewList a -> m
ifoldMapOff :: forall m a. Monoid m => Int -> (Int -> a -> m) -> SkewList a -> m
ifoldMapOff Int
_ Int -> a -> m
_ SkewList a
Nil            = forall a. Monoid a => a
mempty
ifoldMapOff Int
o Int -> a -> m
f (Cons_ Word
s Tree a
t SkewList a
xs) = forall m a.
Semigroup m =>
Int -> Word -> (Int -> a -> m) -> Tree a -> m
ifoldMapTreeOff Int
o Word
s Int -> a -> m
f Tree a
t forall a. Semigroup a => a -> a -> a
<> forall m a. Monoid m => Int -> (Int -> a -> m) -> SkewList a -> m
ifoldMapOff (Int
o forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
s) Int -> a -> m
f SkewList a
xs

ifoldMapTreeOff :: Semigroup m => Int -> Word -> (Int -> a -> m) -> Tree a -> m
ifoldMapTreeOff :: forall m a.
Semigroup m =>
Int -> Word -> (Int -> a -> m) -> Tree a -> m
ifoldMapTreeOff Int
o Word
_ Int -> a -> m
f (Lf a
x)     = Int -> a -> m
f Int
o a
x
ifoldMapTreeOff Int
o Word
s Int -> a -> m
f (Nd a
x Tree a
l Tree a
r) = Int -> a -> m
f Int
o a
x forall a. Semigroup a => a -> a -> a
<> forall m a.
Semigroup m =>
Int -> Word -> (Int -> a -> m) -> Tree a -> m
ifoldMapTreeOff (Int
o forall a. Num a => a -> a -> a
+ Int
1) Word
s' Int -> a -> m
f Tree a
l forall a. Semigroup a => a -> a -> a
<> forall m a.
Semigroup m =>
Int -> Word -> (Int -> a -> m) -> Tree a -> m
ifoldMapTreeOff (Int
o forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
s') Word
s' Int -> a -> m
f Tree a
r
  where
    s' :: Word
s' = Word -> Word
sizeDown Word
s

-- | Indexed right fold.
ifoldr :: (Int -> a -> b -> b) -> b -> SkewList a -> b
ifoldr :: forall a b. (Int -> a -> b -> b) -> b -> SkewList a -> b
ifoldr = forall a t. Int -> (Int -> a -> t -> t) -> t -> SkewList a -> t
ifoldrOff Int
0

ifoldrOff :: Int -> (Int -> a -> t -> t) -> t -> SkewList a -> t
ifoldrOff :: forall a t. Int -> (Int -> a -> t -> t) -> t -> SkewList a -> t
ifoldrOff Int
_ Int -> a -> t -> t
_ t
z SkewList a
Nil            = t
z
ifoldrOff Int
o Int -> a -> t -> t
f t
z (Cons_ Word
s Tree a
t SkewList a
xs) = forall a b. Int -> Word -> (Int -> a -> b -> b) -> b -> Tree a -> b
ifoldrTreeOff Int
o Word
s Int -> a -> t -> t
f (forall a t. Int -> (Int -> a -> t -> t) -> t -> SkewList a -> t
ifoldrOff (Int
o forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
s) Int -> a -> t -> t
f t
z SkewList a
xs) Tree a
t

ifoldrTreeOff :: Int -> Word -> (Int -> a -> b -> b) -> b -> Tree a -> b
ifoldrTreeOff :: forall a b. Int -> Word -> (Int -> a -> b -> b) -> b -> Tree a -> b
ifoldrTreeOff Int
o Word
_ Int -> a -> b -> b
f b
z (Lf a
x) = Int -> a -> b -> b
f Int
o a
x b
z
ifoldrTreeOff Int
o Word
s Int -> a -> b -> b
f b
z (Nd a
x Tree a
l Tree a
r) = Int -> a -> b -> b
f Int
o a
x (forall a b. Int -> Word -> (Int -> a -> b -> b) -> b -> Tree a -> b
ifoldrTreeOff (Int
o forall a. Num a => a -> a -> a
+ Int
1) Word
s' Int -> a -> b -> b
f (forall a b. Int -> Word -> (Int -> a -> b -> b) -> b -> Tree a -> b
ifoldrTreeOff (Int
o forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
s') Word
s' Int -> a -> b -> b
f b
z Tree a
r) Tree a
l) where
    s' :: Word
s' = Word -> Word
sizeDown Word
s

-------------------------------------------------------------------------------
-- Mapping
-------------------------------------------------------------------------------

-- | Adjust a value in the list.
--
-- >>> adjust 3 toUpper $ fromList "bcdef"
-- "bcdEf"
--
-- If index is out of bounds, the list is returned unmodified.
--
-- >>> adjust 10 toUpper $ fromList "bcdef"
-- "bcdef"
--
-- >>> adjust (-1) toUpper $ fromList "bcdef"
-- "bcdef"
--
adjust :: Int -> (a -> a) -> SkewList a -> SkewList a
adjust :: forall a. Int -> (a -> a) -> SkewList a -> SkewList a
adjust Int
i a -> a
f SkewList a
xs
    | Int
i forall a. Ord a => a -> a -> Bool
< Int
0     = SkewList a
xs
    | Bool
otherwise = forall a. Word -> (a -> a) -> SkewList a -> SkewList a
adjustOff (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) a -> a
f SkewList a
xs

adjustOff :: Word -> (a -> a) -> SkewList a -> SkewList a
adjustOff :: forall a. Word -> (a -> a) -> SkewList a -> SkewList a
adjustOff Word
_ a -> a
_ SkewList a
Nil = forall a. SkewList a
Nil
adjustOff Word
i a -> a
f (Cons_ Word
s Tree a
t SkewList a
xs)
    | Word
i forall a. Ord a => a -> a -> Bool
< Word
s     = forall a. Word -> Tree a -> SkewList a -> SkewList a
Cons_ Word
s (forall a. Word -> Word -> (a -> a) -> Tree a -> Tree a
adjustOffTree Word
i Word
s a -> a
f Tree a
t) SkewList a
xs
    | Bool
otherwise = forall a. Word -> Tree a -> SkewList a -> SkewList a
Cons_ Word
s Tree a
t                       (forall a. Word -> (a -> a) -> SkewList a -> SkewList a
adjustOff (Word
i forall a. Num a => a -> a -> a
- Word
s) a -> a
f SkewList a
xs)

adjustOffTree :: Word -> Word -> (a -> a) -> Tree a -> Tree a
adjustOffTree :: forall a. Word -> Word -> (a -> a) -> Tree a -> Tree a
adjustOffTree Word
0 Word
_ a -> a
f   (Lf a
x)     = forall a. a -> Tree a
Lf (a -> a
f a
x)
adjustOffTree Word
_ Word
_ a -> a
_ t :: Tree a
t@(Lf a
_)     = Tree a
t
adjustOffTree Word
0 Word
_ a -> a
f   (Nd a
x Tree a
l Tree a
r) = forall a. a -> Tree a -> Tree a -> Tree a
Nd (a -> a
f a
x) Tree a
l Tree a
r
adjustOffTree Word
i Word
s a -> a
f   (Nd a
x Tree a
l Tree a
r)
    | Word
i forall a. Ord a => a -> a -> Bool
<= Word
s'   = forall a. a -> Tree a -> Tree a -> Tree a
Nd a
x (forall a. Word -> Word -> (a -> a) -> Tree a -> Tree a
adjustOffTree (Word
i forall a. Num a => a -> a -> a
- Word
1) Word
s' a -> a
f Tree a
l) Tree a
r
    | Bool
otherwise = forall a. a -> Tree a -> Tree a -> Tree a
Nd a
x Tree a
l                              (forall a. Word -> Word -> (a -> a) -> Tree a -> Tree a
adjustOffTree (Word
i forall a. Num a => a -> a -> a
- Word
1 forall a. Num a => a -> a -> a
- Word
s') Word
s' a -> a
f Tree a
r)
  where
    s' :: Word
s' = Word -> Word
sizeDown Word
s

-- | Map over elements.
--
-- >>> map toUpper (fromList ['a'..'f'])
-- "ABCDEF"
--
map :: (a -> b) -> SkewList a -> SkewList b
map :: forall a b. (a -> b) -> SkewList a -> SkewList b
map = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

-- | Indexed map.
--
-- >>> imap (,) $ fromList ['a' .. 'f']
-- [(0,'a'),(1,'b'),(2,'c'),(3,'d'),(4,'e'),(5,'f')]
--
imap :: (Int -> a -> b) -> SkewList a -> SkewList b
imap :: forall a b. (Int -> a -> b) -> SkewList a -> SkewList b
imap = forall a b. Int -> (Int -> a -> b) -> SkewList a -> SkewList b
imapOff Int
0

imapOff :: Int -> (Int -> a -> b) -> SkewList a -> SkewList b
imapOff :: forall a b. Int -> (Int -> a -> b) -> SkewList a -> SkewList b
imapOff Int
_ Int -> a -> b
_ SkewList a
Nil            = forall a. SkewList a
Nil
imapOff Int
o Int -> a -> b
f (Cons_ Word
s Tree a
t SkewList a
xs) = forall a. Word -> Tree a -> SkewList a -> SkewList a
Cons_ Word
s (forall a b. Int -> Word -> (Int -> a -> b) -> Tree a -> Tree b
imapTreeOff Int
o Word
s Int -> a -> b
f Tree a
t) (forall a b. Int -> (Int -> a -> b) -> SkewList a -> SkewList b
imapOff (Int
o forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
s) Int -> a -> b
f SkewList a
xs)

imapTreeOff :: Int -> Word -> (Int -> a -> b) -> Tree a -> Tree b
imapTreeOff :: forall a b. Int -> Word -> (Int -> a -> b) -> Tree a -> Tree b
imapTreeOff Int
o Word
_ Int -> a -> b
f (Lf a
x)     = forall a. a -> Tree a
Lf (Int -> a -> b
f Int
o a
x)
imapTreeOff Int
o Word
s Int -> a -> b
f (Nd a
x Tree a
l Tree a
r) = forall a. a -> Tree a -> Tree a -> Tree a
Nd (Int -> a -> b
f Int
o a
x)
    (forall a b. Int -> Word -> (Int -> a -> b) -> Tree a -> Tree b
imapTreeOff (Int
o forall a. Num a => a -> a -> a
+ Int
1)                   Word
s' Int -> a -> b
f Tree a
l)
    (forall a b. Int -> Word -> (Int -> a -> b) -> Tree a -> Tree b
imapTreeOff (Int
o forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
s') Word
s' Int -> a -> b
f Tree a
r)
  where
    s' :: Word
s' = Word -> Word
sizeDown Word
s

-- | Indexed 'I.traverse'.
itraverse :: Applicative f => (Int -> a -> f b) -> SkewList a -> f (SkewList b)
itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f b) -> SkewList a -> f (SkewList b)
itraverse = forall (f :: * -> *) a b.
Applicative f =>
Int -> (Int -> a -> f b) -> SkewList a -> f (SkewList b)
itraverseOff Int
0

itraverseOff :: Applicative f => Int -> (Int -> a -> f b) -> SkewList a -> f (SkewList b)
itraverseOff :: forall (f :: * -> *) a b.
Applicative f =>
Int -> (Int -> a -> f b) -> SkewList a -> f (SkewList b)
itraverseOff Int
_ Int -> a -> f b
_ SkewList a
Nil            = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. SkewList a
Nil
itraverseOff Int
o Int -> a -> f b
f (Cons_ Word
s Tree a
t SkewList a
xs) = forall a. Word -> Tree a -> SkewList a -> SkewList a
Cons_ Word
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b.
Applicative f =>
Int -> Word -> (Int -> a -> f b) -> Tree a -> f (Tree b)
itraverseTreeOff Int
o Word
s Int -> a -> f b
f Tree a
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b.
Applicative f =>
Int -> (Int -> a -> f b) -> SkewList a -> f (SkewList b)
itraverseOff (Int
o forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
s) Int -> a -> f b
f SkewList a
xs

itraverseTreeOff :: Applicative f => Int -> Word -> (Int -> a -> f b) -> Tree a -> f (Tree b)
itraverseTreeOff :: forall (f :: * -> *) a b.
Applicative f =>
Int -> Word -> (Int -> a -> f b) -> Tree a -> f (Tree b)
itraverseTreeOff Int
o Word
_ Int -> a -> f b
f (Lf a
x)     = forall a. a -> Tree a
Lf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> f b
f Int
o a
x
itraverseTreeOff Int
o Word
s Int -> a -> f b
f (Nd a
x Tree a
l Tree a
r) = forall a. a -> Tree a -> Tree a -> Tree a
Nd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> f b
f Int
o a
x
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b.
Applicative f =>
Int -> Word -> (Int -> a -> f b) -> Tree a -> f (Tree b)
itraverseTreeOff (Int
o forall a. Num a => a -> a -> a
+ Int
1)                   Word
s' Int -> a -> f b
f Tree a
l
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b.
Applicative f =>
Int -> Word -> (Int -> a -> f b) -> Tree a -> f (Tree b)
itraverseTreeOff (Int
o forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
s') Word
s' Int -> a -> f b
f Tree a
r
  where
    s' :: Word
s' = Word -> Word
sizeDown Word
s

-------------------------------------------------------------------------------
-- QuickCheck
-------------------------------------------------------------------------------

instance QC.Arbitrary1 SkewList where
    liftArbitrary :: forall a. Gen a -> Gen (SkewList a)
liftArbitrary = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> SkewList a
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
QC.liftArbitrary
    liftShrink :: forall a. (a -> [a]) -> SkewList a -> [SkewList a]
liftShrink a -> [a]
shr = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> SkewList a
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
QC.liftShrink a -> [a]
shr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SkewList a -> [a]
toList

instance QC.Arbitrary a => QC.Arbitrary (SkewList a) where
    arbitrary :: Gen (SkewList a)
arbitrary = forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
QC.arbitrary1
    shrink :: SkewList a -> [SkewList a]
shrink    = forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => f a -> [f a]
QC.shrink1

instance QC.CoArbitrary a => QC.CoArbitrary (SkewList a) where
    coarbitrary :: forall b. SkewList a -> Gen b -> Gen b
coarbitrary = forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SkewList a -> [a]
toList

instance QC.Function a => QC.Function (SkewList a) where
    function :: forall b. (SkewList a -> b) -> SkewList a :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap forall a. SkewList a -> [a]
toList forall a. [a] -> SkewList a
fromList

-------------------------------------------------------------------------------
-- Strict
-------------------------------------------------------------------------------

instance Strict (SkewList a) (Strict.SkewList a) where
    toLazy :: SkewList a -> SkewList a
toLazy SkewList a
Strict.Nil            = forall a. SkewList a
Nil
    toLazy (Strict.Cons_ Word
s Tree a
t SkewList a
xs) = forall a. Word -> Tree a -> SkewList a -> SkewList a
Cons_ Word
s (forall lazy strict. Strict lazy strict => strict -> lazy
toLazy Tree a
t) (forall lazy strict. Strict lazy strict => strict -> lazy
toLazy SkewList a
xs)

    toStrict :: SkewList a -> SkewList a
toStrict SkewList a
Nil            = forall a. SkewList a
Strict.Nil
    toStrict (Cons_ Word
s Tree a
t SkewList a
xs) = forall a. Word -> Tree a -> SkewList a -> SkewList a
Strict.Cons_ Word
s (forall lazy strict. Strict lazy strict => lazy -> strict
toStrict Tree a
t) (forall lazy strict. Strict lazy strict => lazy -> strict
toStrict SkewList a
xs)

instance Strict (Tree a) (Strict.Tree a) where
    toLazy :: Tree a -> Tree a
toLazy (Strict.Lf a
x)     = forall a. a -> Tree a
Lf a
x
    toLazy (Strict.Nd a
x Tree a
l Tree a
r) = forall a. a -> Tree a -> Tree a -> Tree a
Nd a
x (forall lazy strict. Strict lazy strict => strict -> lazy
toLazy Tree a
l) (forall lazy strict. Strict lazy strict => strict -> lazy
toLazy Tree a
r)

    toStrict :: Tree a -> Tree a
toStrict (Lf a
x)     = forall a. a -> Tree a
Strict.Lf a
x
    toStrict (Nd a
x Tree a
l Tree a
r) = forall a. a -> Tree a -> Tree a -> Tree a
Strict.Nd a
x (forall lazy strict. Strict lazy strict => lazy -> strict
toStrict Tree a
l) (forall lazy strict. Strict lazy strict => lazy -> strict
toStrict Tree a
r)