{-# LANGUAGE Haskell2010, FlexibleInstances, Trustworthy #-}
module Data.Monoid.Monus (
Monus(..), OverlappingGCDMonoid(..)
)
where
import Data.Monoid
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 (Commutative m, Monoid m, OverlappingGCDMonoid m) => Monus m where
(<\>) :: m -> m -> m
infix 5 <\>
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 #-}
instance Monus () where
() <\> :: () -> () -> ()
<\> () = ()
instance OverlappingGCDMonoid () where
overlap :: () -> () -> ()
overlap () () = ()
stripOverlap :: () -> () -> ((), (), ())
stripOverlap () () = ((), (), ())
stripPrefixOverlap :: () -> () -> ()
stripPrefixOverlap () () = ()
stripSuffixOverlap :: () -> () -> ()
stripSuffixOverlap () () = ()
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)
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
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
(<\>)
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)
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
(<\>)
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)
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)
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)
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
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.\\)
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
instance Monus IntSet.IntSet where
<\> :: IntSet -> IntSet -> IntSet
(<\>) = IntSet -> IntSet -> IntSet
(IntSet.\\)
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
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
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
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)
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"
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
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
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
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
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