{- 
    Copyright 2013-2019 Mario Blazevic

    License: BSD3 (see BSD3-LICENSE.txt file)
-}

-- | This module defines the monoid transformer data type 'Concat'.
-- 

{-# LANGUAGE Haskell2010 #-}

module Data.Monoid.Instances.Concat (
   Concat, concatenate, extract, force
   )
where

import Control.Applicative -- (Applicative(..))
import Control.Arrow (first)
import qualified Data.Foldable as Foldable
import qualified Data.List as List
import Data.String (IsString(..))
import Data.Semigroup (Semigroup(..))
import Data.Monoid (Monoid(..), First(..), Sum(..))
import Data.Semigroup.Cancellative (LeftReductive(..), RightReductive(..))
import Data.Semigroup.Factorial (Factorial(..), StableFactorial)
import Data.Monoid.GCD (LeftGCDMonoid(..), RightGCDMonoid(..))
import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)
import Data.Monoid.Factorial (FactorialMonoid(..))
import Data.Monoid.Textual (TextualMonoid(..))
import qualified Data.Monoid.Factorial as Factorial
import qualified Data.Monoid.Textual as Textual
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq

import Prelude hiding (all, any, break, filter, foldl, foldl1, foldr, foldr1, map, concatMap,
                       length, null, reverse, scanl, scanr, scanl1, scanr1, span, splitAt, pi)

-- | @'Concat'@ is a transparent monoid transformer. The behaviour of the @'Concat' a@ instances of monoid subclasses is
-- identical to the behaviour of their @a@ instances, up to the 'pure' isomorphism.
--
-- The only purpose of 'Concat' then is to change the performance characteristics of various operations. Most
-- importantly, injecting a monoid into 'Concat' has the effect of making 'mappend' a constant-time operation. The
-- `splitPrimePrefix` and `splitPrimeSuffix` operations are amortized to constant time, provided that only one or the
-- other is used. Using both operations alternately will trigger the worst-case behaviour of O(n).
--
data Concat a = Leaf a
              | Concat a :<> Concat a
              deriving Int -> Concat a -> ShowS
[Concat a] -> ShowS
Concat a -> String
(Int -> Concat a -> ShowS)
-> (Concat a -> String) -> ([Concat a] -> ShowS) -> Show (Concat a)
forall a. Show a => Int -> Concat a -> ShowS
forall a. Show a => [Concat a] -> ShowS
forall a. Show a => Concat a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Concat a] -> ShowS
$cshowList :: forall a. Show a => [Concat a] -> ShowS
show :: Concat a -> String
$cshow :: forall a. Show a => Concat a -> String
showsPrec :: Int -> Concat a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Concat a -> ShowS
Show

{-# DEPRECATED concatenate, extract "Concat is not wrapping Seq any more, don't use concatenate nor extract." #-}
concatenate :: PositiveMonoid a => Seq a -> Concat a
concatenate :: Seq a -> Concat a
concatenate q :: Seq a
q
   | (a -> Bool) -> Seq a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Foldable.all a -> Bool
forall m. MonoidNull m => m -> Bool
null Seq a
q = Concat a
forall a. Monoid a => a
mempty
   | Bool
otherwise = (a -> Concat a -> Concat a) -> Concat a -> Seq a -> Concat a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr (\a :: a
a c :: Concat a
c-> if a -> Bool
forall m. MonoidNull m => m -> Bool
null a
a then Concat a
c else a -> Concat a
forall a. a -> Concat a
Leaf a
a Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
c) Concat a
forall a. Monoid a => a
mempty Seq a
q

extract :: Concat a -> Seq a
extract :: Concat a -> Seq a
extract = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> (Concat a -> [a]) -> Concat a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Concat a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList

force :: Semigroup a => Concat a -> a
force :: Concat a -> a
force (Leaf x :: a
x) = a
x
force (x :: Concat a
x :<> y :: Concat a
y) = Concat a -> a
forall a. Semigroup a => Concat a -> a
force Concat a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Concat a -> a
forall a. Semigroup a => Concat a -> a
force Concat a
y

instance (Eq a, Semigroup a) => Eq (Concat a) where
   x :: Concat a
x == :: Concat a -> Concat a -> Bool
== y :: Concat a
y = Concat a -> a
forall a. Semigroup a => Concat a -> a
force Concat a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Concat a -> a
forall a. Semigroup a => Concat a -> a
force Concat a
y

instance (Ord a, Semigroup a) => Ord (Concat a) where
   compare :: Concat a -> Concat a -> Ordering
compare x :: Concat a
x y :: Concat a
y = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Concat a -> a
forall a. Semigroup a => Concat a -> a
force Concat a
x) (Concat a -> a
forall a. Semigroup a => Concat a -> a
force Concat a
y)

instance Functor Concat where
   fmap :: (a -> b) -> Concat a -> Concat b
fmap f :: a -> b
f (Leaf x :: a
x) = b -> Concat b
forall a. a -> Concat a
Leaf (a -> b
f a
x)
   fmap f :: a -> b
f (l :: Concat a
l :<> r :: Concat a
r) = (a -> b) -> Concat a -> Concat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Concat a
l Concat b -> Concat b -> Concat b
forall a. Concat a -> Concat a -> Concat a
:<> (a -> b) -> Concat a -> Concat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Concat a
r

instance Applicative Concat where
   pure :: a -> Concat a
pure = a -> Concat a
forall a. a -> Concat a
Leaf
   Leaf f :: a -> b
f <*> :: Concat (a -> b) -> Concat a -> Concat b
<*> x :: Concat a
x = a -> b
f (a -> b) -> Concat a -> Concat b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Concat a
x
   (f1 :: Concat (a -> b)
f1 :<> f2 :: Concat (a -> b)
f2) <*> x :: Concat a
x = (Concat (a -> b)
f1 Concat (a -> b) -> Concat a -> Concat b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Concat a
x) Concat b -> Concat b -> Concat b
forall a. Concat a -> Concat a -> Concat a
:<> (Concat (a -> b)
f2 Concat (a -> b) -> Concat a -> Concat b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Concat a
x)

instance Foldable.Foldable Concat where
   fold :: Concat m -> m
fold (Leaf x :: m
x) = m
x
   fold (x :: Concat m
x :<> y :: Concat m
y) = Concat m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold Concat m
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Concat m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold Concat m
y
   foldMap :: (a -> m) -> Concat a -> m
foldMap f :: a -> m
f (Leaf x :: a
x) = a -> m
f a
x
   foldMap f :: a -> m
f (x :: Concat a
x :<> y :: Concat a
y) = (a -> m) -> Concat a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap a -> m
f Concat a
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Concat a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap a -> m
f Concat a
y
   foldl :: (b -> a -> b) -> b -> Concat a -> b
foldl f :: b -> a -> b
f a :: b
a (Leaf x :: a
x) = b -> a -> b
f b
a a
x
   foldl f :: b -> a -> b
f a :: b
a (x :: Concat a
x :<> y :: Concat a
y) = (b -> a -> b) -> b -> Concat a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl b -> a -> b
f ((b -> a -> b) -> b -> Concat a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl b -> a -> b
f b
a Concat a
x) Concat a
y
   foldl' :: (b -> a -> b) -> b -> Concat a -> b
foldl' f :: b -> a -> b
f a :: b
a (Leaf x :: a
x) = b -> a -> b
f b
a a
x
   foldl' f :: b -> a -> b
f a :: b
a (x :: Concat a
x :<> y :: Concat a
y) = let a' :: b
a' = (b -> a -> b) -> b -> Concat a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' b -> a -> b
f b
a Concat a
x in b
a' b -> b -> b
forall a b. a -> b -> b
`seq` (b -> a -> b) -> b -> Concat a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' b -> a -> b
f b
a' Concat a
y
   foldr :: (a -> b -> b) -> b -> Concat a -> b
foldr f :: a -> b -> b
f a :: b
a (Leaf x :: a
x) = a -> b -> b
f a
x b
a
   foldr f :: a -> b -> b
f a :: b
a (x :: Concat a
x :<> y :: Concat a
y) = (a -> b -> b) -> b -> Concat a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr a -> b -> b
f ((a -> b -> b) -> b -> Concat a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr a -> b -> b
f b
a Concat a
y) Concat a
x
   foldr' :: (a -> b -> b) -> b -> Concat a -> b
foldr' f :: a -> b -> b
f a :: b
a (Leaf x :: a
x) = a -> b -> b
f a
x b
a
   foldr' f :: a -> b -> b
f a :: b
a (x :: Concat a
x :<> y :: Concat a
y) = let a' :: b
a' = (a -> b -> b) -> b -> Concat a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr' a -> b -> b
f b
a Concat a
y in (a -> b -> b) -> b -> Concat a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr' a -> b -> b
f b
a' Concat a
x

instance PositiveMonoid a => Semigroup (Concat a) where
   x :: Concat a
x <> :: Concat a -> Concat a -> Concat a
<> y :: Concat a
y 
      | Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
x = Concat a
y
      | Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
y = Concat a
x
      | Bool
otherwise = Concat a
x Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
y

instance PositiveMonoid a => Monoid (Concat a) where
   mempty :: Concat a
mempty = a -> Concat a
forall a. a -> Concat a
Leaf a
forall a. Monoid a => a
mempty
   mappend :: Concat a -> Concat a -> Concat a
mappend = Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
(<>)

instance PositiveMonoid a => MonoidNull (Concat a) where
   null :: Concat a -> Bool
null (Leaf x :: a
x) = a -> Bool
forall m. MonoidNull m => m -> Bool
null a
x
   null _ = Bool
False

instance PositiveMonoid a => PositiveMonoid (Concat a)

instance (LeftReductive a, StableFactorial a, PositiveMonoid a) => LeftReductive (Concat a) where
   stripPrefix :: Concat a -> Concat a -> Maybe (Concat a)
stripPrefix (Leaf x :: a
x) (Leaf y :: a
y) = a -> Concat a
forall a. a -> Concat a
Leaf (a -> Concat a) -> Maybe a -> Maybe (Concat a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> Maybe a
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix a
x a
y
   stripPrefix (xp :: Concat a
xp :<> xs :: Concat a
xs) y :: Concat a
y = Concat a -> Concat a -> Maybe (Concat a)
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix Concat a
xp Concat a
y Maybe (Concat a)
-> (Concat a -> Maybe (Concat a)) -> Maybe (Concat a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Concat a -> Concat a -> Maybe (Concat a)
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix Concat a
xs
   stripPrefix x :: Concat a
x (yp :: Concat a
yp :<> ys :: Concat a
ys) = case (Concat a -> Concat a -> Maybe (Concat a)
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix Concat a
x Concat a
yp, Concat a -> Concat a -> Maybe (Concat a)
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix Concat a
yp Concat a
x)
                               of (Just yps :: Concat a
yps, _) -> Concat a -> Maybe (Concat a)
forall a. a -> Maybe a
Just (Concat a
yps Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
ys)
                                  (Nothing, Nothing) -> Maybe (Concat a)
forall a. Maybe a
Nothing
                                  (Nothing, Just xs :: Concat a
xs) -> Concat a -> Concat a -> Maybe (Concat a)
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix Concat a
xs Concat a
ys

instance (RightReductive a, StableFactorial a, PositiveMonoid a) => RightReductive (Concat a) where
   stripSuffix :: Concat a -> Concat a -> Maybe (Concat a)
stripSuffix (Leaf x :: a
x) (Leaf y :: a
y) = a -> Concat a
forall a. a -> Concat a
Leaf (a -> Concat a) -> Maybe a -> Maybe (Concat a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> Maybe a
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix a
x a
y
   stripSuffix (xp :: Concat a
xp :<> xs :: Concat a
xs) y :: Concat a
y = Concat a -> Concat a -> Maybe (Concat a)
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix Concat a
xs Concat a
y Maybe (Concat a)
-> (Concat a -> Maybe (Concat a)) -> Maybe (Concat a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Concat a -> Concat a -> Maybe (Concat a)
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix Concat a
xp
   stripSuffix x :: Concat a
x (yp :: Concat a
yp :<> ys :: Concat a
ys) = case (Concat a -> Concat a -> Maybe (Concat a)
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix Concat a
x Concat a
ys, Concat a -> Concat a -> Maybe (Concat a)
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix Concat a
ys Concat a
x)
                               of (Just ysp :: Concat a
ysp, _) -> Concat a -> Maybe (Concat a)
forall a. a -> Maybe a
Just (Concat a
yp Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
ysp)
                                  (Nothing, Nothing) -> Maybe (Concat a)
forall a. Maybe a
Nothing
                                  (Nothing, Just xp :: Concat a
xp) -> Concat a -> Concat a -> Maybe (Concat a)
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix Concat a
xp Concat a
yp

instance (LeftGCDMonoid a, StableFactorial a, PositiveMonoid a) => LeftGCDMonoid (Concat a) where
   stripCommonPrefix :: Concat a -> Concat a -> (Concat a, Concat a, Concat a)
stripCommonPrefix (Leaf x :: a
x) (Leaf y :: a
y) = (a -> Concat a) -> (a, a, a) -> (Concat a, Concat a, Concat a)
forall a b. (a -> b) -> (a, a, a) -> (b, b, b)
map3 a -> Concat a
forall a. a -> Concat a
Leaf (a -> a -> (a, a, a)
forall m. LeftGCDMonoid m => m -> m -> (m, m, m)
stripCommonPrefix a
x a
y)
   stripCommonPrefix (xp :: Concat a
xp :<> xs :: Concat a
xs) y :: Concat a
y
      | Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
xps = (Concat a
xp Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
xsp, Concat a
xss, Concat a
yss)
      | Bool
otherwise = (Concat a
xpp, Concat a
xps Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
xs, Concat a
ys)
      where (xpp :: Concat a
xpp, xps :: Concat a
xps, ys :: Concat a
ys) = Concat a -> Concat a -> (Concat a, Concat a, Concat a)
forall m. LeftGCDMonoid m => m -> m -> (m, m, m)
stripCommonPrefix Concat a
xp Concat a
y
            (xsp :: Concat a
xsp, xss :: Concat a
xss, yss :: Concat a
yss) = Concat a -> Concat a -> (Concat a, Concat a, Concat a)
forall m. LeftGCDMonoid m => m -> m -> (m, m, m)
stripCommonPrefix Concat a
xs Concat a
ys
   stripCommonPrefix x :: Concat a
x (yp :: Concat a
yp :<> ys :: Concat a
ys)
      | Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
yps = (Concat a
yp Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
ysp, Concat a
xss, Concat a
yss)
      | Bool
otherwise = (Concat a
ypp, Concat a
xs, Concat a
yps Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
ys)
      where (ypp :: Concat a
ypp, xs :: Concat a
xs, yps :: Concat a
yps) = Concat a -> Concat a -> (Concat a, Concat a, Concat a)
forall m. LeftGCDMonoid m => m -> m -> (m, m, m)
stripCommonPrefix Concat a
x Concat a
yp
            (ysp :: Concat a
ysp, xss :: Concat a
xss, yss :: Concat a
yss) = Concat a -> Concat a -> (Concat a, Concat a, Concat a)
forall m. LeftGCDMonoid m => m -> m -> (m, m, m)
stripCommonPrefix Concat a
xs Concat a
ys

instance (RightGCDMonoid a, StableFactorial a, PositiveMonoid a) => RightGCDMonoid (Concat a) where
   stripCommonSuffix :: Concat a -> Concat a -> (Concat a, Concat a, Concat a)
stripCommonSuffix (Leaf x :: a
x) (Leaf y :: a
y) = (a -> Concat a) -> (a, a, a) -> (Concat a, Concat a, Concat a)
forall a b. (a -> b) -> (a, a, a) -> (b, b, b)
map3 a -> Concat a
forall a. a -> Concat a
Leaf (a -> a -> (a, a, a)
forall m. RightGCDMonoid m => m -> m -> (m, m, m)
stripCommonSuffix a
x a
y)
   stripCommonSuffix (xp :: Concat a
xp :<> xs :: Concat a
xs) y :: Concat a
y
      | Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
xsp = (Concat a
xpp, Concat a
ypp, Concat a
xps Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
xs)
      | Bool
otherwise = (Concat a
xp Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
xsp, Concat a
yp, Concat a
xss)
      where (xsp :: Concat a
xsp, yp :: Concat a
yp, xss :: Concat a
xss) = Concat a -> Concat a -> (Concat a, Concat a, Concat a)
forall m. RightGCDMonoid m => m -> m -> (m, m, m)
stripCommonSuffix Concat a
xs Concat a
y
            (xpp :: Concat a
xpp, ypp :: Concat a
ypp, xps :: Concat a
xps) = Concat a -> Concat a -> (Concat a, Concat a, Concat a)
forall m. RightGCDMonoid m => m -> m -> (m, m, m)
stripCommonSuffix Concat a
xp Concat a
yp
   stripCommonSuffix x :: Concat a
x (yp :: Concat a
yp :<> ys :: Concat a
ys)
      | Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
ysp = (Concat a
xpp, Concat a
ypp, Concat a
yps Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
ys)
      | Bool
otherwise = (Concat a
xp, Concat a
yp Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
ysp, Concat a
yss)
      where (xp :: Concat a
xp, ysp :: Concat a
ysp, yss :: Concat a
yss) = Concat a -> Concat a -> (Concat a, Concat a, Concat a)
forall m. RightGCDMonoid m => m -> m -> (m, m, m)
stripCommonSuffix Concat a
x Concat a
ys
            (xpp :: Concat a
xpp, ypp :: Concat a
ypp, yps :: Concat a
yps) = Concat a -> Concat a -> (Concat a, Concat a, Concat a)
forall m. RightGCDMonoid m => m -> m -> (m, m, m)
stripCommonSuffix Concat a
xp Concat a
yp

instance (Factorial a, PositiveMonoid a) => Factorial (Concat a) where
   factors :: Concat a -> [Concat a]
factors c :: Concat a
c = Concat a -> [Concat a] -> [Concat a]
forall a.
(MonoidNull a, Factorial a) =>
Concat a -> [Concat a] -> [Concat a]
toList Concat a
c []
      where toList :: Concat a -> [Concat a] -> [Concat a]
toList (Leaf x :: a
x) rest :: [Concat a]
rest
               | a -> Bool
forall m. MonoidNull m => m -> Bool
null a
x = [Concat a]
rest
               | Bool
otherwise = (a -> Concat a
forall a. a -> Concat a
Leaf (a -> Concat a) -> [a] -> [Concat a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
forall m. Factorial m => m -> [m]
factors a
x) [Concat a] -> [Concat a] -> [Concat a]
forall a. [a] -> [a] -> [a]
++ [Concat a]
rest
            toList (x :: Concat a
x :<> y :: Concat a
y) rest :: [Concat a]
rest = Concat a -> [Concat a] -> [Concat a]
toList Concat a
x (Concat a -> [Concat a] -> [Concat a]
toList Concat a
y [Concat a]
rest)
   primePrefix :: Concat a -> Concat a
primePrefix (Leaf x :: a
x) = a -> Concat a
forall a. a -> Concat a
Leaf (a -> a
forall m. Factorial m => m -> m
primePrefix a
x)
   primePrefix (x :: Concat a
x :<> _) = Concat a -> Concat a
forall m. Factorial m => m -> m
primePrefix Concat a
x
   primeSuffix :: Concat a -> Concat a
primeSuffix (Leaf x :: a
x) = a -> Concat a
forall a. a -> Concat a
Leaf (a -> a
forall m. Factorial m => m -> m
primeSuffix a
x)
   primeSuffix (_ :<> y :: Concat a
y) = Concat a -> Concat a
forall m. Factorial m => m -> m
primeSuffix Concat a
y

   foldl :: (a -> Concat a -> a) -> a -> Concat a -> a
foldl f :: a -> Concat a -> a
f = (a -> a -> a) -> a -> Concat a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl a -> a -> a
g
      where g :: a -> a -> a
g = (a -> a -> a) -> a -> a -> a
forall m a. Factorial m => (a -> m -> a) -> a -> m -> a
Factorial.foldl (\a :: a
a-> a -> Concat a -> a
f a
a (Concat a -> a) -> (a -> Concat a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concat a
forall a. a -> Concat a
Leaf)
   foldl' :: (a -> Concat a -> a) -> a -> Concat a -> a
foldl' f :: a -> Concat a -> a
f = (a -> a -> a) -> a -> Concat a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' a -> a -> a
g
      where g :: a -> a -> a
g = (a -> a -> a) -> a -> a -> a
forall m a. Factorial m => (a -> m -> a) -> a -> m -> a
Factorial.foldl' (\a :: a
a-> a -> Concat a -> a
f a
a (Concat a -> a) -> (a -> Concat a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concat a
forall a. a -> Concat a
Leaf)
   foldr :: (Concat a -> a -> a) -> a -> Concat a -> a
foldr f :: Concat a -> a -> a
f = (a -> a -> a) -> a -> Concat a -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr a -> a -> a
g
      where g :: a -> a -> a
g a :: a
a b :: a
b = (a -> a -> a) -> a -> a -> a
forall m a. Factorial m => (m -> a -> a) -> a -> m -> a
Factorial.foldr (Concat a -> a -> a
f (Concat a -> a -> a) -> (a -> Concat a) -> a -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concat a
forall a. a -> Concat a
Leaf) a
b a
a
   foldMap :: (Concat a -> n) -> Concat a -> n
foldMap f :: Concat a -> n
f = (a -> n) -> Concat a -> n
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap ((a -> n) -> a -> n
forall m n. (Factorial m, Monoid n) => (m -> n) -> m -> n
Factorial.foldMap (Concat a -> n
f (Concat a -> n) -> (a -> Concat a) -> a -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concat a
forall a. a -> Concat a
Leaf))
   length :: Concat a -> Int
length x :: Concat a
x = Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int) -> Sum Int -> Int
forall a b. (a -> b) -> a -> b
$ (a -> Sum Int) -> Concat a -> Sum Int
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int) -> (a -> Int) -> a -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall m. Factorial m => m -> Int
length) Concat a
x
   reverse :: Concat a -> Concat a
reverse (Leaf x :: a
x) = a -> Concat a
forall a. a -> Concat a
Leaf (a -> a
forall m. Factorial m => m -> m
reverse a
x)
   reverse (x :: Concat a
x :<> y :: Concat a
y) = Concat a -> Concat a
forall m. Factorial m => m -> m
reverse Concat a
y Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a -> Concat a
forall m. Factorial m => m -> m
reverse Concat a
x

instance (FactorialMonoid a, PositiveMonoid a) => FactorialMonoid (Concat a) where
   splitPrimePrefix :: Concat a -> Maybe (Concat a, Concat a)
splitPrimePrefix (Leaf x :: a
x) = (a -> Concat a) -> (a, a) -> (Concat a, Concat a)
forall a b. (a -> b) -> (a, a) -> (b, b)
map2 a -> Concat a
forall a. a -> Concat a
Leaf ((a, a) -> (Concat a, Concat a))
-> Maybe (a, a) -> Maybe (Concat a, Concat a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe (a, a)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix a
x
   splitPrimePrefix (x :: Concat a
x :<> y :: Concat a
y) = ((Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
y) (Concat a -> Concat a)
-> (Concat a, Concat a) -> (Concat a, Concat a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ((Concat a, Concat a) -> (Concat a, Concat a))
-> Maybe (Concat a, Concat a) -> Maybe (Concat a, Concat a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Concat a -> Maybe (Concat a, Concat a)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix Concat a
x
   splitPrimeSuffix :: Concat a -> Maybe (Concat a, Concat a)
splitPrimeSuffix (Leaf x :: a
x) = (a -> Concat a) -> (a, a) -> (Concat a, Concat a)
forall a b. (a -> b) -> (a, a) -> (b, b)
map2 a -> Concat a
forall a. a -> Concat a
Leaf ((a, a) -> (Concat a, Concat a))
-> Maybe (a, a) -> Maybe (Concat a, Concat a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe (a, a)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimeSuffix a
x
   splitPrimeSuffix (x :: Concat a
x :<> y :: Concat a
y) = (Concat a -> Concat a)
-> (Concat a, Concat a) -> (Concat a, Concat a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Concat a
x Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<>) ((Concat a, Concat a) -> (Concat a, Concat a))
-> Maybe (Concat a, Concat a) -> Maybe (Concat a, Concat a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Concat a -> Maybe (Concat a, Concat a)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimeSuffix Concat a
y
   span :: (Concat a -> Bool) -> Concat a -> (Concat a, Concat a)
span p :: Concat a -> Bool
p (Leaf x :: a
x) = (a -> Concat a) -> (a, a) -> (Concat a, Concat a)
forall a b. (a -> b) -> (a, a) -> (b, b)
map2 a -> Concat a
forall a. a -> Concat a
Leaf ((a -> Bool) -> a -> (a, a)
forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span (Concat a -> Bool
p (Concat a -> Bool) -> (a -> Concat a) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concat a
forall a. a -> Concat a
Leaf) a
x)
   span p :: Concat a -> Bool
p (x :: Concat a
x :<> y :: Concat a
y)
      | Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
xs = (Concat a
x Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
yp, Concat a
ys)
      | Bool
otherwise = (Concat a
xp, Concat a
xs Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
y)
      where (xp :: Concat a
xp, xs :: Concat a
xs) = (Concat a -> Bool) -> Concat a -> (Concat a, Concat a)
forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span Concat a -> Bool
p Concat a
x
            (yp :: Concat a
yp, ys :: Concat a
ys) = (Concat a -> Bool) -> Concat a -> (Concat a, Concat a)
forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span Concat a -> Bool
p Concat a
y
   spanMaybe :: s
-> (s -> Concat a -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
spanMaybe s0 :: s
s0 f :: s -> Concat a -> Maybe s
f (Leaf x :: a
x) = (a -> Concat a) -> (a, a, s) -> (Concat a, Concat a, s)
forall a b c. (a -> b) -> (a, a, c) -> (b, b, c)
first2 a -> Concat a
forall a. a -> Concat a
Leaf (s -> (s -> a -> Maybe s) -> a -> (a, a, s)
forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe s
s0 (\s :: s
s-> s -> Concat a -> Maybe s
f s
s (Concat a -> Maybe s) -> (a -> Concat a) -> a -> Maybe s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concat a
forall a. a -> Concat a
Leaf) a
x)
   spanMaybe s0 :: s
s0 f :: s -> Concat a -> Maybe s
f (x :: Concat a
x :<> y :: Concat a
y)
      | Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
xs = (Concat a
x Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
yp, Concat a
ys, s
s2)
      | Bool
otherwise = (Concat a
xp, Concat a
xs Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
y, s
s1)
      where (xp :: Concat a
xp, xs :: Concat a
xs, s1 :: s
s1) = s
-> (s -> Concat a -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe s
s0 s -> Concat a -> Maybe s
f Concat a
x
            (yp :: Concat a
yp, ys :: Concat a
ys, s2 :: s
s2) = s
-> (s -> Concat a -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe s
s1 s -> Concat a -> Maybe s
f Concat a
y
   spanMaybe' :: s
-> (s -> Concat a -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
spanMaybe' s0 :: s
s0 f :: s -> Concat a -> Maybe s
f c :: Concat a
c = s -> (Concat a, Concat a, s) -> (Concat a, Concat a, s)
forall a b. a -> b -> b
seq s
s0 ((Concat a, Concat a, s) -> (Concat a, Concat a, s))
-> (Concat a, Concat a, s) -> (Concat a, Concat a, s)
forall a b. (a -> b) -> a -> b
$
      case Concat a
c
      of Leaf x :: a
x -> (a -> Concat a) -> (a, a, s) -> (Concat a, Concat a, s)
forall a b c. (a -> b) -> (a, a, c) -> (b, b, c)
first2 a -> Concat a
forall a. a -> Concat a
Leaf (s -> (s -> a -> Maybe s) -> a -> (a, a, s)
forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' s
s0 (\s :: s
s-> s -> Concat a -> Maybe s
f s
s (Concat a -> Maybe s) -> (a -> Concat a) -> a -> Maybe s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concat a
forall a. a -> Concat a
Leaf) a
x)
         x :: Concat a
x :<> y :: Concat a
y -> let (xp :: Concat a
xp, xs :: Concat a
xs, s1 :: s
s1) = s
-> (s -> Concat a -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' s
s0 s -> Concat a -> Maybe s
f Concat a
x
                        (yp :: Concat a
yp, ys :: Concat a
ys, s2 :: s
s2) = s
-> (s -> Concat a -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
forall m s.
FactorialMonoid m =>
s -> (s -> m -> Maybe s) -> m -> (m, m, s)
Factorial.spanMaybe' s
s1 s -> Concat a -> Maybe s
f Concat a
y
                    in if Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
xs then (Concat a
x Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
yp, Concat a
ys, s
s2) else (Concat a
xp, Concat a
xs Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
y, s
s1)

   split :: (Concat a -> Bool) -> Concat a -> [Concat a]
split p :: Concat a -> Bool
p = (a -> [Concat a] -> [Concat a])
-> [Concat a] -> Concat a -> [Concat a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr a -> [Concat a] -> [Concat a]
splitNext [Concat a
forall a. Monoid a => a
mempty]
      where splitNext :: a -> [Concat a] -> [Concat a]
splitNext a :: a
a ~(xp :: Concat a
xp:xs :: [Concat a]
xs) =
               let as :: [Concat a]
as = a -> Concat a
forall a. a -> Concat a
Leaf (a -> Concat a) -> [a] -> [Concat a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Bool) -> a -> [a]
forall m. FactorialMonoid m => (m -> Bool) -> m -> [m]
Factorial.split (Concat a -> Bool
p (Concat a -> Bool) -> (a -> Concat a) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concat a
forall a. a -> Concat a
Leaf) a
a
               in if Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
xp
                  then [Concat a]
as [Concat a] -> [Concat a] -> [Concat a]
forall a. [a] -> [a] -> [a]
++ [Concat a]
xs
                  else [Concat a] -> [Concat a]
forall a. [a] -> [a]
init [Concat a]
as [Concat a] -> [Concat a] -> [Concat a]
forall a. [a] -> [a] -> [a]
++ ([Concat a] -> Concat a
forall a. [a] -> a
last [Concat a]
as Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
xp)Concat a -> [Concat a] -> [Concat a]
forall a. a -> [a] -> [a]
:[Concat a]
xs
   splitAt :: Int -> Concat a -> (Concat a, Concat a)
splitAt 0 c :: Concat a
c = (Concat a
forall a. Monoid a => a
mempty, Concat a
c)
   splitAt n :: Int
n (Leaf x :: a
x) = (a -> Concat a) -> (a, a) -> (Concat a, Concat a)
forall a b. (a -> b) -> (a, a) -> (b, b)
map2 a -> Concat a
forall a. a -> Concat a
Leaf (Int -> a -> (a, a)
forall m. FactorialMonoid m => Int -> m -> (m, m)
Factorial.splitAt Int
n a
x)
   splitAt n :: Int
n (x :: Concat a
x :<> y :: Concat a
y)
      | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = (Concat a
x Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
yp, Concat a
ys)
      | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = (Concat a
xp, Concat a
xs Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
y)
      | Bool
otherwise = (Concat a
x, Concat a
y)
      where k :: Int
k = Concat a -> Int
forall m. Factorial m => m -> Int
length Concat a
x
            (yp :: Concat a
yp, ys :: Concat a
ys) = Int -> Concat a -> (Concat a, Concat a)
forall m. FactorialMonoid m => Int -> m -> (m, m)
splitAt (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) Concat a
y
            (xp :: Concat a
xp, xs :: Concat a
xs) = Int -> Concat a -> (Concat a, Concat a)
forall m. FactorialMonoid m => Int -> m -> (m, m)
splitAt Int
n Concat a
x

instance (Factorial a, PositiveMonoid a) => StableFactorial (Concat a)

instance (IsString a) => IsString (Concat a) where
   fromString :: String -> Concat a
fromString s :: String
s = a -> Concat a
forall a. a -> Concat a
Leaf (String -> a
forall a. IsString a => String -> a
fromString String
s)

instance (Eq a, TextualMonoid a, StableFactorial a, PositiveMonoid a) => TextualMonoid (Concat a) where
   fromText :: Text -> Concat a
fromText t :: Text
t = a -> Concat a
forall a. a -> Concat a
Leaf (Text -> a
forall t. TextualMonoid t => Text -> t
fromText Text
t)
   singleton :: Char -> Concat a
singleton = a -> Concat a
forall a. a -> Concat a
Leaf (a -> Concat a) -> (Char -> a) -> Char -> Concat a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> a
forall t. TextualMonoid t => Char -> t
singleton
   splitCharacterPrefix :: Concat a -> Maybe (Char, Concat a)
splitCharacterPrefix (Leaf x :: a
x) = (a -> Concat a
forall a. a -> Concat a
Leaf (a -> Concat a) -> (Char, a) -> (Char, Concat a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ((Char, a) -> (Char, Concat a))
-> Maybe (Char, a) -> Maybe (Char, Concat a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe (Char, a)
forall t. TextualMonoid t => t -> Maybe (Char, t)
splitCharacterPrefix a
x
   splitCharacterPrefix (x :: Concat a
x :<> y :: Concat a
y) = ((Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
y) (Concat a -> Concat a) -> (Char, Concat a) -> (Char, Concat a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ((Char, Concat a) -> (Char, Concat a))
-> Maybe (Char, Concat a) -> Maybe (Char, Concat a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Concat a -> Maybe (Char, Concat a)
forall t. TextualMonoid t => t -> Maybe (Char, t)
splitCharacterPrefix Concat a
x
   characterPrefix :: Concat a -> Maybe Char
characterPrefix (Leaf x :: a
x) = a -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
characterPrefix a
x
   characterPrefix (x :: Concat a
x :<> _) = Concat a -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
characterPrefix Concat a
x
   map :: (Char -> Char) -> Concat a -> Concat a
map f :: Char -> Char
f x :: Concat a
x = (Char -> Char) -> a -> a
forall t. TextualMonoid t => (Char -> Char) -> t -> t
map Char -> Char
f (a -> a) -> Concat a -> Concat a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Concat a
x
   toString :: (Concat a -> String) -> Concat a -> String
toString ft :: Concat a -> String
ft x :: Concat a
x = (a -> String) -> [a] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
List.concatMap ((a -> String) -> a -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
toString ((a -> String) -> a -> String) -> (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ Concat a -> String
ft (Concat a -> String) -> (a -> Concat a) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concat a
forall a. a -> Concat a
Leaf) (Concat a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Concat a
x)

   foldl :: (a -> Concat a -> a) -> (a -> Char -> a) -> a -> Concat a -> a
foldl ft :: a -> Concat a -> a
ft fc :: a -> Char -> a
fc = (a -> a -> a) -> a -> Concat a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl a -> a -> a
g
      where g :: a -> a -> a
g = (a -> a -> a) -> (a -> Char -> a) -> a -> a -> a
forall t a.
TextualMonoid t =>
(a -> t -> a) -> (a -> Char -> a) -> a -> t -> a
Textual.foldl (\a :: a
a-> a -> Concat a -> a
ft a
a (Concat a -> a) -> (a -> Concat a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concat a
forall a. a -> Concat a
Leaf) a -> Char -> a
fc
   foldl' :: (a -> Concat a -> a) -> (a -> Char -> a) -> a -> Concat a -> a
foldl' ft :: a -> Concat a -> a
ft fc :: a -> Char -> a
fc = (a -> a -> a) -> a -> Concat a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' a -> a -> a
g
      where g :: a -> a -> a
g = (a -> a -> a) -> (a -> Char -> a) -> a -> a -> a
forall t a.
TextualMonoid t =>
(a -> t -> a) -> (a -> Char -> a) -> a -> t -> a
Textual.foldl' (\a :: a
a-> a -> Concat a -> a
ft a
a (Concat a -> a) -> (a -> Concat a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concat a
forall a. a -> Concat a
Leaf) a -> Char -> a
fc
   foldr :: (Concat a -> a -> a) -> (Char -> a -> a) -> a -> Concat a -> a
foldr ft :: Concat a -> a -> a
ft fc :: Char -> a -> a
fc = (a -> a -> a) -> a -> Concat a -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr a -> a -> a
g
      where g :: a -> a -> a
g a :: a
a b :: a
b = (a -> a -> a) -> (Char -> a -> a) -> a -> a -> a
forall t a.
TextualMonoid t =>
(t -> a -> a) -> (Char -> a -> a) -> a -> t -> a
Textual.foldr (Concat a -> a -> a
ft (Concat a -> a -> a) -> (a -> Concat a) -> a -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concat a
forall a. a -> Concat a
Leaf) Char -> a -> a
fc a
b a
a
   any :: (Char -> Bool) -> Concat a -> Bool
any p :: Char -> Bool
p = (a -> Bool) -> Concat a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Foldable.any ((Char -> Bool) -> a -> Bool
forall t. TextualMonoid t => (Char -> Bool) -> t -> Bool
any Char -> Bool
p)
   all :: (Char -> Bool) -> Concat a -> Bool
all p :: Char -> Bool
p = (a -> Bool) -> Concat a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Foldable.all ((Char -> Bool) -> a -> Bool
forall t. TextualMonoid t => (Char -> Bool) -> t -> Bool
all Char -> Bool
p)

   span :: (Concat a -> Bool)
-> (Char -> Bool) -> Concat a -> (Concat a, Concat a)
span pt :: Concat a -> Bool
pt pc :: Char -> Bool
pc (Leaf x :: a
x) = (a -> Concat a) -> (a, a) -> (Concat a, Concat a)
forall a b. (a -> b) -> (a, a) -> (b, b)
map2 a -> Concat a
forall a. a -> Concat a
Leaf ((a -> Bool) -> (Char -> Bool) -> a -> (a, a)
forall t.
TextualMonoid t =>
(t -> Bool) -> (Char -> Bool) -> t -> (t, t)
Textual.span (Concat a -> Bool
pt (Concat a -> Bool) -> (a -> Concat a) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concat a
forall a. a -> Concat a
Leaf) Char -> Bool
pc a
x)
   span pt :: Concat a -> Bool
pt pc :: Char -> Bool
pc (x :: Concat a
x :<> y :: Concat a
y)
      | Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
xs = (Concat a
x Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
yp, Concat a
ys)
      | Bool
otherwise = (Concat a
xp, Concat a
xs Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
y)
      where (xp :: Concat a
xp, xs :: Concat a
xs) = (Concat a -> Bool)
-> (Char -> Bool) -> Concat a -> (Concat a, Concat a)
forall t.
TextualMonoid t =>
(t -> Bool) -> (Char -> Bool) -> t -> (t, t)
Textual.span Concat a -> Bool
pt Char -> Bool
pc Concat a
x
            (yp :: Concat a
yp, ys :: Concat a
ys) = (Concat a -> Bool)
-> (Char -> Bool) -> Concat a -> (Concat a, Concat a)
forall t.
TextualMonoid t =>
(t -> Bool) -> (Char -> Bool) -> t -> (t, t)
Textual.span Concat a -> Bool
pt Char -> Bool
pc Concat a
y
   span_ :: Bool -> (Char -> Bool) -> Concat a -> (Concat a, Concat a)
span_ bt :: Bool
bt pc :: Char -> Bool
pc (Leaf x :: a
x) = (a -> Concat a) -> (a, a) -> (Concat a, Concat a)
forall a b. (a -> b) -> (a, a) -> (b, b)
map2 a -> Concat a
forall a. a -> Concat a
Leaf (Bool -> (Char -> Bool) -> a -> (a, a)
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> (t, t)
Textual.span_ Bool
bt Char -> Bool
pc a
x)
   span_ bt :: Bool
bt pc :: Char -> Bool
pc (x :: Concat a
x :<> y :: Concat a
y)
      | Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
xs = (Concat a
x Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
yp, Concat a
ys)
      | Bool
otherwise = (Concat a
xp, Concat a
xs Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
y)
      where (xp :: Concat a
xp, xs :: Concat a
xs) = Bool -> (Char -> Bool) -> Concat a -> (Concat a, Concat a)
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> (t, t)
Textual.span_ Bool
bt Char -> Bool
pc Concat a
x
            (yp :: Concat a
yp, ys :: Concat a
ys) = Bool -> (Char -> Bool) -> Concat a -> (Concat a, Concat a)
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> (t, t)
Textual.span_ Bool
bt Char -> Bool
pc Concat a
y
   break :: (Concat a -> Bool)
-> (Char -> Bool) -> Concat a -> (Concat a, Concat a)
break pt :: Concat a -> Bool
pt pc :: Char -> Bool
pc = (Concat a -> Bool)
-> (Char -> Bool) -> Concat a -> (Concat a, Concat a)
forall t.
TextualMonoid t =>
(t -> Bool) -> (Char -> Bool) -> t -> (t, t)
Textual.span (Bool -> Bool
not (Bool -> Bool) -> (Concat a -> Bool) -> Concat a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Concat a -> Bool
pt) (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
pc)
   takeWhile_ :: Bool -> (Char -> Bool) -> Concat a -> Concat a
takeWhile_ bt :: Bool
bt pc :: Char -> Bool
pc = (Concat a, Concat a) -> Concat a
forall a b. (a, b) -> a
fst ((Concat a, Concat a) -> Concat a)
-> (Concat a -> (Concat a, Concat a)) -> Concat a -> Concat a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> (Char -> Bool) -> Concat a -> (Concat a, Concat a)
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> (t, t)
span_ Bool
bt Char -> Bool
pc
   dropWhile_ :: Bool -> (Char -> Bool) -> Concat a -> Concat a
dropWhile_ bt :: Bool
bt pc :: Char -> Bool
pc = (Concat a, Concat a) -> Concat a
forall a b. (a, b) -> b
snd ((Concat a, Concat a) -> Concat a)
-> (Concat a -> (Concat a, Concat a)) -> Concat a -> Concat a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> (Char -> Bool) -> Concat a -> (Concat a, Concat a)
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> (t, t)
span_ Bool
bt Char -> Bool
pc
   break_ :: Bool -> (Char -> Bool) -> Concat a -> (Concat a, Concat a)
break_ bt :: Bool
bt pc :: Char -> Bool
pc = Bool -> (Char -> Bool) -> Concat a -> (Concat a, Concat a)
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> (t, t)
span_ (Bool -> Bool
not Bool
bt) (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
pc)

   spanMaybe :: s
-> (s -> Concat a -> Maybe s)
-> (s -> Char -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
spanMaybe s0 :: s
s0 ft :: s -> Concat a -> Maybe s
ft fc :: s -> Char -> Maybe s
fc (Leaf x :: a
x) = (a -> Concat a) -> (a, a, s) -> (Concat a, Concat a, s)
forall a b c. (a -> b) -> (a, a, c) -> (b, b, c)
first2 a -> Concat a
forall a. a -> Concat a
Leaf (s
-> (s -> a -> Maybe s) -> (s -> Char -> Maybe s) -> a -> (a, a, s)
forall t s.
TextualMonoid t =>
s
-> (s -> t -> Maybe s) -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe s
s0 (\s :: s
s-> s -> Concat a -> Maybe s
ft s
s (Concat a -> Maybe s) -> (a -> Concat a) -> a -> Maybe s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concat a
forall a. a -> Concat a
Leaf) s -> Char -> Maybe s
fc a
x)
   spanMaybe s0 :: s
s0 ft :: s -> Concat a -> Maybe s
ft fc :: s -> Char -> Maybe s
fc (x :: Concat a
x :<> y :: Concat a
y)
      | Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
xs = (Concat a
x Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
yp, Concat a
ys, s
s2)
      | Bool
otherwise = (Concat a
xp, Concat a
xs Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
y, s
s1)
      where (xp :: Concat a
xp, xs :: Concat a
xs, s1 :: s
s1) = s
-> (s -> Concat a -> Maybe s)
-> (s -> Char -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
forall t s.
TextualMonoid t =>
s
-> (s -> t -> Maybe s) -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe s
s0 s -> Concat a -> Maybe s
ft s -> Char -> Maybe s
fc Concat a
x
            (yp :: Concat a
yp, ys :: Concat a
ys, s2 :: s
s2) = s
-> (s -> Concat a -> Maybe s)
-> (s -> Char -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
forall t s.
TextualMonoid t =>
s
-> (s -> t -> Maybe s) -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe s
s1 s -> Concat a -> Maybe s
ft s -> Char -> Maybe s
fc Concat a
y
   spanMaybe' :: s
-> (s -> Concat a -> Maybe s)
-> (s -> Char -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
spanMaybe' s0 :: s
s0 ft :: s -> Concat a -> Maybe s
ft fc :: s -> Char -> Maybe s
fc c :: Concat a
c = s -> (Concat a, Concat a, s) -> (Concat a, Concat a, s)
forall a b. a -> b -> b
seq s
s0 ((Concat a, Concat a, s) -> (Concat a, Concat a, s))
-> (Concat a, Concat a, s) -> (Concat a, Concat a, s)
forall a b. (a -> b) -> a -> b
$
      case Concat a
c
      of Leaf x :: a
x -> (a -> Concat a) -> (a, a, s) -> (Concat a, Concat a, s)
forall a b c. (a -> b) -> (a, a, c) -> (b, b, c)
first2 a -> Concat a
forall a. a -> Concat a
Leaf (s
-> (s -> a -> Maybe s) -> (s -> Char -> Maybe s) -> a -> (a, a, s)
forall t s.
TextualMonoid t =>
s
-> (s -> t -> Maybe s) -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe' s
s0 (\s :: s
s-> s -> Concat a -> Maybe s
ft s
s (Concat a -> Maybe s) -> (a -> Concat a) -> a -> Maybe s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concat a
forall a. a -> Concat a
Leaf) s -> Char -> Maybe s
fc a
x)
         x :: Concat a
x :<> y :: Concat a
y -> let (xp :: Concat a
xp, xs :: Concat a
xs, s1 :: s
s1) = s
-> (s -> Concat a -> Maybe s)
-> (s -> Char -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
forall t s.
TextualMonoid t =>
s
-> (s -> t -> Maybe s) -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe' s
s0 s -> Concat a -> Maybe s
ft s -> Char -> Maybe s
fc Concat a
x
                        (yp :: Concat a
yp, ys :: Concat a
ys, s2 :: s
s2) = s
-> (s -> Concat a -> Maybe s)
-> (s -> Char -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
forall t s.
TextualMonoid t =>
s
-> (s -> t -> Maybe s) -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe' s
s1 s -> Concat a -> Maybe s
ft s -> Char -> Maybe s
fc Concat a
y
                    in if Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
xs then (Concat a
x Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
yp, Concat a
ys, s
s2) else (Concat a
xp, Concat a
xs Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
y, s
s1)
   spanMaybe_ :: s -> (s -> Char -> Maybe s) -> Concat a -> (Concat a, Concat a, s)
spanMaybe_ s0 :: s
s0 fc :: s -> Char -> Maybe s
fc (Leaf x :: a
x) = (a -> Concat a) -> (a, a, s) -> (Concat a, Concat a, s)
forall a b c. (a -> b) -> (a, a, c) -> (b, b, c)
first2 a -> Concat a
forall a. a -> Concat a
Leaf (s -> (s -> Char -> Maybe s) -> a -> (a, a, s)
forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_ s
s0 s -> Char -> Maybe s
fc a
x)
   spanMaybe_ s0 :: s
s0 fc :: s -> Char -> Maybe s
fc (x :: Concat a
x :<> y :: Concat a
y)
      | Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
xs = (Concat a
x Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
yp, Concat a
ys, s
s2)
      | Bool
otherwise = (Concat a
xp, Concat a
xs Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
y, s
s1)
      where (xp :: Concat a
xp, xs :: Concat a
xs, s1 :: s
s1) = s -> (s -> Char -> Maybe s) -> Concat a -> (Concat a, Concat a, s)
forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_ s
s0 s -> Char -> Maybe s
fc Concat a
x
            (yp :: Concat a
yp, ys :: Concat a
ys, s2 :: s
s2) = s -> (s -> Char -> Maybe s) -> Concat a -> (Concat a, Concat a, s)
forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_ s
s1 s -> Char -> Maybe s
fc Concat a
y
   spanMaybe_' :: s -> (s -> Char -> Maybe s) -> Concat a -> (Concat a, Concat a, s)
spanMaybe_' s0 :: s
s0 fc :: s -> Char -> Maybe s
fc c :: Concat a
c = s -> (Concat a, Concat a, s) -> (Concat a, Concat a, s)
forall a b. a -> b -> b
seq s
s0 ((Concat a, Concat a, s) -> (Concat a, Concat a, s))
-> (Concat a, Concat a, s) -> (Concat a, Concat a, s)
forall a b. (a -> b) -> a -> b
$
      case Concat a
c
      of Leaf x :: a
x -> (a -> Concat a) -> (a, a, s) -> (Concat a, Concat a, s)
forall a b c. (a -> b) -> (a, a, c) -> (b, b, c)
first2 a -> Concat a
forall a. a -> Concat a
Leaf (s -> (s -> Char -> Maybe s) -> a -> (a, a, s)
forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_' s
s0 s -> Char -> Maybe s
fc a
x)
         x :: Concat a
x :<> y :: Concat a
y -> let (xp :: Concat a
xp, xs :: Concat a
xs, s1 :: s
s1) = s -> (s -> Char -> Maybe s) -> Concat a -> (Concat a, Concat a, s)
forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_' s
s0 s -> Char -> Maybe s
fc Concat a
x
                        (yp :: Concat a
yp, ys :: Concat a
ys, s2 :: s
s2) = s -> (s -> Char -> Maybe s) -> Concat a -> (Concat a, Concat a, s)
forall t s.
TextualMonoid t =>
s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
Textual.spanMaybe_' s
s1 s -> Char -> Maybe s
fc Concat a
y
                    in if Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
xs then (Concat a
x Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
yp, Concat a
ys, s
s2) else (Concat a
xp, Concat a
xs Concat a -> Concat a -> Concat a
forall a. Concat a -> Concat a -> Concat a
:<> Concat a
y, s
s1)

   split :: (Char -> Bool) -> Concat a -> [Concat a]
split p :: Char -> Bool
p = (a -> [Concat a] -> [Concat a])
-> [Concat a] -> Concat a -> [Concat a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr a -> [Concat a] -> [Concat a]
forall a.
(PositiveMonoid a, TextualMonoid a) =>
a -> [Concat a] -> [Concat a]
splitNext [Concat a
forall a. Monoid a => a
mempty]
      where splitNext :: a -> [Concat a] -> [Concat a]
splitNext a :: a
a ~(xp :: Concat a
xp:xs :: [Concat a]
xs) =
               let as :: [Concat a]
as = a -> Concat a
forall a. a -> Concat a
Leaf (a -> Concat a) -> [a] -> [Concat a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> a -> [a]
forall t. TextualMonoid t => (Char -> Bool) -> t -> [t]
Textual.split Char -> Bool
p a
a
               in if Concat a -> Bool
forall m. MonoidNull m => m -> Bool
null Concat a
xp
                  then [Concat a]
as [Concat a] -> [Concat a] -> [Concat a]
forall a. [a] -> [a] -> [a]
++ [Concat a]
xs
                  else [Concat a] -> [Concat a]
forall a. [a] -> [a]
init [Concat a]
as [Concat a] -> [Concat a] -> [Concat a]
forall a. [a] -> [a] -> [a]
++ ([Concat a] -> Concat a
forall a. [a] -> a
last [Concat a]
as Concat a -> Concat a -> Concat a
forall a. Semigroup a => a -> a -> a
<> Concat a
xp)Concat a -> [Concat a] -> [Concat a]
forall a. a -> [a] -> [a]
:[Concat a]
xs
   find :: (Char -> Bool) -> Concat a -> Maybe Char
find p :: Char -> Bool
p x :: Concat a
x = First Char -> Maybe Char
forall a. First a -> Maybe a
getFirst (First Char -> Maybe Char) -> First Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$ (a -> First Char) -> Concat a -> First Char
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (Maybe Char -> First Char
forall a. Maybe a -> First a
First (Maybe Char -> First Char) -> (a -> Maybe Char) -> a -> First Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> a -> Maybe Char
forall t. TextualMonoid t => (Char -> Bool) -> t -> Maybe Char
find Char -> Bool
p) Concat a
x
   elem :: Char -> Concat a -> Bool
elem i :: Char
i = (a -> Bool) -> Concat a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Foldable.any (Char -> a -> Bool
forall t. TextualMonoid t => Char -> t -> Bool
Textual.elem Char
i)

-- Utility functions

map2 :: (a -> b) -> (a, a) -> (b, b)
map2 :: (a -> b) -> (a, a) -> (b, b)
map2 f :: a -> b
f (x :: a
x, y :: a
y) = (a -> b
f a
x, a -> b
f a
y)

map3 :: (a -> b) -> (a, a, a) -> (b, b, b)
map3 :: (a -> b) -> (a, a, a) -> (b, b, b)
map3 f :: a -> b
f (x :: a
x, y :: a
y, z :: a
z) = (a -> b
f a
x, a -> b
f a
y, a -> b
f a
z)

first2 :: (a -> b) -> (a, a, c) -> (b, b, c)
first2 :: (a -> b) -> (a, a, c) -> (b, b, c)
first2 f :: a -> b
f (x :: a
x, y :: a
y, z :: c
z) = (a -> b
f a
x, a -> b
f a
y, c
z)