{-# 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') = 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 #-}
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 = 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)
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
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
(<\>)
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)
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
(<\>)
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)
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)
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)
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
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.\\)
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
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 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
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
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
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)
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"
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
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
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
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
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