{- 
    Copyright 2013-2019 Mario Blazevic

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

-- | This module defines the 'OverlappingGCDMonoid' => 'Monus' subclass of the 'Monoid' class.
--
-- @since 1.0

{-# LANGUAGE Haskell2010, FlexibleInstances, Trustworthy #-}

module Data.Monoid.Monus (
   Monus(..), OverlappingGCDMonoid(..)
   )
where
   
import Data.Monoid -- (Monoid, Dual(..), Sum(..), Product(..))
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as LazyByteString
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Map as Map
import qualified Data.Sequence as Sequence
import qualified Data.Set as Set
import Data.Sequence (ViewL((:<)), (|>))
import qualified Data.Vector as Vector
import Numeric.Natural (Natural)

import Data.Semigroup.Cancellative
import Data.Monoid.Null (MonoidNull(null))

import Prelude hiding (null)

-- | Class of Abelian monoids with monus. The monus operation '<\>' is a synonym for both 'stripPrefixOverlap' and
-- 'stripSuffixOverlap', which must be equivalent as '<>' is both associative and commutative:
--
-- > (<\>) = flip stripPrefixOverlap
-- > (<\>) = flip stripSuffixOverlap
--
-- @since 1.0
class (Commutative m, Monoid m, OverlappingGCDMonoid m) => Monus m where
   (<\>) :: m -> m -> m

infix 5 <\>

-- | Class of monoids for which the greatest overlap can be found between any two values, such that
--
-- > a == a' <> overlap a b
-- > b == overlap a b <> b'
--
-- The methods must satisfy the following laws:
--
-- > stripOverlap a b == (stripSuffixOverlap b a, overlap a b, stripPrefixOverlap a b)
-- > stripSuffixOverlap b a <> overlap a b == a
-- > overlap a b <> stripPrefixOverlap a b == b
--
-- The result of @overlap a b@ must be the largest prefix of @b@ and suffix of @a@, in the sense that it contains any
-- other value @x@ that satifies the property @(x `isPrefixOf` b) && (x `isSuffixOf` a)@:
--
-- > ∀x. (x `isPrefixOf` b && x `isSuffixOf` a) => (x `isPrefixOf` overlap a b && x `isSuffixOf` overlap a b)
--
-- and it must be unique so there's no other value @y@ that satisfies the same properties for every such @x@:
--
-- > ∀y. ((∀x. (x `isPrefixOf` b && x `isSuffixOf` a) => x `isPrefixOf` y && x `isSuffixOf` y) => y == overlap a b)
--
-- @since 1.0
--
-- In addition, the 'overlap' operation must satisfy the following properties:
--
-- __/Idempotence/__
--
-- @
-- 'overlap' a a '==' a
-- @
--
-- __/Identity/__
--
-- @
-- 'overlap' 'mempty' a '==' 'mempty'
-- @
-- @
-- 'overlap' a 'mempty' '==' 'mempty'
-- @
--
class (Monoid m, LeftReductive m, RightReductive m) => OverlappingGCDMonoid m where
   stripPrefixOverlap :: m -> m -> m
   stripSuffixOverlap :: m -> m -> m
   overlap :: m -> m -> m
   stripOverlap :: m -> m -> (m, m, m)

   stripPrefixOverlap m
a m
b = m
b'
      where (m
_, m
_, m
b') = m -> m -> (m, m, m)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap m
a m
b
   stripSuffixOverlap m
a m
b = m
b'
      where (m
b', m
_, m
_) = m -> m -> (m, m, m)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap m
b m
a
   overlap m
a m
b = m
o
      where (m
_, m
o, m
_) = m -> m -> (m, m, m)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap m
a m
b
   {-# MINIMAL stripOverlap #-}

-- Unit instances

-- | /O(1)/
instance Monus () where
   () <\> :: () -> () -> ()
<\> () = ()

-- | /O(1)/
instance OverlappingGCDMonoid () where
   overlap :: () -> () -> ()
overlap () () = ()
   stripOverlap :: () -> () -> ((), (), ())
stripOverlap () () = ((), (), ())
   stripPrefixOverlap :: () -> () -> ()
stripPrefixOverlap () () = ()
   stripSuffixOverlap :: () -> () -> ()
stripSuffixOverlap () () = ()

-- Dual instances

instance Monus a => Monus (Dual a) where
   Dual a
a <\> :: Dual a -> Dual a -> Dual a
<\> Dual a
b = a -> Dual a
forall a. a -> Dual a
Dual (a
a a -> a -> a
forall m. Monus m => m -> m -> m
<\> a
b)

instance OverlappingGCDMonoid a => OverlappingGCDMonoid (Dual a) where
   overlap :: Dual a -> Dual a -> Dual a
overlap (Dual a
a) (Dual a
b) = a -> Dual a
forall a. a -> Dual a
Dual (a -> a -> a
forall m. OverlappingGCDMonoid m => m -> m -> m
overlap a
b a
a)
   stripOverlap :: Dual a -> Dual a -> (Dual a, Dual a, Dual a)
stripOverlap (Dual a
a) (Dual a
b) = (a -> Dual a
forall a. a -> Dual a
Dual a
s, a -> Dual a
forall a. a -> Dual a
Dual a
o, a -> Dual a
forall a. a -> Dual a
Dual a
p)
      where (a
p, a
o, a
s) = a -> a -> (a, a, a)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap a
b a
a
   stripPrefixOverlap :: Dual a -> Dual a -> Dual a
stripPrefixOverlap (Dual a
a) (Dual a
b) = a -> Dual a
forall a. a -> Dual a
Dual (a -> a -> a
forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap a
a a
b)
   stripSuffixOverlap :: Dual a -> Dual a -> Dual a
stripSuffixOverlap (Dual a
a) (Dual a
b) = a -> Dual a
forall a. a -> Dual a
Dual (a -> a -> a
forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap a
a a
b)

-- Sum instances

-- | /O(1)/
instance Monus (Sum Natural) where
   Sum Natural
a <\> :: Sum Natural -> Sum Natural -> Sum Natural
<\> Sum Natural
b
      | Natural
a Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
b = Natural -> Sum Natural
forall a. a -> Sum a
Sum (Natural
a Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
b)
      | Bool
otherwise = Natural -> Sum Natural
forall a. a -> Sum a
Sum Natural
0

-- | /O(1)/
instance OverlappingGCDMonoid (Sum Natural) where
   overlap :: Sum Natural -> Sum Natural -> Sum Natural
overlap (Sum Natural
a) (Sum Natural
b) = Natural -> Sum Natural
forall a. a -> Sum a
Sum (Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
min Natural
a Natural
b)
   stripOverlap :: Sum Natural
-> Sum Natural -> (Sum Natural, Sum Natural, Sum Natural)
stripOverlap (Sum Natural
a) (Sum Natural
b) = (Natural -> Sum Natural
forall a. a -> Sum a
Sum (Natural -> Sum Natural) -> Natural -> Sum Natural
forall a b. (a -> b) -> a -> b
$ Natural
a Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
c, Natural -> Sum Natural
forall a. a -> Sum a
Sum Natural
c, Natural -> Sum Natural
forall a. a -> Sum a
Sum (Natural -> Sum Natural) -> Natural -> Sum Natural
forall a b. (a -> b) -> a -> b
$ Natural
b Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
c)
      where c :: Natural
c = Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
min Natural
a Natural
b
   stripPrefixOverlap :: Sum Natural -> Sum Natural -> Sum Natural
stripPrefixOverlap = (Sum Natural -> Sum Natural -> Sum Natural)
-> Sum Natural -> Sum Natural -> Sum Natural
forall a b c. (a -> b -> c) -> b -> a -> c
flip Sum Natural -> Sum Natural -> Sum Natural
forall m. Monus m => m -> m -> m
(<\>)
   stripSuffixOverlap :: Sum Natural -> Sum Natural -> Sum Natural
stripSuffixOverlap = (Sum Natural -> Sum Natural -> Sum Natural)
-> Sum Natural -> Sum Natural -> Sum Natural
forall a b c. (a -> b -> c) -> b -> a -> c
flip Sum Natural -> Sum Natural -> Sum Natural
forall m. Monus m => m -> m -> m
(<\>)

-- Product instances

-- | /O(1)/
instance Monus (Product Natural) where
   Product Natural
0 <\> :: Product Natural -> Product Natural -> Product Natural
<\> Product Natural
0 = Natural -> Product Natural
forall a. a -> Product a
Product Natural
1
   Product Natural
a <\> Product Natural
b = Natural -> Product Natural
forall a. a -> Product a
Product (Natural
a Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
`div` Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
Prelude.gcd Natural
a Natural
b)

-- | /O(1)/
instance OverlappingGCDMonoid (Product Natural) where
   overlap :: Product Natural -> Product Natural -> Product Natural
overlap (Product Natural
a) (Product Natural
b) = Natural -> Product Natural
forall a. a -> Product a
Product (Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
gcd Natural
a Natural
b)
   stripOverlap :: Product Natural
-> Product Natural
-> (Product Natural, Product Natural, Product Natural)
stripOverlap (Product Natural
0) (Product Natural
0) = (Natural -> Product Natural
forall a. a -> Product a
Product Natural
1, Natural -> Product Natural
forall a. a -> Product a
Product Natural
0, Natural -> Product Natural
forall a. a -> Product a
Product Natural
1)
   stripOverlap (Product Natural
a) (Product Natural
b) = (Natural -> Product Natural
forall a. a -> Product a
Product (Natural -> Product Natural) -> Natural -> Product Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
div Natural
a Natural
c, Natural -> Product Natural
forall a. a -> Product a
Product Natural
c, Natural -> Product Natural
forall a. a -> Product a
Product (Natural -> Product Natural) -> Natural -> Product Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
div Natural
b Natural
c)
      where c :: Natural
c = Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
gcd Natural
a Natural
b
   stripPrefixOverlap :: Product Natural -> Product Natural -> Product Natural
stripPrefixOverlap = (Product Natural -> Product Natural -> Product Natural)
-> Product Natural -> Product Natural -> Product Natural
forall a b c. (a -> b -> c) -> b -> a -> c
flip Product Natural -> Product Natural -> Product Natural
forall m. Monus m => m -> m -> m
(<\>)
   stripSuffixOverlap :: Product Natural -> Product Natural -> Product Natural
stripSuffixOverlap = (Product Natural -> Product Natural -> Product Natural)
-> Product Natural -> Product Natural -> Product Natural
forall a b c. (a -> b -> c) -> b -> a -> c
flip Product Natural -> Product Natural -> Product Natural
forall m. Monus m => m -> m -> m
(<\>)

-- Pair instances

instance (Monus a, Monus b) => Monus (a, b) where
   (a
a1, b
b1) <\> :: (a, b) -> (a, b) -> (a, b)
<\> (a
a2, b
b2) = (a
a1 a -> a -> a
forall m. Monus m => m -> m -> m
<\> a
a2, b
b1 b -> b -> b
forall m. Monus m => m -> m -> m
<\> b
b2)

instance (OverlappingGCDMonoid a, OverlappingGCDMonoid b) => OverlappingGCDMonoid (a, b) where
   overlap :: (a, b) -> (a, b) -> (a, b)
overlap (a
a1, b
b1) (a
a2, b
b2) = (a -> a -> a
forall m. OverlappingGCDMonoid m => m -> m -> m
overlap a
a1 a
a2, b -> b -> b
forall m. OverlappingGCDMonoid m => m -> m -> m
overlap b
b1 b
b2)
   stripOverlap :: (a, b) -> (a, b) -> ((a, b), (a, b), (a, b))
stripOverlap (a
a1, b
b1) (a
a2, b
b2) = ((a
ap, b
bp), (a
ao, b
bo), (a
as, b
bs))
      where (a
ap, a
ao, a
as) = a -> a -> (a, a, a)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap a
a1 a
a2
            (b
bp, b
bo, b
bs) = b -> b -> (b, b, b)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap b
b1 b
b2
   stripPrefixOverlap :: (a, b) -> (a, b) -> (a, b)
stripPrefixOverlap (a
a1, b
b1) (a
a2, b
b2) = (a -> a -> a
forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap a
a1 a
a2, b -> b -> b
forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap b
b1 b
b2)
   stripSuffixOverlap :: (a, b) -> (a, b) -> (a, b)
stripSuffixOverlap (a
a1, b
b1) (a
a2, b
b2) = (a -> a -> a
forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap a
a1 a
a2, b -> b -> b
forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap b
b1 b
b2)

-- Triple instances

instance (Monus a, Monus b, Monus c) => Monus (a, b, c) where
   (a
a1, b
b1, c
c1) <\> :: (a, b, c) -> (a, b, c) -> (a, b, c)
<\> (a
a2, b
b2, c
c2) = (a
a1 a -> a -> a
forall m. Monus m => m -> m -> m
<\> a
a2, b
b1 b -> b -> b
forall m. Monus m => m -> m -> m
<\> b
b2, c
c1 c -> c -> c
forall m. Monus m => m -> m -> m
<\> c
c2)

instance (OverlappingGCDMonoid a, OverlappingGCDMonoid b, OverlappingGCDMonoid c) =>
         OverlappingGCDMonoid (a, b, c) where
   overlap :: (a, b, c) -> (a, b, c) -> (a, b, c)
overlap (a
a1, b
b1, c
c1) (a
a2, b
b2, c
c2) = (a -> a -> a
forall m. OverlappingGCDMonoid m => m -> m -> m
overlap a
a1 a
a2, b -> b -> b
forall m. OverlappingGCDMonoid m => m -> m -> m
overlap b
b1 b
b2, c -> c -> c
forall m. OverlappingGCDMonoid m => m -> m -> m
overlap c
c1 c
c2)
   stripOverlap :: (a, b, c) -> (a, b, c) -> ((a, b, c), (a, b, c), (a, b, c))
stripOverlap (a
a1, b
b1, c
c1) (a
a2, b
b2, c
c2) = ((a
ap, b
bp, c
cp), (a
ao, b
bo, c
co), (a
as, b
bs, c
cs))
      where (a
ap, a
ao, a
as) = a -> a -> (a, a, a)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap a
a1 a
a2
            (b
bp, b
bo, b
bs) = b -> b -> (b, b, b)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap b
b1 b
b2
            (c
cp, c
co, c
cs) = c -> c -> (c, c, c)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap c
c1 c
c2
   stripPrefixOverlap :: (a, b, c) -> (a, b, c) -> (a, b, c)
stripPrefixOverlap (a
a1, b
b1, c
c1) (a
a2, b
b2, c
c2) = (a -> a -> a
forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap a
a1 a
a2, b -> b -> b
forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap b
b1 b
b2, c -> c -> c
forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap c
c1 c
c2)
   stripSuffixOverlap :: (a, b, c) -> (a, b, c) -> (a, b, c)
stripSuffixOverlap (a
a1, b
b1, c
c1) (a
a2, b
b2, c
c2) = (a -> a -> a
forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap a
a1 a
a2, b -> b -> b
forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap b
b1 b
b2, c -> c -> c
forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap c
c1 c
c2)

-- Quadruple instances

instance (Monus a, Monus b, Monus c, Monus d) => Monus (a, b, c, d) where
   (a
a1, b
b1, c
c1, d
d1) <\> :: (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
<\> (a
a2, b
b2, c
c2, d
d2) = (a
a1 a -> a -> a
forall m. Monus m => m -> m -> m
<\> a
a2, b
b1 b -> b -> b
forall m. Monus m => m -> m -> m
<\> b
b2, c
c1 c -> c -> c
forall m. Monus m => m -> m -> m
<\> c
c2, d
d1 d -> d -> d
forall m. Monus m => m -> m -> m
<\> d
d2)

instance (OverlappingGCDMonoid a, OverlappingGCDMonoid b, OverlappingGCDMonoid c, OverlappingGCDMonoid d) =>
         OverlappingGCDMonoid (a, b, c, d) where
   overlap :: (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
overlap (a
a1, b
b1, c
c1, d
d1) (a
a2, b
b2, c
c2, d
d2) = (a -> a -> a
forall m. OverlappingGCDMonoid m => m -> m -> m
overlap a
a1 a
a2, b -> b -> b
forall m. OverlappingGCDMonoid m => m -> m -> m
overlap b
b1 b
b2, c -> c -> c
forall m. OverlappingGCDMonoid m => m -> m -> m
overlap c
c1 c
c2, d -> d -> d
forall m. OverlappingGCDMonoid m => m -> m -> m
overlap d
d1 d
d2)
   stripOverlap :: (a, b, c, d)
-> (a, b, c, d) -> ((a, b, c, d), (a, b, c, d), (a, b, c, d))
stripOverlap (a
a1, b
b1, c
c1, d
d1) (a
a2, b
b2, c
c2, d
d2) = ((a
ap, b
bp, c
cp, d
dp), (a
ao, b
bo, c
co, d
dm), (a
as, b
bs, c
cs, d
ds))
      where (a
ap, a
ao, a
as) = a -> a -> (a, a, a)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap a
a1 a
a2
            (b
bp, b
bo, b
bs) = b -> b -> (b, b, b)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap b
b1 b
b2
            (c
cp, c
co, c
cs) = c -> c -> (c, c, c)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap c
c1 c
c2
            (d
dp, d
dm, d
ds) = d -> d -> (d, d, d)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap d
d1 d
d2
   stripPrefixOverlap :: (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
stripPrefixOverlap (a
a1, b
b1, c
c1, d
d1) (a
a2, b
b2, c
c2, d
d2) =
      (a -> a -> a
forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap a
a1 a
a2, b -> b -> b
forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap b
b1 b
b2, c -> c -> c
forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap c
c1 c
c2, d -> d -> d
forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap d
d1 d
d2)
   stripSuffixOverlap :: (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
stripSuffixOverlap (a
a1, b
b1, c
c1, d
d1) (a
a2, b
b2, c
c2, d
d2) =
      (a -> a -> a
forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap a
a1 a
a2, b -> b -> b
forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap b
b1 b
b2, c -> c -> c
forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap c
c1 c
c2, d -> d -> d
forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap d
d1 d
d2)

-- Maybe instances

instance (Monus a, MonoidNull a) => Monus (Maybe a) where
   Just a
a <\> :: Maybe a -> Maybe a -> Maybe a
<\> Just a
b
      | a -> Bool
forall m. MonoidNull m => m -> Bool
null a
remainder = Maybe a
forall a. Maybe a
Nothing
      | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just a
remainder
    where
      remainder :: a
remainder = a
a a -> a -> a
forall m. Monus m => m -> m -> m
<\> a
b
   Maybe a
Nothing <\> Maybe a
_ = Maybe a
forall a. Maybe a
Nothing
   Maybe a
x <\> Maybe a
Nothing = Maybe a
x

instance (OverlappingGCDMonoid a, MonoidNull a) => OverlappingGCDMonoid (Maybe a) where
   overlap :: Maybe a -> Maybe a -> Maybe a
overlap (Just a
a) (Just a
b) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> a -> a
forall m. OverlappingGCDMonoid m => m -> m -> m
overlap a
a a
b)
   overlap Maybe a
_ Maybe a
_ = Maybe a
forall a. Maybe a
Nothing
   stripOverlap :: Maybe a -> Maybe a -> (Maybe a, Maybe a, Maybe a)
stripOverlap (Just a
a) (Just a
b) = (if a -> Bool
forall m. MonoidNull m => m -> Bool
null a
a' then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
a', a -> Maybe a
forall a. a -> Maybe a
Just a
o, if a -> Bool
forall m. MonoidNull m => m -> Bool
null a
b' then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
b')
      where (a
a', a
o, a
b') = a -> a -> (a, a, a)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap a
a a
b
   stripOverlap Maybe a
a Maybe a
b = (Maybe a
a, Maybe a
forall a. Maybe a
Nothing, Maybe a
b)
   stripPrefixOverlap :: Maybe a -> Maybe a -> Maybe a
stripPrefixOverlap (Just a
a) (Just a
b)
      | a -> Bool
forall m. MonoidNull m => m -> Bool
null a
b' = Maybe a
forall a. Maybe a
Nothing
      | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just a
b'
      where b' :: a
b' = a -> a -> a
forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap a
a a
b
   stripPrefixOverlap Maybe a
Nothing Maybe a
x = Maybe a
x
   stripPrefixOverlap Maybe a
_ Maybe a
Nothing = Maybe a
forall a. Maybe a
Nothing
   stripSuffixOverlap :: Maybe a -> Maybe a -> Maybe a
stripSuffixOverlap (Just a
a) (Just a
b)
      | a -> Bool
forall m. MonoidNull m => m -> Bool
null a
b' = Maybe a
forall a. Maybe a
Nothing
      | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just a
b'
      where b' :: a
b' = a -> a -> a
forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap a
a a
b
   stripSuffixOverlap Maybe a
Nothing Maybe a
x = Maybe a
x
   stripSuffixOverlap Maybe a
_ Maybe a
Nothing = Maybe a
forall a. Maybe a
Nothing

-- Set instances

-- | /O(m*log(n/m + 1)), m <= n/
instance Ord a => Monus (Set.Set a) where
   <\> :: Set a -> Set a -> Set a
(<\>) = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
(Set.\\)

-- | /O(m*log(n/m + 1)), m <= n/
instance Ord a => OverlappingGCDMonoid (Set.Set a) where
   overlap :: Set a -> Set a -> Set a
overlap = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection
   stripOverlap :: Set a -> Set a -> (Set a, Set a, Set a)
stripOverlap Set a
a Set a
b = (Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set a
a Set a
b, Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set a
a Set a
b, Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set a
b Set a
a)
   stripPrefixOverlap :: Set a -> Set a -> Set a
stripPrefixOverlap Set a
a Set a
b = Set a
b Set a -> Set a -> Set a
forall m. Monus m => m -> m -> m
<\> Set a
a
   stripSuffixOverlap :: Set a -> Set a -> Set a
stripSuffixOverlap Set a
a Set a
b = Set a
b Set a -> Set a -> Set a
forall m. Monus m => m -> m -> m
<\> Set a
a

-- IntSet instances

-- | /O(m+n)/
instance Monus IntSet.IntSet where
   <\> :: IntSet -> IntSet -> IntSet
(<\>) = IntSet -> IntSet -> IntSet
(IntSet.\\)

-- | /O(m+n)/
instance OverlappingGCDMonoid IntSet.IntSet where
   overlap :: IntSet -> IntSet -> IntSet
overlap = IntSet -> IntSet -> IntSet
IntSet.intersection
   stripOverlap :: IntSet -> IntSet -> (IntSet, IntSet, IntSet)
stripOverlap IntSet
a IntSet
b = (IntSet -> IntSet -> IntSet
IntSet.difference IntSet
a IntSet
b, IntSet -> IntSet -> IntSet
IntSet.intersection IntSet
a IntSet
b, IntSet -> IntSet -> IntSet
IntSet.difference IntSet
b IntSet
a)
   stripPrefixOverlap :: IntSet -> IntSet -> IntSet
stripPrefixOverlap IntSet
a IntSet
b = IntSet
b IntSet -> IntSet -> IntSet
forall m. Monus m => m -> m -> m
<\> IntSet
a
   stripSuffixOverlap :: IntSet -> IntSet -> IntSet
stripSuffixOverlap IntSet
a IntSet
b = IntSet
b IntSet -> IntSet -> IntSet
forall m. Monus m => m -> m -> m
<\> IntSet
a

-- Map instances

-- | /O(m+n)/
instance (Ord k, Eq v) => OverlappingGCDMonoid (Map.Map k v) where
    overlap :: Map k v -> Map k v -> Map k v
overlap = (Map k v -> Map k v -> Map k v) -> Map k v -> Map k v -> Map k v
forall a b c. (a -> b -> c) -> b -> a -> c
flip Map k v -> Map k v -> Map k v
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection
    stripOverlap :: Map k v -> Map k v -> (Map k v, Map k v, Map k v)
stripOverlap Map k v
a Map k v
b = (Map k v -> Map k v -> Map k v
forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap Map k v
b Map k v
a, Map k v -> Map k v -> Map k v
forall m. OverlappingGCDMonoid m => m -> m -> m
overlap Map k v
a Map k v
b, Map k v -> Map k v -> Map k v
forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap Map k v
a Map k v
b)
    stripPrefixOverlap :: Map k v -> Map k v -> Map k v
stripPrefixOverlap = (Map k v -> Map k v -> Map k v) -> Map k v -> Map k v -> Map k v
forall a b c. (a -> b -> c) -> b -> a -> c
flip Map k v -> Map k v -> Map k v
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference
    stripSuffixOverlap :: Map k v -> Map k v -> Map k v
stripSuffixOverlap Map k v
a Map k v
b = (v -> v -> Maybe v) -> Map k v -> Map k v -> Map k v
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith (\v
x v
y-> if v
x v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
y then Maybe v
forall a. Maybe a
Nothing else v -> Maybe v
forall a. a -> Maybe a
Just v
x) Map k v
b Map k v
a

-- IntMap instances

-- | /O(m+n)/
instance Eq a => OverlappingGCDMonoid (IntMap.IntMap a) where
    overlap :: IntMap a -> IntMap a -> IntMap a
overlap = (IntMap a -> IntMap a -> IntMap a)
-> IntMap a -> IntMap a -> IntMap a
forall a b c. (a -> b -> c) -> b -> a -> c
flip IntMap a -> IntMap a -> IntMap a
forall a b. IntMap a -> IntMap b -> IntMap a
IntMap.intersection
    stripOverlap :: IntMap a -> IntMap a -> (IntMap a, IntMap a, IntMap a)
stripOverlap IntMap a
a IntMap a
b = (IntMap a -> IntMap a -> IntMap a
forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap IntMap a
b IntMap a
a, IntMap a -> IntMap a -> IntMap a
forall m. OverlappingGCDMonoid m => m -> m -> m
overlap IntMap a
a IntMap a
b, IntMap a -> IntMap a -> IntMap a
forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap IntMap a
a IntMap a
b)
    stripPrefixOverlap :: IntMap a -> IntMap a -> IntMap a
stripPrefixOverlap = (IntMap a -> IntMap a -> IntMap a)
-> IntMap a -> IntMap a -> IntMap a
forall a b c. (a -> b -> c) -> b -> a -> c
flip IntMap a -> IntMap a -> IntMap a
forall a b. IntMap a -> IntMap b -> IntMap a
IntMap.difference
    stripSuffixOverlap :: IntMap a -> IntMap a -> IntMap a
stripSuffixOverlap IntMap a
a IntMap a
b = (a -> a -> Maybe a) -> IntMap a -> IntMap a -> IntMap a
forall a b. (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
IntMap.differenceWith (\a
x a
y-> if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
x) IntMap a
b IntMap a
a

-- List instances

-- | /O(m*n)/
instance Eq a => OverlappingGCDMonoid [a] where
   overlap :: [a] -> [a] -> [a]
overlap [a]
a [a]
b = [a] -> [a]
go [a]
a
      where go :: [a] -> [a]
go [a]
x | [a]
x [a] -> [a] -> Bool
forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` [a]
b = [a]
x
                 | Bool
otherwise = [a] -> [a]
go ([a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail [a]
x)
   stripOverlap :: [a] -> [a] -> ([a], [a], [a])
stripOverlap [a]
a [a]
b = [a] -> [a] -> ([a], [a], [a])
go [] [a]
a
      where go :: [a] -> [a] -> ([a], [a], [a])
go [a]
p [a]
o | Just [a]
s <- [a] -> [a] -> Maybe [a]
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix [a]
o [a]
b = ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
p, [a]
o, [a]
s)
                   | a
x:[a]
xs <- [a]
o = [a] -> [a] -> ([a], [a], [a])
go (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
p) [a]
xs
                   | Bool
otherwise = [Char] -> ([a], [a], [a])
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"
   stripPrefixOverlap :: [a] -> [a] -> [a]
stripPrefixOverlap [a]
a [a]
b = [a] -> [a]
go [a]
a
      where go :: [a] -> [a]
go [a]
x | Just [a]
s <- [a] -> [a] -> Maybe [a]
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix [a]
x [a]
b = [a]
s
                 | Bool
otherwise = [a] -> [a]
go ([a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail [a]
x)

-- Seq instances

-- | /O(min(m,n)^2)/
instance Eq a => OverlappingGCDMonoid (Sequence.Seq a) where
   overlap :: Seq a -> Seq a -> Seq a
overlap Seq a
a Seq a
b = Seq a -> Seq a
go (Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
Sequence.drop (Seq a -> Int
forall a. Seq a -> Int
Sequence.length Seq a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Seq a -> Int
forall a. Seq a -> Int
Sequence.length Seq a
b) Seq a
a)
      where go :: Seq a -> Seq a
go Seq a
x | Seq a
x Seq a -> Seq a -> Bool
forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` Seq a
b = Seq a
x
                 | a
_ :< Seq a
x' <- Seq a -> ViewL a
forall a. Seq a -> ViewL a
Sequence.viewl Seq a
x = Seq a -> Seq a
go Seq a
x'
                 | Bool
otherwise = [Char] -> Seq a
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"
   stripOverlap :: Seq a -> Seq a -> (Seq a, Seq a, Seq a)
stripOverlap Seq a
a Seq a
b = (Seq a -> Seq a -> (Seq a, Seq a, Seq a))
-> (Seq a, Seq a) -> (Seq a, Seq a, Seq a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Seq a -> Seq a -> (Seq a, Seq a, Seq a)
go (Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Sequence.splitAt (Seq a -> Int
forall a. Seq a -> Int
Sequence.length Seq a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Seq a -> Int
forall a. Seq a -> Int
Sequence.length Seq a
b) Seq a
a)
      where go :: Seq a -> Seq a -> (Seq a, Seq a, Seq a)
go Seq a
p Seq a
o | Just Seq a
s <- Seq a -> Seq a -> Maybe (Seq a)
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix Seq a
o Seq a
b = (Seq a
p, Seq a
o, Seq a
s)
                   | a
x :< Seq a
xs <- Seq a -> ViewL a
forall a. Seq a -> ViewL a
Sequence.viewl Seq a
o = Seq a -> Seq a -> (Seq a, Seq a, Seq a)
go (Seq a
p Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
x) Seq a
xs
                   | Bool
otherwise = [Char] -> (Seq a, Seq a, Seq a)
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

-- Vector instances

-- | /O(min(m,n)^2)/
instance Eq a => OverlappingGCDMonoid (Vector.Vector a) where
   stripOverlap :: Vector a -> Vector a -> (Vector a, Vector a, Vector a)
stripOverlap Vector a
a Vector a
b = Int -> (Vector a, Vector a, Vector a)
go (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
alen Int
blen)
      where alen :: Int
alen = Vector a -> Int
forall a. Vector a -> Int
Vector.length Vector a
a
            blen :: Int
blen = Vector a -> Int
forall a. Vector a -> Int
Vector.length Vector a
b
            go :: Int -> (Vector a, Vector a, Vector a)
go Int
i | Vector a
as Vector a -> Vector a -> Bool
forall a. Eq a => a -> a -> Bool
== Vector a
bp = (Vector a
ap, Vector a
as, Vector a
bs)
                 | Bool
otherwise = Int -> (Vector a, Vector a, Vector a)
go (Int -> Int
forall a. Enum a => a -> a
pred Int
i)
               where (Vector a
ap, Vector a
as) = Int -> Vector a -> (Vector a, Vector a)
forall a. Int -> Vector a -> (Vector a, Vector a)
Vector.splitAt (Int
alen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Vector a
a
                     (Vector a
bp, Vector a
bs) = Int -> Vector a -> (Vector a, Vector a)
forall a. Int -> Vector a -> (Vector a, Vector a)
Vector.splitAt Int
i Vector a
b

-- ByteString instances

-- | /O(min(m,n)^2)/
instance OverlappingGCDMonoid ByteString.ByteString where
   stripOverlap :: ByteString -> ByteString -> (ByteString, ByteString, ByteString)
stripOverlap ByteString
a ByteString
b = Int -> (ByteString, ByteString, ByteString)
go (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
alen Int
blen)
      where alen :: Int
alen = ByteString -> Int
ByteString.length ByteString
a
            blen :: Int
blen = ByteString -> Int
ByteString.length ByteString
b
            go :: Int -> (ByteString, ByteString, ByteString)
go Int
i | ByteString
as ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bp = (ByteString
ap, ByteString
as, ByteString
bs)
                 | Bool
otherwise = Int -> (ByteString, ByteString, ByteString)
go (Int -> Int
forall a. Enum a => a -> a
pred Int
i)
               where (ByteString
ap, ByteString
as) = Int -> ByteString -> (ByteString, ByteString)
ByteString.splitAt (Int
alen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) ByteString
a
                     (ByteString
bp, ByteString
bs) = Int -> ByteString -> (ByteString, ByteString)
ByteString.splitAt Int
i ByteString
b

-- Lazy ByteString instances

-- | /O(m*n)/
instance OverlappingGCDMonoid LazyByteString.ByteString where
   stripOverlap :: ByteString -> ByteString -> (ByteString, ByteString, ByteString)
stripOverlap ByteString
a ByteString
b = Int64 -> (ByteString, ByteString, ByteString)
go (Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max Int64
alen Int64
blen)
      where alen :: Int64
alen = ByteString -> Int64
LazyByteString.length ByteString
a
            blen :: Int64
blen = ByteString -> Int64
LazyByteString.length ByteString
b
            go :: Int64 -> (ByteString, ByteString, ByteString)
go Int64
i | ByteString
as ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bp = (ByteString
ap, ByteString
as, ByteString
bs)
                 | Bool
otherwise = Int64 -> (ByteString, ByteString, ByteString)
go (Int64 -> Int64
forall a. Enum a => a -> a
pred Int64
i)
               where (ByteString
ap, ByteString
as) = Int64 -> ByteString -> (ByteString, ByteString)
LazyByteString.splitAt (Int64
alen Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
i) ByteString
a
                     (ByteString
bp, ByteString
bs) = Int64 -> ByteString -> (ByteString, ByteString)
LazyByteString.splitAt Int64
i ByteString
b

-- Text instances

-- | /O(min(m,n)^2)/
instance OverlappingGCDMonoid Text.Text where
   stripOverlap :: Text -> Text -> (Text, Text, Text)
stripOverlap Text
a Text
b
      | Text -> Bool
Text.null Text
b = (Text
a, Text
b, Text
b)
      | Bool
otherwise = [(Text, Text)] -> (Text, Text, Text)
go (HasCallStack => Text -> Text -> [(Text, Text)]
Text -> Text -> [(Text, Text)]
Text.breakOnAll (Int -> Text -> Text
Text.take Int
1 Text
b) Text
a)
      where go :: [(Text, Text)] -> (Text, Text, Text)
go [] = (Text
a, Text
forall a. Monoid a => a
mempty, Text
b)
            go ((Text
ap, Text
as):[(Text, Text)]
breaks)
               | Just Text
bs <- Text -> Text -> Maybe Text
Text.stripPrefix Text
as Text
b = (Text
ap, Text
as, Text
bs)
               | Bool
otherwise = [(Text, Text)] -> (Text, Text, Text)
go [(Text, Text)]
breaks

-- Lazy Text instances

-- | /O(m*n)/
instance OverlappingGCDMonoid LazyText.Text where
   stripOverlap :: Text -> Text -> (Text, Text, Text)
stripOverlap Text
a Text
b
      | Text -> Bool
LazyText.null Text
b = (Text
a, Text
b, Text
b)
      | Bool
otherwise = [(Text, Text)] -> (Text, Text, Text)
go (HasCallStack => Text -> Text -> [(Text, Text)]
Text -> Text -> [(Text, Text)]
LazyText.breakOnAll (Int64 -> Text -> Text
LazyText.take Int64
1 Text
b) Text
a)
      where go :: [(Text, Text)] -> (Text, Text, Text)
go [] = (Text
a, Text
forall a. Monoid a => a
mempty, Text
b)
            go ((Text
ap, Text
as):[(Text, Text)]
breaks)
               | Just Text
bs <- Text -> Text -> Maybe Text
LazyText.stripPrefix Text
as Text
b = (Text
ap, Text
as, Text
bs)
               | Bool
otherwise = [(Text, Text)] -> (Text, Text, Text)
go [(Text, Text)]
breaks