{- 
    Copyright 2013-2022 Mario Blazevic

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

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

{-# LANGUAGE Haskell2010, DeriveDataTypeable #-}

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

import Control.Applicative -- (Applicative(..))
import Control.Arrow (first)
import Data.Data (Data, Typeable)
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 qualified Data.Text as Text

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 (Typeable (Concat a)
Typeable (Concat a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Concat a -> c (Concat a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Concat a))
-> (Concat a -> Constr)
-> (Concat a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Concat a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Concat a)))
-> ((forall b. Data b => b -> b) -> Concat a -> Concat a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Concat a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Concat a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Concat a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Concat a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Concat a -> m (Concat a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Concat a -> m (Concat a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Concat a -> m (Concat a))
-> Data (Concat a)
Concat a -> Constr
Concat a -> DataType
(forall b. Data b => b -> b) -> Concat a -> Concat a
forall a. Data a => Typeable (Concat a)
forall a. Data a => Concat a -> Constr
forall a. Data a => Concat a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b) -> Concat a -> Concat a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Concat a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Concat a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Concat a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Concat a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Concat a -> m (Concat a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Concat a -> m (Concat a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Concat a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Concat a -> c (Concat a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Concat a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Concat a))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Concat a -> u
forall u. (forall d. Data d => d -> u) -> Concat a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Concat a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Concat a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Concat a -> m (Concat a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Concat a -> m (Concat a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Concat a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Concat a -> c (Concat a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Concat a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Concat a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Concat a -> c (Concat a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Concat a -> c (Concat a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Concat a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Concat a)
$ctoConstr :: forall a. Data a => Concat a -> Constr
toConstr :: Concat a -> Constr
$cdataTypeOf :: forall a. Data a => Concat a -> DataType
dataTypeOf :: Concat a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Concat a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Concat a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Concat a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Concat a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Concat a -> Concat a
gmapT :: (forall b. Data b => b -> b) -> Concat a -> Concat a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Concat a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Concat a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Concat a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Concat a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Concat a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Concat a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Concat a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Concat a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Concat a -> m (Concat a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Concat a -> m (Concat a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Concat a -> m (Concat a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Concat a -> m (Concat a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Concat a -> m (Concat a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Concat a -> m (Concat a)
Data, 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
$cshowsPrec :: forall a. Show a => Int -> Concat a -> ShowS
showsPrec :: Int -> Concat a -> ShowS
$cshow :: forall a. Show a => Concat a -> String
show :: Concat a -> String
$cshowList :: forall a. Show a => [Concat a] -> ShowS
showList :: [Concat a] -> ShowS
Show, Typeable)

{-# DEPRECATED concatenate, extract "Concat is not wrapping Seq any more, don't use concatenate nor extract." #-}
concatenate :: PositiveMonoid a => Seq a -> Concat a
concatenate :: forall a. PositiveMonoid a => Seq a -> Concat a
concatenate 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 a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr (\a
a 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 :: forall a. 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 a. Concat a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList

force :: Semigroup a => Concat a -> a
force :: forall a. Semigroup a => Concat a -> a
force (Leaf a
x) = a
x
force (Concat a
x :<> 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
   Concat a
x == :: Concat a -> Concat a -> Bool
== 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 Concat a
x 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 :: forall a b. (a -> b) -> Concat a -> Concat b
fmap a -> b
f (Leaf a
x) = b -> Concat b
forall a. a -> Concat a
Leaf (a -> b
f a
x)
   fmap a -> b
f (Concat a
l :<> Concat a
r) = (a -> b) -> Concat a -> Concat b
forall a b. (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 a b. (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 :: forall a. a -> Concat a
pure = a -> Concat a
forall a. a -> Concat a
Leaf
   Leaf a -> b
f <*> :: forall a b. Concat (a -> b) -> Concat a -> Concat b
<*> 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
   (Concat (a -> b)
f1 :<> Concat (a -> b)
f2) <*> Concat a
x = (Concat (a -> b)
f1 Concat (a -> b) -> Concat a -> Concat b
forall a b. 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 a b. 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 :: forall m. Monoid m => Concat m -> m
fold (Leaf m
x) = m
x
   fold (Concat m
x :<> Concat m
y) = Concat m -> m
forall m. Monoid m => 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 m. Monoid m => Concat m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold Concat m
y
   foldMap :: forall m a. Monoid m => (a -> m) -> Concat a -> m
foldMap a -> m
f (Leaf a
x) = a -> m
f a
x
   foldMap a -> m
f (Concat a
x :<> Concat a
y) = (a -> m) -> Concat a -> m
forall m a. Monoid m => (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 m a. Monoid m => (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 :: forall b a. (b -> a -> b) -> b -> Concat a -> b
foldl b -> a -> b
f b
a (Leaf a
x) = b -> a -> b
f b
a a
x
   foldl b -> a -> b
f b
a (Concat a
x :<> Concat a
y) = (b -> a -> b) -> b -> Concat a -> b
forall 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 -> b) -> b -> Concat a -> b
forall 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) Concat a
y
   foldl' :: forall b a. (b -> a -> b) -> b -> Concat a -> b
foldl' b -> a -> b
f b
a (Leaf a
x) = b -> a -> b
f b
a a
x
   foldl' b -> a -> b
f b
a (Concat a
x :<> Concat a
y) = let a' :: b
a' = (b -> a -> b) -> b -> Concat a -> b
forall 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 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
y
   foldr :: forall a b. (a -> b -> b) -> b -> Concat a -> b
foldr a -> b -> b
f b
a (Leaf a
x) = a -> b -> b
f a
x b
a
   foldr a -> b -> b
f b
a (Concat a
x :<> Concat a
y) = (a -> b -> b) -> b -> Concat a -> b
forall a b. (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 a b. (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' :: forall a b. (a -> b -> b) -> b -> Concat a -> b
foldr' a -> b -> b
f b
a (Leaf a
x) = a -> b -> b
f a
x b
a
   foldr' a -> b -> b
f b
a (Concat a
x :<> Concat a
y) = let a' :: b
a' = (a -> b -> b) -> b -> Concat a -> b
forall a b. (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 a b. (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
   Concat a
x <> :: Concat a -> Concat a -> Concat a
<> 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 a
x) = a -> Bool
forall m. MonoidNull m => m -> Bool
null a
x
   null Concat a
_ = 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 a
x) (Leaf 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 (Concat a
xp :<> Concat a
xs) 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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 Concat a
x (Concat a
yp :<> 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 Concat a
yps, Maybe (Concat a)
_) -> 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)
                                  (Maybe (Concat a)
Nothing, Maybe (Concat a)
Nothing) -> Maybe (Concat a)
forall a. Maybe a
Nothing
                                  (Maybe (Concat a)
Nothing, Just 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 a
x) (Leaf 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 (Concat a
xp :<> Concat a
xs) 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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 Concat a
x (Concat a
yp :<> 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 Concat a
ysp, Maybe (Concat a)
_) -> 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)
                                  (Maybe (Concat a)
Nothing, Maybe (Concat a)
Nothing) -> Maybe (Concat a)
forall a. Maybe a
Nothing
                                  (Maybe (Concat a)
Nothing, Just 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 a
x) (Leaf 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 (Concat a
xp :<> Concat a
xs) 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 (Concat a
xpp, Concat a
xps, 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
            (Concat a
xsp, Concat a
xss, 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 Concat a
x (Concat a
yp :<> 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 (Concat a
ypp, Concat a
xs, 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
            (Concat a
ysp, Concat a
xss, 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 a
x) (Leaf 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 (Concat a
xp :<> Concat a
xs) 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 (Concat a
xsp, Concat a
yp, 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
            (Concat a
xpp, Concat a
ypp, 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 Concat a
x (Concat a
yp :<> 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 (Concat a
xp, Concat a
ysp, 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
            (Concat a
xpp, Concat a
ypp, 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 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 a
x) [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 (Concat a
x :<> Concat a
y) [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 a
x) = a -> Concat a
forall a. a -> Concat a
Leaf (a -> a
forall m. Factorial m => m -> m
primePrefix a
x)
   primePrefix (Concat a
x :<> Concat a
_) = Concat a -> Concat a
forall m. Factorial m => m -> m
primePrefix Concat a
x
   primeSuffix :: Concat a -> Concat a
primeSuffix (Leaf a
x) = a -> Concat a
forall a. a -> Concat a
Leaf (a -> a
forall m. Factorial m => m -> m
primeSuffix a
x)
   primeSuffix (Concat a
_ :<> Concat a
y) = Concat a -> Concat a
forall m. Factorial m => m -> m
primeSuffix Concat a
y

   foldl :: forall a. (a -> Concat a -> a) -> a -> Concat a -> a
foldl a -> Concat a -> a
f = (a -> a -> a) -> a -> Concat a -> a
forall b a. (b -> a -> b) -> b -> Concat a -> b
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
forall a. (a -> a -> a) -> a -> a -> a
Factorial.foldl (\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' :: forall a. (a -> Concat a -> a) -> a -> Concat a -> a
foldl' a -> Concat a -> a
f = (a -> a -> a) -> a -> Concat a -> a
forall b a. (b -> a -> b) -> b -> Concat a -> b
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
forall a. (a -> a -> a) -> a -> a -> a
Factorial.foldl' (\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 :: forall a. (Concat a -> a -> a) -> a -> Concat a -> a
foldr Concat a -> a -> a
f = (a -> a -> a) -> a -> Concat a -> a
forall a b. (a -> b -> b) -> b -> Concat a -> b
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 -> a -> a) -> a -> a -> a
forall m a. Factorial m => (m -> a -> a) -> a -> m -> a
forall a. (a -> a -> a) -> a -> a -> 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 :: forall n. Monoid n => (Concat a -> n) -> Concat a -> n
foldMap Concat a -> n
f = (a -> n) -> Concat a -> n
forall m a. Monoid m => (a -> m) -> Concat a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap ((a -> n) -> a -> n
forall n. Monoid n => (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 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 m a. Monoid m => (a -> m) -> Concat a -> m
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 a
x) = a -> Concat a
forall a. a -> Concat a
Leaf (a -> a
forall m. Factorial m => m -> m
reverse a
x)
   reverse (Concat a
x :<> 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 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 (Concat a
x :<> 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 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 (Concat a
x :<> Concat a
y) = (Concat a -> Concat a)
-> (Concat a, Concat a) -> (Concat a, Concat a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
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 Concat a -> Bool
p (Leaf 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 Concat a -> Bool
p (Concat a
x :<> 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 (Concat a
xp, 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
            (Concat a
yp, 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 :: forall s.
s
-> (s -> Concat a -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
spanMaybe s
s0 s -> Concat a -> Maybe s
f (Leaf 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 s. 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 -> 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 s
s0 s -> Concat a -> Maybe s
f (Concat a
x :<> 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 (Concat a
xp, Concat a
xs, s
s1) = s
-> (s -> Concat a -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
forall s.
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
            (Concat a
yp, Concat a
ys, s
s2) = s
-> (s -> Concat a -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
forall s.
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' :: forall s.
s
-> (s -> Concat a -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
spanMaybe' s
s0 s -> Concat a -> Maybe s
f 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 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 s. 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 -> 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)
         Concat a
x :<> Concat a
y -> let (Concat a
xp, Concat a
xs, s
s1) = s
-> (s -> Concat a -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
forall s.
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
                        (Concat a
yp, Concat a
ys, s
s2) = s
-> (s -> Concat a -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
forall s.
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 Concat a -> Bool
p = (a -> [Concat a] -> [Concat a])
-> [Concat a] -> Concat a -> [Concat a]
forall a b. (a -> b -> b) -> b -> Concat a -> b
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 ~(Concat a
xp:[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. HasCallStack => [a] -> [a]
init [Concat a]
as [Concat a] -> [Concat a] -> [Concat a]
forall a. [a] -> [a] -> [a]
++ ([Concat a] -> Concat a
forall a. HasCallStack => [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 Int
0 Concat a
c = (Concat a
forall a. Monoid a => a
mempty, Concat a
c)
   splitAt Int
n (Leaf 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 Int
n (Concat a
x :<> 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
            (Concat a
yp, 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
            (Concat a
xp, 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 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 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 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 (Concat a
x :<> 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 a
x) = a -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
characterPrefix a
x
   characterPrefix (Concat a
x :<> Concat a
_) = Concat a -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
characterPrefix Concat a
x
   map :: (Char -> Char) -> Concat a -> Concat a
map Char -> Char
f 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 Concat a -> String
ft 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 a. Concat a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Concat a
x)
   toText :: (Concat a -> Text) -> Concat a -> Text
toText Concat a -> Text
ft Concat a
x = [Text] -> Text
Text.concat ((a -> Text) -> a -> Text
forall t. TextualMonoid t => (t -> Text) -> t -> Text
toText (Concat a -> Text
ft (Concat a -> Text) -> (a -> Concat a) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Concat a
forall a. a -> Concat a
Leaf) (a -> Text) -> [a] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Concat a -> [a]
forall a. Concat a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Concat a
x)

   foldl :: forall a.
(a -> Concat a -> a) -> (a -> Char -> a) -> a -> Concat a -> a
foldl a -> Concat a -> a
ft a -> Char -> a
fc = (a -> a -> a) -> a -> Concat a -> a
forall b a. (b -> a -> b) -> b -> Concat a -> b
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
forall a. (a -> a -> a) -> (a -> Char -> a) -> a -> a -> a
Textual.foldl (\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' :: forall a.
(a -> Concat a -> a) -> (a -> Char -> a) -> a -> Concat a -> a
foldl' a -> Concat a -> a
ft a -> Char -> a
fc = (a -> a -> a) -> a -> Concat a -> a
forall b a. (b -> a -> b) -> b -> Concat a -> b
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
forall a. (a -> a -> a) -> (a -> Char -> a) -> a -> a -> a
Textual.foldl' (\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 :: forall a.
(Concat a -> a -> a) -> (Char -> a -> a) -> a -> Concat a -> a
foldr Concat a -> a -> a
ft Char -> a -> a
fc = (a -> a -> a) -> a -> Concat a -> a
forall a b. (a -> b -> b) -> b -> Concat a -> b
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 -> a -> a) -> (Char -> a -> a) -> a -> a -> a
forall t a.
TextualMonoid t =>
(t -> a -> a) -> (Char -> a -> a) -> a -> t -> a
forall a. (a -> a -> a) -> (Char -> a -> a) -> a -> a -> 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 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 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 Concat a -> Bool
pt Char -> Bool
pc (Leaf 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 Concat a -> Bool
pt Char -> Bool
pc (Concat a
x :<> 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 (Concat a
xp, 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
            (Concat a
yp, 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_ Bool
bt Char -> Bool
pc (Leaf 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_ Bool
bt Char -> Bool
pc (Concat a
x :<> 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 (Concat a
xp, 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
            (Concat a
yp, 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 Concat a -> Bool
pt 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_ Bool
bt 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_ Bool
bt 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_ Bool
bt 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 :: forall s.
s
-> (s -> Concat a -> Maybe s)
-> (s -> Char -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
spanMaybe s
s0 s -> Concat a -> Maybe s
ft s -> Char -> Maybe s
fc (Leaf 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 s.
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 -> 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 s
s0 s -> Concat a -> Maybe s
ft s -> Char -> Maybe s
fc (Concat a
x :<> 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 (Concat a
xp, Concat a
xs, s
s1) = s
-> (s -> Concat a -> Maybe s)
-> (s -> Char -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
forall s.
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
            (Concat a
yp, Concat a
ys, s
s2) = s
-> (s -> Concat a -> Maybe s)
-> (s -> Char -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
forall s.
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' :: forall s.
s
-> (s -> Concat a -> Maybe s)
-> (s -> Char -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
spanMaybe' s
s0 s -> Concat a -> Maybe s
ft s -> Char -> Maybe s
fc 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 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 s.
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 -> 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)
         Concat a
x :<> Concat a
y -> let (Concat a
xp, Concat a
xs, s
s1) = s
-> (s -> Concat a -> Maybe s)
-> (s -> Char -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
forall s.
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
                        (Concat a
yp, Concat a
ys, s
s2) = s
-> (s -> Concat a -> Maybe s)
-> (s -> Char -> Maybe s)
-> Concat a
-> (Concat a, Concat a, s)
forall s.
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_ :: forall s.
s -> (s -> Char -> Maybe s) -> Concat a -> (Concat a, Concat a, s)
spanMaybe_ s
s0 s -> Char -> Maybe s
fc (Leaf 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 s. 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_ s
s0 s -> Char -> Maybe s
fc (Concat a
x :<> 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 (Concat a
xp, Concat a
xs, s
s1) = s -> (s -> Char -> Maybe s) -> Concat a -> (Concat a, Concat a, s)
forall s.
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
            (Concat a
yp, Concat a
ys, s
s2) = s -> (s -> Char -> Maybe s) -> Concat a -> (Concat a, Concat a, s)
forall s.
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_' :: forall s.
s -> (s -> Char -> Maybe s) -> Concat a -> (Concat a, Concat a, s)
spanMaybe_' s
s0 s -> Char -> Maybe s
fc 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 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 s. 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)
         Concat a
x :<> Concat a
y -> let (Concat a
xp, Concat a
xs, s
s1) = s -> (s -> Char -> Maybe s) -> Concat a -> (Concat a, Concat a, s)
forall s.
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
                        (Concat a
yp, Concat a
ys, s
s2) = s -> (s -> Char -> Maybe s) -> Concat a -> (Concat a, Concat a, s)
forall s.
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 Char -> Bool
p = (a -> [Concat a] -> [Concat a])
-> [Concat a] -> Concat a -> [Concat a]
forall a b. (a -> b -> b) -> b -> Concat a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr a -> [Concat a] -> [Concat a]
forall {p}.
(PositiveMonoid p, TextualMonoid p) =>
p -> [Concat p] -> [Concat p]
splitNext [Concat a
forall a. Monoid a => a
mempty]
      where splitNext :: p -> [Concat p] -> [Concat p]
splitNext p
a ~(Concat p
xp:[Concat p]
xs) =
               let as :: [Concat p]
as = p -> Concat p
forall a. a -> Concat a
Leaf (p -> Concat p) -> [p] -> [Concat p]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> p -> [p]
forall t. TextualMonoid t => (Char -> Bool) -> t -> [t]
Textual.split Char -> Bool
p p
a
               in if Concat p -> Bool
forall m. MonoidNull m => m -> Bool
null Concat p
xp
                  then [Concat p]
as [Concat p] -> [Concat p] -> [Concat p]
forall a. [a] -> [a] -> [a]
++ [Concat p]
xs
                  else [Concat p] -> [Concat p]
forall a. HasCallStack => [a] -> [a]
init [Concat p]
as [Concat p] -> [Concat p] -> [Concat p]
forall a. [a] -> [a] -> [a]
++ ([Concat p] -> Concat p
forall a. HasCallStack => [a] -> a
last [Concat p]
as Concat p -> Concat p -> Concat p
forall a. Semigroup a => a -> a -> a
<> Concat p
xp)Concat p -> [Concat p] -> [Concat p]
forall a. a -> [a] -> [a]
:[Concat p]
xs
   find :: (Char -> Bool) -> Concat a -> Maybe Char
find Char -> Bool
p 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 m a. Monoid m => (a -> m) -> Concat a -> m
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 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 :: forall a b. (a -> b) -> (a, a) -> (b, b)
map2 a -> b
f (a
x, a
y) = (a -> b
f a
x, a -> b
f a
y)

map3 :: (a -> b) -> (a, a, a) -> (b, b, b)
map3 :: forall a b. (a -> b) -> (a, a, a) -> (b, b, b)
map3 a -> b
f (a
x, a
y, 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 :: forall a b c. (a -> b) -> (a, a, c) -> (b, b, c)
first2 a -> b
f (a
x, a
y, c
z) = (a -> b
f a
x, a -> b
f a
y, c
z)