{- 
    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 is contained
-- in any other value @x@ that satifies the property @(x `isPrefixOf` b) && (x `isSuffixOf` a)@:
--
-- > (x `isPrefixOf` overlap a b) && (x `isSuffixOf` overlap a b)
--
-- and it must be unique so it's not contained in any other value @y@ that satisfies the same property @(y
-- `isPrefixOf` b) && (y `isSuffixOf` a)@:
--
-- > not ((y `isPrefixOf` overlap a b) && (y `isSuffixOf` overlap a b) && y /= overlap a b)
--
-- @since 1.0
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 a :: m
a b :: m
b = m
b'
      where (_, _, b' :: m
b') = m -> m -> (m, m, m)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap m
a m
b
   stripSuffixOverlap a :: m
a b :: m
b = m
b'
      where (b' :: m
b', _, _) = m -> m -> (m, m, m)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap m
b m
a
   overlap a :: m
a b :: m
b = m
o
      where (_, o :: m
o, _) = 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
a <\> :: Dual a -> Dual a -> Dual a
<\> Dual b :: 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
a) (Dual b :: 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
a) (Dual b :: 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 (p :: a
p, o :: a
o, s :: 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
a) (Dual b :: 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
a) (Dual b :: 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 a :: Natural
a <\> :: Sum Natural -> Sum Natural -> Sum Natural
<\> Sum b :: 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 0

-- | /O(1)/
instance OverlappingGCDMonoid (Sum Natural) where
   overlap :: Sum Natural -> Sum Natural -> Sum Natural
overlap (Sum a :: Natural
a) (Sum b :: 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 a :: Natural
a) (Sum b :: 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 0 <\> :: Product Natural -> Product Natural -> Product Natural
<\> Product 0 = Natural -> Product Natural
forall a. a -> Product a
Product 1
   Product a :: Natural
a <\> Product b :: 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 a :: Natural
a) (Product b :: 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 0) (Product 0) = (Natural -> Product Natural
forall a. a -> Product a
Product 1, Natural -> Product Natural
forall a. a -> Product a
Product 0, Natural -> Product Natural
forall a. a -> Product a
Product 1)
   stripOverlap (Product a :: Natural
a) (Product b :: 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
   (a1 :: a
a1, b1 :: b
b1) <\> :: (a, b) -> (a, b) -> (a, b)
<\> (a2 :: a
a2, b2 :: 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 (a1 :: a
a1, b1 :: b
b1) (a2 :: a
a2, b2 :: 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 (a1 :: a
a1, b1 :: b
b1) (a2 :: a
a2, b2 :: b
b2) = ((a
ap, b
bp), (a
ao, b
bo), (a
as, b
bs))
      where (ap :: a
ap, ao :: a
ao, as :: a
as) = a -> a -> (a, a, a)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap a
a1 a
a2
            (bp :: b
bp, bo :: b
bo, bs :: 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 (a1 :: a
a1, b1 :: b
b1) (a2 :: a
a2, b2 :: 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 (a1 :: a
a1, b1 :: b
b1) (a2 :: a
a2, b2 :: 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
   (a1 :: a
a1, b1 :: b
b1, c1 :: c
c1) <\> :: (a, b, c) -> (a, b, c) -> (a, b, c)
<\> (a2 :: a
a2, b2 :: b
b2, c2 :: 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 (a1 :: a
a1, b1 :: b
b1, c1 :: c
c1) (a2 :: a
a2, b2 :: b
b2, c2 :: 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 (a1 :: a
a1, b1 :: b
b1, c1 :: c
c1) (a2 :: a
a2, b2 :: b
b2, c2 :: c
c2) = ((a
ap, b
bp, c
cp), (a
ao, b
bo, c
co), (a
as, b
bs, c
cs))
      where (ap :: a
ap, ao :: a
ao, as :: a
as) = a -> a -> (a, a, a)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap a
a1 a
a2
            (bp :: b
bp, bo :: b
bo, bs :: b
bs) = b -> b -> (b, b, b)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap b
b1 b
b2
            (cp :: c
cp, co :: c
co, cs :: 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 (a1 :: a
a1, b1 :: b
b1, c1 :: c
c1) (a2 :: a
a2, b2 :: b
b2, c2 :: 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 (a1 :: a
a1, b1 :: b
b1, c1 :: c
c1) (a2 :: a
a2, b2 :: b
b2, c2 :: 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
   (a1 :: a
a1, b1 :: b
b1, c1 :: c
c1, d1 :: d
d1) <\> :: (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
<\> (a2 :: a
a2, b2 :: b
b2, c2 :: c
c2, d2 :: 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 (a1 :: a
a1, b1 :: b
b1, c1 :: c
c1, d1 :: d
d1) (a2 :: a
a2, b2 :: b
b2, c2 :: c
c2, d2 :: 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 (a1 :: a
a1, b1 :: b
b1, c1 :: c
c1, d1 :: d
d1) (a2 :: a
a2, b2 :: b
b2, c2 :: c
c2, d2 :: 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 (ap :: a
ap, ao :: a
ao, as :: a
as) = a -> a -> (a, a, a)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap a
a1 a
a2
            (bp :: b
bp, bo :: b
bo, bs :: b
bs) = b -> b -> (b, b, b)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap b
b1 b
b2
            (cp :: c
cp, co :: c
co, cs :: c
cs) = c -> c -> (c, c, c)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap c
c1 c
c2
            (dp :: d
dp, dm :: d
dm, ds :: 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 (a1 :: a
a1, b1 :: b
b1, c1 :: c
c1, d1 :: d
d1) (a2 :: a
a2, b2 :: b
b2, c2 :: c
c2, d2 :: 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 (a1 :: a
a1, b1 :: b
b1, c1 :: c
c1, d1 :: d
d1) (a2 :: a
a2, b2 :: b
b2, c2 :: c
c2, d2 :: 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
a <\> :: Maybe a -> Maybe a -> Maybe a
<\> Just b :: a
b = a -> Maybe a
forall a. a -> Maybe a
Just (a
a a -> a -> a
forall m. Monus m => m -> m -> m
<\> a
b)
   Nothing <\> _ = Maybe a
forall a. Maybe a
Nothing
   x :: Maybe a
x <\> Nothing = Maybe a
x

instance (OverlappingGCDMonoid a, MonoidNull a) => OverlappingGCDMonoid (Maybe a) where
   overlap :: Maybe a -> Maybe a -> Maybe a
overlap (Just a :: a
a) (Just b :: 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
forall a. Maybe a
Nothing
   stripOverlap :: Maybe a -> Maybe a -> (Maybe a, Maybe a, Maybe a)
stripOverlap (Just a :: a
a) (Just b :: a
b) = (a -> Maybe a
forall a. a -> Maybe a
Just a
a', a -> Maybe a
forall a. a -> Maybe a
Just a
o, a -> Maybe a
forall a. a -> Maybe a
Just a
b')
      where (a' :: a
a', o :: a
o, b' :: a
b') = a -> a -> (a, a, a)
forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap a
a a
b
   stripOverlap a :: Maybe a
a b :: 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
a) (Just b :: 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 Nothing x :: Maybe a
x = Maybe a
x
   stripPrefixOverlap _ Nothing = Maybe a
forall a. Maybe a
Nothing
   stripSuffixOverlap :: Maybe a -> Maybe a -> Maybe a
stripSuffixOverlap (Just a :: a
a) (Just b :: 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 Nothing x :: Maybe a
x = Maybe a
x
   stripSuffixOverlap _ 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 a :: Set a
a b :: 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 a :: Set a
a b :: 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 a :: Set a
a b :: 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 a :: IntSet
a b :: 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 a :: IntSet
a b :: IntSet
b = IntSet
b IntSet -> IntSet -> IntSet
forall m. Monus m => m -> m -> m
<\> IntSet
a
   stripSuffixOverlap :: IntSet -> IntSet -> IntSet
stripSuffixOverlap a :: IntSet
a b :: 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
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 a :: Map k v
a b :: Map k v
b = (Map k v -> Map k v -> Map k v
forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap 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
stripSuffixOverlap 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 a :: Map k v
a b :: 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 (\x :: v
x y :: 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
forall a b. IntMap a -> IntMap b -> IntMap a
IntMap.intersection
    stripOverlap :: IntMap a -> IntMap a -> (IntMap a, IntMap a, IntMap a)
stripOverlap a :: IntMap a
a b :: IntMap a
b = (IntMap a -> IntMap a -> IntMap a
forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap 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
stripSuffixOverlap 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 a :: IntMap a
a b :: 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 (\x :: a
x y :: 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]
b = [a] -> [a]
go [a]
a
      where go :: [a] -> [a]
go x :: [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. [a] -> [a]
tail [a]
x)
   stripOverlap :: [a] -> [a] -> ([a], [a], [a])
stripOverlap a :: [a]
a b :: [a]
b = [a] -> [a] -> ([a], [a], [a])
go [] [a]
a
      where go :: [a] -> [a] -> ([a], [a], [a])
go p :: [a]
p o :: [a]
o | Just s :: [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)
                   | x :: a
x:xs :: [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 "impossible"
   stripPrefixOverlap :: [a] -> [a] -> [a]
stripPrefixOverlap a :: [a]
a b :: [a]
b = [a] -> [a]
go [a]
a
      where go :: [a] -> [a]
go x :: [a]
x | Just s :: [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. [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 a :: Seq a
a b :: 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 x :: 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
                 | _ :< x' :: 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 "impossible"
   stripOverlap :: Seq a -> Seq a -> (Seq a, Seq a, Seq a)
stripOverlap a :: Seq a
a b :: 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 p :: Seq a
p o :: Seq a
o | Just s :: 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)
                   | x :: a
x :< xs :: 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 "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 a :: Vector a
a b :: 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 i :: 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 (ap :: Vector a
ap, as :: 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
                     (bp :: Vector a
bp, bs :: 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 a :: ByteString
a b :: 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 i :: 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 (ap :: ByteString
ap, as :: ByteString
as) = Int -> ByteString -> (ByteString, ByteString)
ByteString.splitAt (Int
alen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) ByteString
a
                     (bp :: ByteString
bp, bs :: 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 a :: ByteString
a b :: 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 i :: 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 (ap :: ByteString
ap, as :: ByteString
as) = Int64 -> ByteString -> (ByteString, ByteString)
LazyByteString.splitAt (Int64
alen Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
i) ByteString
a
                     (bp :: ByteString
bp, bs :: 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 a :: Text
a b :: Text
b
      | Text -> Bool
Text.null Text
b = (Text
a, Text
b, Text
b)
      | Bool
otherwise = [(Text, Text)] -> (Text, Text, Text)
go (Text -> Text -> [(Text, Text)]
Text.breakOnAll (Int -> Text -> Text
Text.take 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 ((ap :: Text
ap, as :: Text
as):breaks :: [(Text, Text)]
breaks)
               | Just bs :: 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 a :: Text
a b :: Text
b
      | Text -> Bool
LazyText.null Text
b = (Text
a, Text
b, Text
b)
      | Bool
otherwise = [(Text, Text)] -> (Text, Text, Text)
go (Text -> Text -> [(Text, Text)]
LazyText.breakOnAll (Int64 -> Text -> Text
LazyText.take 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 ((ap :: Text
ap, as :: Text
as):breaks :: [(Text, Text)]
breaks)
               | Just bs :: 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