{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}

-- Note: Parts of the documentation are based on/are directly copied from
-- documentation in the @Data.FingerTree.Strict@ module.
module Data.FingerTree.RootMeasured.Strict
  ( -- * Strict finger trees with root measures
    StrictFingerTree

    -- * Measuring
  , Measured (..)
  , RootMeasured (..)
  , SuperMeasured

    -- * Construction
  , fromList
  , (|>)

    -- * Splitting
  , Sized (..)
  , SplitRootMeasure (..)
  , split
  , splitSized
  , splitl
  , splitr

    -- * Maps
  , fmap'
  , fmap''
  ) where

import Data.FingerTree.Strict (Measured)
import qualified Data.FingerTree.Strict as FT
import Data.Foldable (Foldable (toList))
import Data.Semigroup.Cancellative
  ( LeftCancellative
  , LeftReductive (..)
  , RightCancellative
  , RightReductive (..)
  )
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..), noThunksInValues)

{-------------------------------------------------------------------------------
  Strict finger trees with root measures
-------------------------------------------------------------------------------}

-- | A @StrictFingerTree@ with elements of type @a@, an internal measure of type
-- @vi@, and a root measure of type @vr@.
data StrictFingerTree vr vi a = SFT
  { forall vr vi a. StrictFingerTree vr vi a -> vr
rm :: vr
  , forall vr vi a. StrictFingerTree vr vi a -> StrictFingerTree vi a
elements :: !(FT.StrictFingerTree vi a)
  }
  deriving (Int -> StrictFingerTree vr vi a -> ShowS
[StrictFingerTree vr vi a] -> ShowS
StrictFingerTree vr vi a -> String
(Int -> StrictFingerTree vr vi a -> ShowS)
-> (StrictFingerTree vr vi a -> String)
-> ([StrictFingerTree vr vi a] -> ShowS)
-> Show (StrictFingerTree vr vi a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall vr vi a.
(Show vr, Show a) =>
Int -> StrictFingerTree vr vi a -> ShowS
forall vr vi a.
(Show vr, Show a) =>
[StrictFingerTree vr vi a] -> ShowS
forall vr vi a.
(Show vr, Show a) =>
StrictFingerTree vr vi a -> String
$cshowsPrec :: forall vr vi a.
(Show vr, Show a) =>
Int -> StrictFingerTree vr vi a -> ShowS
showsPrec :: Int -> StrictFingerTree vr vi a -> ShowS
$cshow :: forall vr vi a.
(Show vr, Show a) =>
StrictFingerTree vr vi a -> String
show :: StrictFingerTree vr vi a -> String
$cshowList :: forall vr vi a.
(Show vr, Show a) =>
[StrictFingerTree vr vi a] -> ShowS
showList :: [StrictFingerTree vr vi a] -> ShowS
Show, StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool
(StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool)
-> (StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool)
-> Eq (StrictFingerTree vr vi a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall vr vi a.
(Eq vr, Eq a) =>
StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool
$c== :: forall vr vi a.
(Eq vr, Eq a) =>
StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool
== :: StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool
$c/= :: forall vr vi a.
(Eq vr, Eq a) =>
StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool
/= :: StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool
Eq, Eq (StrictFingerTree vr vi a)
Eq (StrictFingerTree vr vi a) =>
(StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Ordering)
-> (StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool)
-> (StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool)
-> (StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool)
-> (StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool)
-> (StrictFingerTree vr vi a
    -> StrictFingerTree vr vi a -> StrictFingerTree vr vi a)
-> (StrictFingerTree vr vi a
    -> StrictFingerTree vr vi a -> StrictFingerTree vr vi a)
-> Ord (StrictFingerTree vr vi a)
StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool
StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Ordering
StrictFingerTree vr vi a
-> StrictFingerTree vr vi a -> StrictFingerTree vr vi a
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 vr vi a. (Ord vr, Ord a) => Eq (StrictFingerTree vr vi a)
forall vr vi a.
(Ord vr, Ord a) =>
StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool
forall vr vi a.
(Ord vr, Ord a) =>
StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Ordering
forall vr vi a.
(Ord vr, Ord a) =>
StrictFingerTree vr vi a
-> StrictFingerTree vr vi a -> StrictFingerTree vr vi a
$ccompare :: forall vr vi a.
(Ord vr, Ord a) =>
StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Ordering
compare :: StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Ordering
$c< :: forall vr vi a.
(Ord vr, Ord a) =>
StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool
< :: StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool
$c<= :: forall vr vi a.
(Ord vr, Ord a) =>
StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool
<= :: StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool
$c> :: forall vr vi a.
(Ord vr, Ord a) =>
StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool
> :: StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool
$c>= :: forall vr vi a.
(Ord vr, Ord a) =>
StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool
>= :: StrictFingerTree vr vi a -> StrictFingerTree vr vi a -> Bool
$cmax :: forall vr vi a.
(Ord vr, Ord a) =>
StrictFingerTree vr vi a
-> StrictFingerTree vr vi a -> StrictFingerTree vr vi a
max :: StrictFingerTree vr vi a
-> StrictFingerTree vr vi a -> StrictFingerTree vr vi a
$cmin :: forall vr vi a.
(Ord vr, Ord a) =>
StrictFingerTree vr vi a
-> StrictFingerTree vr vi a -> StrictFingerTree vr vi a
min :: StrictFingerTree vr vi a
-> StrictFingerTree vr vi a -> StrictFingerTree vr vi a
Ord, (forall x.
 StrictFingerTree vr vi a -> Rep (StrictFingerTree vr vi a) x)
-> (forall x.
    Rep (StrictFingerTree vr vi a) x -> StrictFingerTree vr vi a)
-> Generic (StrictFingerTree vr vi a)
forall x.
Rep (StrictFingerTree vr vi a) x -> StrictFingerTree vr vi a
forall x.
StrictFingerTree vr vi a -> Rep (StrictFingerTree vr vi a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall vr vi a x.
Rep (StrictFingerTree vr vi a) x -> StrictFingerTree vr vi a
forall vr vi a x.
StrictFingerTree vr vi a -> Rep (StrictFingerTree vr vi a) x
$cfrom :: forall vr vi a x.
StrictFingerTree vr vi a -> Rep (StrictFingerTree vr vi a) x
from :: forall x.
StrictFingerTree vr vi a -> Rep (StrictFingerTree vr vi a) x
$cto :: forall vr vi a x.
Rep (StrictFingerTree vr vi a) x -> StrictFingerTree vr vi a
to :: forall x.
Rep (StrictFingerTree vr vi a) x -> StrictFingerTree vr vi a
Generic)

instance Foldable (StrictFingerTree vr vi) where
  foldMap :: forall m a. Monoid m => (a -> m) -> StrictFingerTree vr vi a -> m
foldMap a -> m
f = (a -> m) -> StrictFingerTree vi a -> m
forall m a. Monoid m => (a -> m) -> StrictFingerTree vi a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (StrictFingerTree vi a -> m)
-> (StrictFingerTree vr vi a -> StrictFingerTree vi a)
-> StrictFingerTree vr vi a
-> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictFingerTree vr vi a -> StrictFingerTree vi a
forall vr vi a. StrictFingerTree vr vi a -> StrictFingerTree vi a
elements

instance NoThunks a => NoThunks (StrictFingerTree vr vi a) where
  showTypeOf :: Proxy (StrictFingerTree vr vi a) -> String
showTypeOf Proxy (StrictFingerTree vr vi a)
_ = String
"StrictFingerTree'"
  wNoThunks :: Context -> StrictFingerTree vr vi a -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt = Context -> [a] -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> [a] -> IO (Maybe ThunkInfo)
noThunksInValues Context
ctxt ([a] -> IO (Maybe ThunkInfo))
-> (StrictFingerTree vr vi a -> [a])
-> StrictFingerTree vr vi a
-> IO (Maybe ThunkInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictFingerTree vr vi a -> [a]
forall a. StrictFingerTree vr vi a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance
  (Semigroup vr, Measured vi a) =>
  Semigroup (StrictFingerTree vr vi a)
  where
  SFT vr
tm1 StrictFingerTree vi a
xs1 <> :: StrictFingerTree vr vi a
-> StrictFingerTree vr vi a -> StrictFingerTree vr vi a
<> SFT vr
tm2 StrictFingerTree vi a
xs2 = vr -> StrictFingerTree vi a -> StrictFingerTree vr vi a
forall vr vi a.
vr -> StrictFingerTree vi a -> StrictFingerTree vr vi a
SFT (vr
tm1 vr -> vr -> vr
forall a. Semigroup a => a -> a -> a
<> vr
tm2) (StrictFingerTree vi a
xs1 StrictFingerTree vi a
-> StrictFingerTree vi a -> StrictFingerTree vi a
forall v a.
Measured v a =>
StrictFingerTree v a
-> StrictFingerTree v a -> StrictFingerTree v a
FT.>< StrictFingerTree vi a
xs2)

instance (Monoid vr, Measured vi a) => Monoid (StrictFingerTree vr vi a) where
  mempty :: StrictFingerTree vr vi a
mempty = vr -> StrictFingerTree vi a -> StrictFingerTree vr vi a
forall vr vi a.
vr -> StrictFingerTree vi a -> StrictFingerTree vr vi a
SFT vr
forall a. Monoid a => a
mempty StrictFingerTree vi a
forall v a. Measured v a => StrictFingerTree v a
FT.empty

{-------------------------------------------------------------------------------
  Measuring
-------------------------------------------------------------------------------}

-- | All @'StrictFingerTree'@s are internally measured.
instance Measured vi a => Measured vi (StrictFingerTree vr vi a) where
  measure :: StrictFingerTree vr vi a -> vi
measure = StrictFingerTree vi a -> vi
forall v a. Measured v a => a -> v
FT.measure (StrictFingerTree vi a -> vi)
-> (StrictFingerTree vr vi a -> StrictFingerTree vi a)
-> StrictFingerTree vr vi a
-> vi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictFingerTree vr vi a -> StrictFingerTree vi a
forall vr vi a. StrictFingerTree vr vi a -> StrictFingerTree vi a
elements

-- | Re-iteration of @'Measured'@, but for root measures.
--
-- This re-iteration is necessary because we want to allow the root measure to
-- be distinct from the internal measure. For example, we can not create both of
-- these instances for distinct types @T@ and @T'@:
--
-- > instance Measured T  a where -- ...
--
-- > instance Measured T' a where -- ...
--
-- Furthermore, we want the root measure to be a cancellative monoid.
class
  (LeftCancellative v, RightCancellative v, Monoid v) =>
  RootMeasured v a
    | a -> v
  where
  measureRoot :: a -> v

-- | All @'StrictFingerTree'@s are root measured.
instance RootMeasured vr a => RootMeasured vr (StrictFingerTree vr vi a) where
  measureRoot :: StrictFingerTree vr vi a -> vr
measureRoot = StrictFingerTree vr vi a -> vr
forall vr vi a. StrictFingerTree vr vi a -> vr
rm

-- | Conjunction of @'RootMeasured'@ and @'Measured'@ constraints.
type SuperMeasured vr vi a = (RootMeasured vr a, Measured vi a)

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

infixl 5 |>

-- | /O(1)/. Add an element to the right end of a sequence.
--
-- Mnemonic: a triangle with the single element at the pointy end.
(|>) ::
  SuperMeasured vr vi a =>
  StrictFingerTree vr vi a ->
  a ->
  StrictFingerTree vr vi a
SFT vr
vr StrictFingerTree vi a
sft |> :: forall vr vi a.
SuperMeasured vr vi a =>
StrictFingerTree vr vi a -> a -> StrictFingerTree vr vi a
|> (!a
a) = vr -> StrictFingerTree vi a -> StrictFingerTree vr vi a
forall vr vi a.
vr -> StrictFingerTree vi a -> StrictFingerTree vr vi a
SFT (vr
vr vr -> vr -> vr
forall a. Semigroup a => a -> a -> a
<> a -> vr
forall v a. RootMeasured v a => a -> v
measureRoot a
a) (StrictFingerTree vi a
sft StrictFingerTree vi a -> a -> StrictFingerTree vi a
forall v a.
Measured v a =>
StrictFingerTree v a -> a -> StrictFingerTree v a
FT.|> a
a)

-- | /O(n)/. Create a sequence from a finite list of elements. The opposite
-- operation @'toList'@ is supplied by the @'Foldable'@ instance.
fromList :: SuperMeasured vr vi a => [a] -> StrictFingerTree vr vi a
fromList :: forall vr vi a.
SuperMeasured vr vi a =>
[a] -> StrictFingerTree vr vi a
fromList ![a]
xs = vr -> StrictFingerTree vi a -> StrictFingerTree vr vi a
forall vr vi a.
vr -> StrictFingerTree vi a -> StrictFingerTree vr vi a
SFT ((a -> vr) -> [a] -> vr
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> vr
forall v a. RootMeasured v a => a -> v
measureRoot [a]
xs) ([a] -> StrictFingerTree vi a
forall v a. Measured v a => [a] -> StrictFingerTree v a
FT.fromList [a]
xs)

{-------------------------------------------------------------------------------
  Splitting
-------------------------------------------------------------------------------}

-- | /O(log(min(i,n-i))) + O(f(l, r))/. Split a sequence at a point where the
-- predicate on the accumulated /internal/ measure of the prefix changes from
-- 'False' to 'True'.
--
-- For predictable results, one should ensure that there is only one such point,
-- i.e. that the predicate is /monotonic/.
--
-- A @'SplitRootMeasure'@ function @f@ should be provided that computes the root
-- measures of the left and right parts of the split. Since the @vr@ type is a
-- cancellative monoid, we can use 'stripPrefix' and 'stripSuffix' to compute
-- the root measures: see @'splitl'@ and @'splitr'@.
--
-- Note on time complexity: the @log@ factor comes from @'FT.split'@. Moreover,
-- the @log@ factor of the time complexity is determined by the smallest part of
-- the split: the result of /(min(i, n-i))/ is either @i@ or @n-i@, which are
-- the lengths of the split parts.
--
-- Denotations for time complexity: @n@ denotes the length of the input of the
-- split. @i@ denotes the length of left part of the split result. @l@ denotes
-- the left part of the split result. @r@ denotes the right part of the split
-- result. @f@ denotes a @'SplitRootMeasure'@ function. @length@ denotes a
-- function that computes the length of a finger tree.
split ::
  SuperMeasured vr vi a =>
  (vi -> Bool) ->
  SplitRootMeasure vr vi a ->
  StrictFingerTree vr vi a ->
  ( StrictFingerTree vr vi a
  , StrictFingerTree vr vi a
  )
split :: forall vr vi a.
SuperMeasured vr vi a =>
(vi -> Bool)
-> SplitRootMeasure vr vi a
-> StrictFingerTree vr vi a
-> (StrictFingerTree vr vi a, StrictFingerTree vr vi a)
split vi -> Bool
p SplitRootMeasure vr vi a
f (SFT vr
vr StrictFingerTree vi a
sft) = (vr -> StrictFingerTree vi a -> StrictFingerTree vr vi a
forall vr vi a.
vr -> StrictFingerTree vi a -> StrictFingerTree vr vi a
SFT vr
vrLeft StrictFingerTree vi a
left, vr -> StrictFingerTree vi a -> StrictFingerTree vr vi a
forall vr vi a.
vr -> StrictFingerTree vi a -> StrictFingerTree vr vi a
SFT vr
vrRight StrictFingerTree vi a
right)
 where
  (StrictFingerTree vi a
left, StrictFingerTree vi a
right) = (vi -> Bool)
-> StrictFingerTree vi a
-> (StrictFingerTree vi a, StrictFingerTree vi a)
forall v a.
Measured v a =>
(v -> Bool)
-> StrictFingerTree v a
-> (StrictFingerTree v a, StrictFingerTree v a)
FT.split vi -> Bool
p StrictFingerTree vi a
sft
  (vr
vrLeft, vr
vrRight) = SplitRootMeasure vr vi a
-> vr -> (StrictFingerTree vi a, StrictFingerTree vi a) -> (vr, vr)
forall vr vi a.
SplitRootMeasure vr vi a
-> vr -> (StrictFingerTree vi a, StrictFingerTree vi a) -> (vr, vr)
unSplitRootMeasure SplitRootMeasure vr vi a
f vr
vr (StrictFingerTree vi a
left, StrictFingerTree vi a
right)

-- | A function that computes the root measures of the left and right parts of a
-- split.
--
-- The function's arguments are:
-- * The root measure of the input of the split function, and
-- * The left and right parts of the split.
newtype SplitRootMeasure vr vi a = SplitRootMeasure
  { forall vr vi a.
SplitRootMeasure vr vi a
-> vr -> (StrictFingerTree vi a, StrictFingerTree vi a) -> (vr, vr)
unSplitRootMeasure ::
      vr ->
      ( FT.StrictFingerTree vi a
      , FT.StrictFingerTree vi a
      ) ->
      (vr, vr)
  }

-- | /O(log(min(i,n-i))) + O(i)/. Specialisation of @'split'@ that is fast if
-- @i@ is small.
splitl ::
  SuperMeasured vr vi a =>
  (vi -> Bool) ->
  StrictFingerTree vr vi a ->
  ( StrictFingerTree vr vi a
  , StrictFingerTree vr vi a
  )
splitl :: forall vr vi a.
SuperMeasured vr vi a =>
(vi -> Bool)
-> StrictFingerTree vr vi a
-> (StrictFingerTree vr vi a, StrictFingerTree vr vi a)
splitl vi -> Bool
p = (vi -> Bool)
-> SplitRootMeasure vr vi a
-> StrictFingerTree vr vi a
-> (StrictFingerTree vr vi a, StrictFingerTree vr vi a)
forall vr vi a.
SuperMeasured vr vi a =>
(vi -> Bool)
-> SplitRootMeasure vr vi a
-> StrictFingerTree vr vi a
-> (StrictFingerTree vr vi a, StrictFingerTree vr vi a)
split vi -> Bool
p (SplitRootMeasure vr vi a
 -> StrictFingerTree vr vi a
 -> (StrictFingerTree vr vi a, StrictFingerTree vr vi a))
-> SplitRootMeasure vr vi a
-> StrictFingerTree vr vi a
-> (StrictFingerTree vr vi a, StrictFingerTree vr vi a)
forall a b. (a -> b) -> a -> b
$ (vr -> (StrictFingerTree vi a, StrictFingerTree vi a) -> (vr, vr))
-> SplitRootMeasure vr vi a
forall vr vi a.
(vr -> (StrictFingerTree vi a, StrictFingerTree vi a) -> (vr, vr))
-> SplitRootMeasure vr vi a
SplitRootMeasure ((vr -> (StrictFingerTree vi a, StrictFingerTree vi a) -> (vr, vr))
 -> SplitRootMeasure vr vi a)
-> (vr
    -> (StrictFingerTree vi a, StrictFingerTree vi a) -> (vr, vr))
-> SplitRootMeasure vr vi a
forall a b. (a -> b) -> a -> b
$ \vr
vr (StrictFingerTree vi a
l, StrictFingerTree vi a
_r) ->
  let vrl :: vr
vrl = (a -> vr) -> StrictFingerTree vi a -> vr
forall m a. Monoid m => (a -> m) -> StrictFingerTree vi a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> vr
forall v a. RootMeasured v a => a -> v
measureRoot StrictFingerTree vi a
l
   in (vr
vrl, Maybe vr -> vr
forall a. Maybe a -> a
errorIfStripFailed (Maybe vr -> vr) -> Maybe vr -> vr
forall a b. (a -> b) -> a -> b
$ vr -> vr -> Maybe vr
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix vr
vrl vr
vr)

-- | /O(log(min(i,n-i))) + O(n-i)/. Specialisation of @'split'@ that is fast if
-- if @i@ is large.
splitr ::
  SuperMeasured vr vi a =>
  (vi -> Bool) ->
  StrictFingerTree vr vi a ->
  ( StrictFingerTree vr vi a
  , StrictFingerTree vr vi a
  )
splitr :: forall vr vi a.
SuperMeasured vr vi a =>
(vi -> Bool)
-> StrictFingerTree vr vi a
-> (StrictFingerTree vr vi a, StrictFingerTree vr vi a)
splitr vi -> Bool
p = (vi -> Bool)
-> SplitRootMeasure vr vi a
-> StrictFingerTree vr vi a
-> (StrictFingerTree vr vi a, StrictFingerTree vr vi a)
forall vr vi a.
SuperMeasured vr vi a =>
(vi -> Bool)
-> SplitRootMeasure vr vi a
-> StrictFingerTree vr vi a
-> (StrictFingerTree vr vi a, StrictFingerTree vr vi a)
split vi -> Bool
p (SplitRootMeasure vr vi a
 -> StrictFingerTree vr vi a
 -> (StrictFingerTree vr vi a, StrictFingerTree vr vi a))
-> SplitRootMeasure vr vi a
-> StrictFingerTree vr vi a
-> (StrictFingerTree vr vi a, StrictFingerTree vr vi a)
forall a b. (a -> b) -> a -> b
$ (vr -> (StrictFingerTree vi a, StrictFingerTree vi a) -> (vr, vr))
-> SplitRootMeasure vr vi a
forall vr vi a.
(vr -> (StrictFingerTree vi a, StrictFingerTree vi a) -> (vr, vr))
-> SplitRootMeasure vr vi a
SplitRootMeasure ((vr -> (StrictFingerTree vi a, StrictFingerTree vi a) -> (vr, vr))
 -> SplitRootMeasure vr vi a)
-> (vr
    -> (StrictFingerTree vi a, StrictFingerTree vi a) -> (vr, vr))
-> SplitRootMeasure vr vi a
forall a b. (a -> b) -> a -> b
$ \vr
vr (StrictFingerTree vi a
_l, StrictFingerTree vi a
r) ->
  let vrr :: vr
vrr = (a -> vr) -> StrictFingerTree vi a -> vr
forall m a. Monoid m => (a -> m) -> StrictFingerTree vi a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> vr
forall v a. RootMeasured v a => a -> v
measureRoot StrictFingerTree vi a
r
   in (Maybe vr -> vr
forall a. Maybe a -> a
errorIfStripFailed (Maybe vr -> vr) -> Maybe vr -> vr
forall a b. (a -> b) -> a -> b
$ vr -> vr -> Maybe vr
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix vr
vrr vr
vr, vr
vrr)

class Sized a where
  size :: a -> Int

-- | /O(log(min(i,n-i))) + O(min(i,n-i))/. Specialisation of @'split'@ that
-- automatically determines whether @i@ or @n-i@ is smallest.
--
-- Note: a way to view @'splitSized'@ is as being equivalent to a function that
-- delegates to @'splitl'@ or @'splitr'@ based on whether @i@ or @n-i@ are
-- smallest respectively.
splitSized ::
  (SuperMeasured vr vi a, Sized vi) =>
  (vi -> Bool) ->
  StrictFingerTree vr vi a ->
  ( StrictFingerTree vr vi a
  , StrictFingerTree vr vi a
  )
splitSized :: forall vr vi a.
(SuperMeasured vr vi a, Sized vi) =>
(vi -> Bool)
-> StrictFingerTree vr vi a
-> (StrictFingerTree vr vi a, StrictFingerTree vr vi a)
splitSized vi -> Bool
p = (vi -> Bool)
-> SplitRootMeasure vr vi a
-> StrictFingerTree vr vi a
-> (StrictFingerTree vr vi a, StrictFingerTree vr vi a)
forall vr vi a.
SuperMeasured vr vi a =>
(vi -> Bool)
-> SplitRootMeasure vr vi a
-> StrictFingerTree vr vi a
-> (StrictFingerTree vr vi a, StrictFingerTree vr vi a)
split vi -> Bool
p (SplitRootMeasure vr vi a
 -> StrictFingerTree vr vi a
 -> (StrictFingerTree vr vi a, StrictFingerTree vr vi a))
-> SplitRootMeasure vr vi a
-> StrictFingerTree vr vi a
-> (StrictFingerTree vr vi a, StrictFingerTree vr vi a)
forall a b. (a -> b) -> a -> b
$ (vr -> (StrictFingerTree vi a, StrictFingerTree vi a) -> (vr, vr))
-> SplitRootMeasure vr vi a
forall vr vi a.
(vr -> (StrictFingerTree vi a, StrictFingerTree vi a) -> (vr, vr))
-> SplitRootMeasure vr vi a
SplitRootMeasure ((vr -> (StrictFingerTree vi a, StrictFingerTree vi a) -> (vr, vr))
 -> SplitRootMeasure vr vi a)
-> (vr
    -> (StrictFingerTree vi a, StrictFingerTree vi a) -> (vr, vr))
-> SplitRootMeasure vr vi a
forall a b. (a -> b) -> a -> b
$ \vr
vr (StrictFingerTree vi a
l, StrictFingerTree vi a
r) ->
  let
    (Int
sizel, Int
sizer) = (vi -> Int
forall a. Sized a => a -> Int
size (StrictFingerTree vi a -> vi
forall v a. Measured v a => a -> v
FT.measure StrictFingerTree vi a
l), vi -> Int
forall a. Sized a => a -> Int
size (StrictFingerTree vi a -> vi
forall v a. Measured v a => a -> v
FT.measure StrictFingerTree vi a
r))
   in
    if Int
sizel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
sizer
      then
        let vrl :: vr
vrl = (a -> vr) -> StrictFingerTree vi a -> vr
forall m a. Monoid m => (a -> m) -> StrictFingerTree vi a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> vr
forall v a. RootMeasured v a => a -> v
measureRoot StrictFingerTree vi a
l
         in (vr
vrl, Maybe vr -> vr
forall a. Maybe a -> a
errorIfStripFailed (Maybe vr -> vr) -> Maybe vr -> vr
forall a b. (a -> b) -> a -> b
$ vr -> vr -> Maybe vr
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix vr
vrl vr
vr)
      else
        let vrr :: vr
vrr = (a -> vr) -> StrictFingerTree vi a -> vr
forall m a. Monoid m => (a -> m) -> StrictFingerTree vi a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> vr
forall v a. RootMeasured v a => a -> v
measureRoot StrictFingerTree vi a
r
         in (Maybe vr -> vr
forall a. Maybe a -> a
errorIfStripFailed (Maybe vr -> vr) -> Maybe vr -> vr
forall a b. (a -> b) -> a -> b
$ vr -> vr -> Maybe vr
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix vr
vrr vr
vr, vr
vrr)

errorIfStripFailed :: Maybe a -> a
errorIfStripFailed :: forall a. Maybe a -> a
errorIfStripFailed (Just a
x) = a
x
errorIfStripFailed Maybe a
Nothing =
  String -> a
forall a. HasCallStack => String -> a
error
    String
"stripPrefix/stripSuffix: stripping a \
    \prefix or suffix failed, but that should \
    \be impossible. Are you sure the root \
    \measure is truly a cancellative monoid?"

{-------------------------------------------------------------------------------
  Maps
-------------------------------------------------------------------------------}

-- | Like @'fmap'@, but with constraints on the element types.
--
-- Note: @vr2@ is reconstructed in time linear in the size of the finger tree.
fmap' ::
  ( SuperMeasured vr1 vi1 a1
  , SuperMeasured vr2 vi2 a2
  ) =>
  (a1 -> a2) ->
  StrictFingerTree vr1 vi1 a1 ->
  StrictFingerTree vr2 vi2 a2
fmap' :: forall vr1 vi1 a1 vr2 vi2 a2.
(SuperMeasured vr1 vi1 a1, SuperMeasured vr2 vi2 a2) =>
(a1 -> a2)
-> StrictFingerTree vr1 vi1 a1 -> StrictFingerTree vr2 vi2 a2
fmap' a1 -> a2
f (SFT vr1
_ StrictFingerTree vi1 a1
sft) = vr2 -> StrictFingerTree vi2 a2 -> StrictFingerTree vr2 vi2 a2
forall vr vi a.
vr -> StrictFingerTree vi a -> StrictFingerTree vr vi a
SFT vr2
vr' StrictFingerTree vi2 a2
sft'
 where
  sft' :: StrictFingerTree vi2 a2
sft' = (a1 -> a2) -> StrictFingerTree vi1 a1 -> StrictFingerTree vi2 a2
forall v1 a1 v2 a2.
(Measured v1 a1, Measured v2 a2) =>
(a1 -> a2) -> StrictFingerTree v1 a1 -> StrictFingerTree v2 a2
FT.fmap' a1 -> a2
f StrictFingerTree vi1 a1
sft
  vr' :: vr2
vr' = (a2 -> vr2) -> StrictFingerTree vi2 a2 -> vr2
forall m a. Monoid m => (a -> m) -> StrictFingerTree vi2 a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a2 -> vr2
forall v a. RootMeasured v a => a -> v
measureRoot StrictFingerTree vi2 a2
sft'

-- | Like @'fmap''@, but without the linear-time reconstruction of the root
-- level measure.
--
-- Though similar to @'fmap''@, this function also requires a function parameter
-- of root measures to root measures. This function ensures that we do not have
-- to reconstruct @vr2@ from the elements of the finger tree.
fmap'' ::
  ( SuperMeasured vr1 vi1 a1
  , SuperMeasured vr2 vi2 a2
  ) =>
  (a1 -> a2) ->
  (vr1 -> vr2) ->
  StrictFingerTree vr1 vi1 a1 ->
  StrictFingerTree vr2 vi2 a2
fmap'' :: forall vr1 vi1 a1 vr2 vi2 a2.
(SuperMeasured vr1 vi1 a1, SuperMeasured vr2 vi2 a2) =>
(a1 -> a2)
-> (vr1 -> vr2)
-> StrictFingerTree vr1 vi1 a1
-> StrictFingerTree vr2 vi2 a2
fmap'' a1 -> a2
f vr1 -> vr2
g (SFT vr1
vr StrictFingerTree vi1 a1
sft) = vr2 -> StrictFingerTree vi2 a2 -> StrictFingerTree vr2 vi2 a2
forall vr vi a.
vr -> StrictFingerTree vi a -> StrictFingerTree vr vi a
SFT vr2
vr' StrictFingerTree vi2 a2
sft'
 where
  sft' :: StrictFingerTree vi2 a2
sft' = (a1 -> a2) -> StrictFingerTree vi1 a1 -> StrictFingerTree vi2 a2
forall v1 a1 v2 a2.
(Measured v1 a1, Measured v2 a2) =>
(a1 -> a2) -> StrictFingerTree v1 a1 -> StrictFingerTree v2 a2
FT.fmap' a1 -> a2
f StrictFingerTree vi1 a1
sft
  vr' :: vr2
vr' = vr1 -> vr2
g vr1
vr