{- 
    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
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') = 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
_) = 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
_) = 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 = forall a. a -> Dual a
Dual (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) = forall a. a -> Dual a
Dual (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) = (forall a. a -> Dual a
Dual a
s, forall a. a -> Dual a
Dual a
o, forall a. a -> Dual a
Dual a
p)
      where (a
p, a
o, a
s) = 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) = forall a. a -> Dual a
Dual (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) = forall a. a -> Dual a
Dual (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 forall a. Ord a => a -> a -> Bool
> Natural
b = forall a. a -> Sum a
Sum (Natural
a forall a. Num a => a -> a -> a
- Natural
b)
      | Bool
otherwise = 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) = forall a. a -> Sum a
Sum (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) = (forall a. a -> Sum a
Sum forall a b. (a -> b) -> a -> b
$ Natural
a forall a. Num a => a -> a -> a
- Natural
c, forall a. a -> Sum a
Sum Natural
c, forall a. a -> Sum a
Sum forall a b. (a -> b) -> a -> b
$ Natural
b forall a. Num a => a -> a -> a
- Natural
c)
      where c :: Natural
c = forall a. Ord a => a -> a -> a
min Natural
a Natural
b
   stripPrefixOverlap :: Sum Natural -> Sum Natural -> Sum Natural
stripPrefixOverlap = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall m. Monus m => m -> m -> m
(<\>)
   stripSuffixOverlap :: Sum Natural -> Sum Natural -> Sum Natural
stripSuffixOverlap = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = forall a. a -> Product a
Product Natural
1
   Product Natural
a <\> Product Natural
b = forall a. a -> Product a
Product (Natural
a forall a. Integral a => a -> a -> a
`div` 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) = forall a. a -> Product a
Product (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) = (forall a. a -> Product a
Product Natural
1, forall a. a -> Product a
Product Natural
0, forall a. a -> Product a
Product Natural
1)
   stripOverlap (Product Natural
a) (Product Natural
b) = (forall a. a -> Product a
Product forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div Natural
a Natural
c, forall a. a -> Product a
Product Natural
c, forall a. a -> Product a
Product forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
div Natural
b Natural
c)
      where c :: Natural
c = forall a. Integral a => a -> a -> a
gcd Natural
a Natural
b
   stripPrefixOverlap :: Product Natural -> Product Natural -> Product Natural
stripPrefixOverlap = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall m. Monus m => m -> m -> m
(<\>)
   stripSuffixOverlap :: Product Natural -> Product Natural -> Product Natural
stripSuffixOverlap = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 forall m. Monus m => m -> m -> m
<\> a
a2, b
b1 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) = (forall m. OverlappingGCDMonoid m => m -> m -> m
overlap a
a1 a
a2, 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) = forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap a
a1 a
a2
            (b
bp, b
bo, b
bs) = 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) = (forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap a
a1 a
a2, 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) = (forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap a
a1 a
a2, 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 forall m. Monus m => m -> m -> m
<\> a
a2, b
b1 forall m. Monus m => m -> m -> m
<\> b
b2, c
c1 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) = (forall m. OverlappingGCDMonoid m => m -> m -> m
overlap a
a1 a
a2, forall m. OverlappingGCDMonoid m => m -> m -> m
overlap b
b1 b
b2, 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) = forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap a
a1 a
a2
            (b
bp, b
bo, b
bs) = forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap b
b1 b
b2
            (c
cp, c
co, c
cs) = 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) = (forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap a
a1 a
a2, forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap b
b1 b
b2, 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) = (forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap a
a1 a
a2, forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap b
b1 b
b2, 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 forall m. Monus m => m -> m -> m
<\> a
a2, b
b1 forall m. Monus m => m -> m -> m
<\> b
b2, c
c1 forall m. Monus m => m -> m -> m
<\> c
c2, d
d1 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) = (forall m. OverlappingGCDMonoid m => m -> m -> m
overlap a
a1 a
a2, forall m. OverlappingGCDMonoid m => m -> m -> m
overlap b
b1 b
b2, forall m. OverlappingGCDMonoid m => m -> m -> m
overlap c
c1 c
c2, 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) = forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap a
a1 a
a2
            (b
bp, b
bo, b
bs) = forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap b
b1 b
b2
            (c
cp, c
co, c
cs) = forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap c
c1 c
c2
            (d
dp, d
dm, d
ds) = 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) =
      (forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap a
a1 a
a2, forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap b
b1 b
b2, forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap c
c1 c
c2, 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) =
      (forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap a
a1 a
a2, forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap b
b1 b
b2, forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap c
c1 c
c2, 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
      | forall m. MonoidNull m => m -> Bool
null a
remainder = forall a. Maybe a
Nothing
      | Bool
otherwise = forall a. a -> Maybe a
Just a
remainder
    where
      remainder :: a
remainder = a
a forall m. Monus m => m -> m -> m
<\> a
b
   Maybe a
Nothing <\> 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) = forall a. a -> Maybe a
Just (forall m. OverlappingGCDMonoid m => m -> m -> m
overlap a
a a
b)
   overlap 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 forall m. MonoidNull m => m -> Bool
null a
a' then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just a
a', forall a. a -> Maybe a
Just a
o, if forall m. MonoidNull m => m -> Bool
null a
b' then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just a
b')
      where (a
a', a
o, a
b') = forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m)
stripOverlap a
a a
b
   stripOverlap Maybe a
a Maybe a
b = (Maybe a
a, forall a. Maybe a
Nothing, Maybe a
b)
   stripPrefixOverlap :: Maybe a -> Maybe a -> Maybe a
stripPrefixOverlap (Just a
a) (Just a
b)
      | forall m. MonoidNull m => m -> Bool
null a
b' = forall a. Maybe a
Nothing
      | Bool
otherwise = forall a. a -> Maybe a
Just a
b'
      where b' :: a
b' = 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 = forall a. Maybe a
Nothing
   stripSuffixOverlap :: Maybe a -> Maybe a -> Maybe a
stripSuffixOverlap (Just a
a) (Just a
b)
      | forall m. MonoidNull m => m -> Bool
null a
b' = forall a. Maybe a
Nothing
      | Bool
otherwise = forall a. a -> Maybe a
Just a
b'
      where b' :: a
b' = 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 = 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
(<\>) = 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 = 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 = (forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set a
a Set a
b, forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set a
a Set a
b, 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 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 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 forall m. Monus m => m -> m -> m
<\> IntSet
a
   stripSuffixOverlap :: IntSet -> IntSet -> IntSet
stripSuffixOverlap IntSet
a IntSet
b = IntSet
b 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = (forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap Map k v
b Map k v
a, forall m. OverlappingGCDMonoid m => m -> m -> m
overlap Map k v
a Map k v
b, 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = 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 forall a. Eq a => a -> a -> Bool
== v
y then forall a. Maybe a
Nothing else 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = (forall m. OverlappingGCDMonoid m => m -> m -> m
stripSuffixOverlap IntMap a
b IntMap a
a, forall m. OverlappingGCDMonoid m => m -> m -> m
overlap IntMap a
a IntMap a
b, forall m. OverlappingGCDMonoid m => m -> m -> m
stripPrefixOverlap IntMap a
a IntMap a
b)
    stripPrefixOverlap :: IntMap a -> IntMap a -> IntMap a
stripPrefixOverlap = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = forall a b. (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
IntMap.differenceWith (\a
x a
y-> if a
x forall a. Eq a => a -> a -> Bool
== a
y then forall a. Maybe a
Nothing else 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 forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` [a]
b = [a]
x
                 | Bool
otherwise = [a] -> [a]
go (forall a. [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 <- forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix [a]
o [a]
b = (forall a. [a] -> [a]
reverse [a]
p, [a]
o, [a]
s)
                   | a
x:[a]
xs <- [a]
o = [a] -> [a] -> ([a], [a], [a])
go (a
xforall a. a -> [a] -> [a]
:[a]
p) [a]
xs
                   | Bool
otherwise = 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 <- forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix [a]
x [a]
b = [a]
s
                 | Bool
otherwise = [a] -> [a]
go (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 Seq a
a Seq a
b = Seq a -> Seq a
go (forall a. Int -> Seq a -> Seq a
Sequence.drop (forall a. Seq a -> Int
Sequence.length Seq a
a forall a. Num a => a -> a -> a
- 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 forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` Seq a
b = Seq a
x
                 | a
_ :< Seq a
x' <- forall a. Seq a -> ViewL a
Sequence.viewl Seq a
x = Seq a -> Seq a
go Seq a
x'
                 | Bool
otherwise = 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 = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Seq a -> Seq a -> (Seq a, Seq a, Seq a)
go (forall a. Int -> Seq a -> (Seq a, Seq a)
Sequence.splitAt (forall a. Seq a -> Int
Sequence.length Seq a
a forall a. Num a => a -> a -> a
- 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 <- 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 <- 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 forall a. Seq a -> a -> Seq a
|> a
x) Seq a
xs
                   | Bool
otherwise = 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 (forall a. Ord a => a -> a -> a
max Int
alen Int
blen)
      where alen :: Int
alen = forall a. Vector a -> Int
Vector.length Vector a
a
            blen :: Int
blen = forall a. Vector a -> Int
Vector.length Vector a
b
            go :: Int -> (Vector a, Vector a, Vector a)
go Int
i | Vector a
as 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 (forall a. Enum a => a -> a
pred Int
i)
               where (Vector a
ap, Vector a
as) = forall a. Int -> Vector a -> (Vector a, Vector a)
Vector.splitAt (Int
alen forall a. Num a => a -> a -> a
- Int
i) Vector a
a
                     (Vector a
bp, Vector a
bs) = 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 (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 forall a. Eq a => a -> a -> Bool
== ByteString
bp = (ByteString
ap, ByteString
as, ByteString
bs)
                 | Bool
otherwise = Int -> (ByteString, ByteString, ByteString)
go (forall a. Enum a => a -> a
pred Int
i)
               where (ByteString
ap, ByteString
as) = Int -> ByteString -> (ByteString, ByteString)
ByteString.splitAt (Int
alen 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 (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 forall a. Eq a => a -> a -> Bool
== ByteString
bp = (ByteString
ap, ByteString
as, ByteString
bs)
                 | Bool
otherwise = Int64 -> (ByteString, ByteString, ByteString)
go (forall a. Enum a => a -> a
pred Int64
i)
               where (ByteString
ap, ByteString
as) = Int64 -> ByteString -> (ByteString, ByteString)
LazyByteString.splitAt (Int64
alen 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 (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, 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 (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, 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