{- Copyright 2013-2019 Mario Blazevic License: BSD3 (see BSD3-LICENSE.txt file) -} -- | This module defines the 'OverlappingGCDMonoid' => 'Monus' subclass of the 'Monoid' class. -- -- @since 1.0 {-# LANGUAGE Haskell2010, FlexibleInstances, Trustworthy #-} module Data.Monoid.Monus ( Monus(..), OverlappingGCDMonoid(..) ) where import Data.Monoid -- (Monoid, Dual(..), Sum(..), Product(..)) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Lazy as LazyByteString import qualified Data.Text as Text import qualified Data.Text.Lazy as LazyText import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet import qualified Data.Map as Map import qualified Data.Sequence as Sequence import qualified Data.Set as Set import Data.Sequence (ViewL((:<)), (|>)) import qualified Data.Vector as Vector import Numeric.Natural (Natural) import Data.Semigroup.Cancellative import Data.Monoid.Null (MonoidNull(null)) import Prelude hiding (null) -- | Class of Abelian monoids with monus. The monus operation '<\>' is a synonym for both 'stripPrefixOverlap' and -- 'stripSuffixOverlap', which must be equivalent as '<>' is both associative and commutative: -- -- > (<\>) = flip stripPrefixOverlap -- > (<\>) = flip stripSuffixOverlap -- -- @since 1.0 class (Commutative m, Monoid m, OverlappingGCDMonoid m) => Monus m where (<\>) :: m -> m -> m infix 5 <\> -- | Class of monoids for which the greatest overlap can be found between any two values, such that -- -- > a == a' <> overlap a b -- > b == overlap a b <> b' -- -- The methods must satisfy the following laws: -- -- > stripOverlap a b == (stripSuffixOverlap b a, overlap a b, stripPrefixOverlap a b) -- > stripSuffixOverlap b a <> overlap a b == a -- > overlap a b <> stripPrefixOverlap a b == b -- -- The result of @overlap a b@ must be the largest prefix of @b@ and suffix of @a@, in the sense that it contains any -- other value @x@ that satifies the property @(x `isPrefixOf` b) && (x `isSuffixOf` a)@: -- -- > ∀x. (x `isPrefixOf` b && x `isSuffixOf` a) => (x `isPrefixOf` overlap a b && x `isSuffixOf` overlap a b) -- -- and it must be unique so there's no other value @y@ that satisfies the same properties for every such @x@: -- -- > ∀y. ((∀x. (x `isPrefixOf` b && x `isSuffixOf` a) => x `isPrefixOf` y && x `isSuffixOf` y) => y == overlap a b) -- -- @since 1.0 -- -- In addition, the 'overlap' operation must satisfy the following properties: -- -- __/Idempotence/__ -- -- @ -- 'overlap' a a '==' a -- @ -- -- __/Identity/__ -- -- @ -- 'overlap' 'mempty' a '==' 'mempty' -- @ -- @ -- 'overlap' a 'mempty' '==' 'mempty' -- @ -- class (Monoid m, LeftReductive m, RightReductive m) => OverlappingGCDMonoid m where stripPrefixOverlap :: m -> m -> m stripSuffixOverlap :: m -> m -> m overlap :: m -> m -> m stripOverlap :: m -> m -> (m, m, m) stripPrefixOverlap m a m b = m b' where (m _, m _, m b') = m -> m -> (m, m, m) forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m) stripOverlap m a m b stripSuffixOverlap m a m b = m b' where (m b', m _, m _) = m -> m -> (m, m, m) forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m) stripOverlap m b m a overlap m a m b = m o where (m _, m o, m _) = m -> m -> (m, m, m) forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m) stripOverlap m a m b {-# MINIMAL stripOverlap #-} -- Unit instances -- | /O(1)/ instance Monus () where () <\> :: () -> () -> () <\> () = () -- | /O(1)/ instance OverlappingGCDMonoid () where overlap :: () -> () -> () overlap () () = () stripOverlap :: () -> () -> ((), (), ()) stripOverlap () () = ((), (), ()) stripPrefixOverlap :: () -> () -> () stripPrefixOverlap () () = () stripSuffixOverlap :: () -> () -> () stripSuffixOverlap () () = () -- Dual instances instance Monus a => Monus (Dual a) where Dual a a <\> :: Dual a -> Dual a -> Dual a <\> Dual a b = a -> Dual a forall a. a -> Dual a Dual (a a a -> a -> a forall m. Monus m => m -> m -> m <\> a b) instance OverlappingGCDMonoid a => OverlappingGCDMonoid (Dual a) where overlap :: Dual a -> Dual a -> Dual a overlap (Dual a a) (Dual a b) = a -> Dual a forall a. a -> Dual a Dual (a -> a -> a forall m. OverlappingGCDMonoid m => m -> m -> m overlap a b a a) stripOverlap :: Dual a -> Dual a -> (Dual a, Dual a, Dual a) stripOverlap (Dual a a) (Dual a b) = (a -> Dual a forall a. a -> Dual a Dual a s, a -> Dual a forall a. a -> Dual a Dual a o, a -> Dual a forall a. a -> Dual a Dual a p) where (a p, a o, a s) = a -> a -> (a, a, a) forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m) stripOverlap a b a a stripPrefixOverlap :: Dual a -> Dual a -> Dual a stripPrefixOverlap (Dual a a) (Dual a b) = a -> Dual a forall a. a -> Dual a Dual (a -> a -> a forall m. OverlappingGCDMonoid m => m -> m -> m stripSuffixOverlap a a a b) stripSuffixOverlap :: Dual a -> Dual a -> Dual a stripSuffixOverlap (Dual a a) (Dual a b) = a -> Dual a forall a. a -> Dual a Dual (a -> a -> a forall m. OverlappingGCDMonoid m => m -> m -> m stripPrefixOverlap a a a b) -- Sum instances -- | /O(1)/ instance Monus (Sum Natural) where Sum Natural a <\> :: Sum Natural -> Sum Natural -> Sum Natural <\> Sum Natural b | Natural a Natural -> Natural -> Bool forall a. Ord a => a -> a -> Bool > Natural b = Natural -> Sum Natural forall a. a -> Sum a Sum (Natural a Natural -> Natural -> Natural forall a. Num a => a -> a -> a - Natural b) | Bool otherwise = Natural -> Sum Natural forall a. a -> Sum a Sum Natural 0 -- | /O(1)/ instance OverlappingGCDMonoid (Sum Natural) where overlap :: Sum Natural -> Sum Natural -> Sum Natural overlap (Sum Natural a) (Sum Natural b) = Natural -> Sum Natural forall a. a -> Sum a Sum (Natural -> Natural -> Natural forall a. Ord a => a -> a -> a min Natural a Natural b) stripOverlap :: Sum Natural -> Sum Natural -> (Sum Natural, Sum Natural, Sum Natural) stripOverlap (Sum Natural a) (Sum Natural b) = (Natural -> Sum Natural forall a. a -> Sum a Sum (Natural -> Sum Natural) -> Natural -> Sum Natural forall a b. (a -> b) -> a -> b $ Natural a Natural -> Natural -> Natural forall a. Num a => a -> a -> a - Natural c, Natural -> Sum Natural forall a. a -> Sum a Sum Natural c, Natural -> Sum Natural forall a. a -> Sum a Sum (Natural -> Sum Natural) -> Natural -> Sum Natural forall a b. (a -> b) -> a -> b $ Natural b Natural -> Natural -> Natural forall a. Num a => a -> a -> a - Natural c) where c :: Natural c = Natural -> Natural -> Natural forall a. Ord a => a -> a -> a min Natural a Natural b stripPrefixOverlap :: Sum Natural -> Sum Natural -> Sum Natural stripPrefixOverlap = (Sum Natural -> Sum Natural -> Sum Natural) -> Sum Natural -> Sum Natural -> Sum Natural forall a b c. (a -> b -> c) -> b -> a -> c flip Sum Natural -> Sum Natural -> Sum Natural forall m. Monus m => m -> m -> m (<\>) stripSuffixOverlap :: Sum Natural -> Sum Natural -> Sum Natural stripSuffixOverlap = (Sum Natural -> Sum Natural -> Sum Natural) -> Sum Natural -> Sum Natural -> Sum Natural forall a b c. (a -> b -> c) -> b -> a -> c flip Sum Natural -> Sum Natural -> Sum Natural forall m. Monus m => m -> m -> m (<\>) -- Product instances -- | /O(1)/ instance Monus (Product Natural) where Product Natural 0 <\> :: Product Natural -> Product Natural -> Product Natural <\> Product Natural 0 = Natural -> Product Natural forall a. a -> Product a Product Natural 1 Product Natural a <\> Product Natural b = Natural -> Product Natural forall a. a -> Product a Product (Natural a Natural -> Natural -> Natural forall a. Integral a => a -> a -> a `div` Natural -> Natural -> Natural forall a. Integral a => a -> a -> a Prelude.gcd Natural a Natural b) -- | /O(1)/ instance OverlappingGCDMonoid (Product Natural) where overlap :: Product Natural -> Product Natural -> Product Natural overlap (Product Natural a) (Product Natural b) = Natural -> Product Natural forall a. a -> Product a Product (Natural -> Natural -> Natural forall a. Integral a => a -> a -> a gcd Natural a Natural b) stripOverlap :: Product Natural -> Product Natural -> (Product Natural, Product Natural, Product Natural) stripOverlap (Product Natural 0) (Product Natural 0) = (Natural -> Product Natural forall a. a -> Product a Product Natural 1, Natural -> Product Natural forall a. a -> Product a Product Natural 0, Natural -> Product Natural forall a. a -> Product a Product Natural 1) stripOverlap (Product Natural a) (Product Natural b) = (Natural -> Product Natural forall a. a -> Product a Product (Natural -> Product Natural) -> Natural -> Product Natural forall a b. (a -> b) -> a -> b $ Natural -> Natural -> Natural forall a. Integral a => a -> a -> a div Natural a Natural c, Natural -> Product Natural forall a. a -> Product a Product Natural c, Natural -> Product Natural forall a. a -> Product a Product (Natural -> Product Natural) -> Natural -> Product Natural forall a b. (a -> b) -> a -> b $ Natural -> Natural -> Natural forall a. Integral a => a -> a -> a div Natural b Natural c) where c :: Natural c = Natural -> Natural -> Natural forall a. Integral a => a -> a -> a gcd Natural a Natural b stripPrefixOverlap :: Product Natural -> Product Natural -> Product Natural stripPrefixOverlap = (Product Natural -> Product Natural -> Product Natural) -> Product Natural -> Product Natural -> Product Natural forall a b c. (a -> b -> c) -> b -> a -> c flip Product Natural -> Product Natural -> Product Natural forall m. Monus m => m -> m -> m (<\>) stripSuffixOverlap :: Product Natural -> Product Natural -> Product Natural stripSuffixOverlap = (Product Natural -> Product Natural -> Product Natural) -> Product Natural -> Product Natural -> Product Natural forall a b c. (a -> b -> c) -> b -> a -> c flip Product Natural -> Product Natural -> Product Natural forall m. Monus m => m -> m -> m (<\>) -- Pair instances instance (Monus a, Monus b) => Monus (a, b) where (a a1, b b1) <\> :: (a, b) -> (a, b) -> (a, b) <\> (a a2, b b2) = (a a1 a -> a -> a forall m. Monus m => m -> m -> m <\> a a2, b b1 b -> b -> b forall m. Monus m => m -> m -> m <\> b b2) instance (OverlappingGCDMonoid a, OverlappingGCDMonoid b) => OverlappingGCDMonoid (a, b) where overlap :: (a, b) -> (a, b) -> (a, b) overlap (a a1, b b1) (a a2, b b2) = (a -> a -> a forall m. OverlappingGCDMonoid m => m -> m -> m overlap a a1 a a2, b -> b -> b forall m. OverlappingGCDMonoid m => m -> m -> m overlap b b1 b b2) stripOverlap :: (a, b) -> (a, b) -> ((a, b), (a, b), (a, b)) stripOverlap (a a1, b b1) (a a2, b b2) = ((a ap, b bp), (a ao, b bo), (a as, b bs)) where (a ap, a ao, a as) = a -> a -> (a, a, a) forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m) stripOverlap a a1 a a2 (b bp, b bo, b bs) = b -> b -> (b, b, b) forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m) stripOverlap b b1 b b2 stripPrefixOverlap :: (a, b) -> (a, b) -> (a, b) stripPrefixOverlap (a a1, b b1) (a a2, b b2) = (a -> a -> a forall m. OverlappingGCDMonoid m => m -> m -> m stripPrefixOverlap a a1 a a2, b -> b -> b forall m. OverlappingGCDMonoid m => m -> m -> m stripPrefixOverlap b b1 b b2) stripSuffixOverlap :: (a, b) -> (a, b) -> (a, b) stripSuffixOverlap (a a1, b b1) (a a2, b b2) = (a -> a -> a forall m. OverlappingGCDMonoid m => m -> m -> m stripSuffixOverlap a a1 a a2, b -> b -> b forall m. OverlappingGCDMonoid m => m -> m -> m stripSuffixOverlap b b1 b b2) -- Triple instances instance (Monus a, Monus b, Monus c) => Monus (a, b, c) where (a a1, b b1, c c1) <\> :: (a, b, c) -> (a, b, c) -> (a, b, c) <\> (a a2, b b2, c c2) = (a a1 a -> a -> a forall m. Monus m => m -> m -> m <\> a a2, b b1 b -> b -> b forall m. Monus m => m -> m -> m <\> b b2, c c1 c -> c -> c forall m. Monus m => m -> m -> m <\> c c2) instance (OverlappingGCDMonoid a, OverlappingGCDMonoid b, OverlappingGCDMonoid c) => OverlappingGCDMonoid (a, b, c) where overlap :: (a, b, c) -> (a, b, c) -> (a, b, c) overlap (a a1, b b1, c c1) (a a2, b b2, c c2) = (a -> a -> a forall m. OverlappingGCDMonoid m => m -> m -> m overlap a a1 a a2, b -> b -> b forall m. OverlappingGCDMonoid m => m -> m -> m overlap b b1 b b2, c -> c -> c forall m. OverlappingGCDMonoid m => m -> m -> m overlap c c1 c c2) stripOverlap :: (a, b, c) -> (a, b, c) -> ((a, b, c), (a, b, c), (a, b, c)) stripOverlap (a a1, b b1, c c1) (a a2, b b2, c c2) = ((a ap, b bp, c cp), (a ao, b bo, c co), (a as, b bs, c cs)) where (a ap, a ao, a as) = a -> a -> (a, a, a) forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m) stripOverlap a a1 a a2 (b bp, b bo, b bs) = b -> b -> (b, b, b) forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m) stripOverlap b b1 b b2 (c cp, c co, c cs) = c -> c -> (c, c, c) forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m) stripOverlap c c1 c c2 stripPrefixOverlap :: (a, b, c) -> (a, b, c) -> (a, b, c) stripPrefixOverlap (a a1, b b1, c c1) (a a2, b b2, c c2) = (a -> a -> a forall m. OverlappingGCDMonoid m => m -> m -> m stripPrefixOverlap a a1 a a2, b -> b -> b forall m. OverlappingGCDMonoid m => m -> m -> m stripPrefixOverlap b b1 b b2, c -> c -> c forall m. OverlappingGCDMonoid m => m -> m -> m stripPrefixOverlap c c1 c c2) stripSuffixOverlap :: (a, b, c) -> (a, b, c) -> (a, b, c) stripSuffixOverlap (a a1, b b1, c c1) (a a2, b b2, c c2) = (a -> a -> a forall m. OverlappingGCDMonoid m => m -> m -> m stripSuffixOverlap a a1 a a2, b -> b -> b forall m. OverlappingGCDMonoid m => m -> m -> m stripSuffixOverlap b b1 b b2, c -> c -> c forall m. OverlappingGCDMonoid m => m -> m -> m stripSuffixOverlap c c1 c c2) -- Quadruple instances instance (Monus a, Monus b, Monus c, Monus d) => Monus (a, b, c, d) where (a a1, b b1, c c1, d d1) <\> :: (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d) <\> (a a2, b b2, c c2, d d2) = (a a1 a -> a -> a forall m. Monus m => m -> m -> m <\> a a2, b b1 b -> b -> b forall m. Monus m => m -> m -> m <\> b b2, c c1 c -> c -> c forall m. Monus m => m -> m -> m <\> c c2, d d1 d -> d -> d forall m. Monus m => m -> m -> m <\> d d2) instance (OverlappingGCDMonoid a, OverlappingGCDMonoid b, OverlappingGCDMonoid c, OverlappingGCDMonoid d) => OverlappingGCDMonoid (a, b, c, d) where overlap :: (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d) overlap (a a1, b b1, c c1, d d1) (a a2, b b2, c c2, d d2) = (a -> a -> a forall m. OverlappingGCDMonoid m => m -> m -> m overlap a a1 a a2, b -> b -> b forall m. OverlappingGCDMonoid m => m -> m -> m overlap b b1 b b2, c -> c -> c forall m. OverlappingGCDMonoid m => m -> m -> m overlap c c1 c c2, d -> d -> d forall m. OverlappingGCDMonoid m => m -> m -> m overlap d d1 d d2) stripOverlap :: (a, b, c, d) -> (a, b, c, d) -> ((a, b, c, d), (a, b, c, d), (a, b, c, d)) stripOverlap (a a1, b b1, c c1, d d1) (a a2, b b2, c c2, d d2) = ((a ap, b bp, c cp, d dp), (a ao, b bo, c co, d dm), (a as, b bs, c cs, d ds)) where (a ap, a ao, a as) = a -> a -> (a, a, a) forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m) stripOverlap a a1 a a2 (b bp, b bo, b bs) = b -> b -> (b, b, b) forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m) stripOverlap b b1 b b2 (c cp, c co, c cs) = c -> c -> (c, c, c) forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m) stripOverlap c c1 c c2 (d dp, d dm, d ds) = d -> d -> (d, d, d) forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m) stripOverlap d d1 d d2 stripPrefixOverlap :: (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d) stripPrefixOverlap (a a1, b b1, c c1, d d1) (a a2, b b2, c c2, d d2) = (a -> a -> a forall m. OverlappingGCDMonoid m => m -> m -> m stripPrefixOverlap a a1 a a2, b -> b -> b forall m. OverlappingGCDMonoid m => m -> m -> m stripPrefixOverlap b b1 b b2, c -> c -> c forall m. OverlappingGCDMonoid m => m -> m -> m stripPrefixOverlap c c1 c c2, d -> d -> d forall m. OverlappingGCDMonoid m => m -> m -> m stripPrefixOverlap d d1 d d2) stripSuffixOverlap :: (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d) stripSuffixOverlap (a a1, b b1, c c1, d d1) (a a2, b b2, c c2, d d2) = (a -> a -> a forall m. OverlappingGCDMonoid m => m -> m -> m stripSuffixOverlap a a1 a a2, b -> b -> b forall m. OverlappingGCDMonoid m => m -> m -> m stripSuffixOverlap b b1 b b2, c -> c -> c forall m. OverlappingGCDMonoid m => m -> m -> m stripSuffixOverlap c c1 c c2, d -> d -> d forall m. OverlappingGCDMonoid m => m -> m -> m stripSuffixOverlap d d1 d d2) -- Maybe instances instance (Monus a, MonoidNull a) => Monus (Maybe a) where Just a a <\> :: Maybe a -> Maybe a -> Maybe a <\> Just a b | a -> Bool forall m. MonoidNull m => m -> Bool null a remainder = Maybe a forall a. Maybe a Nothing | Bool otherwise = a -> Maybe a forall a. a -> Maybe a Just a remainder where remainder :: a remainder = a a a -> a -> a forall m. Monus m => m -> m -> m <\> a b Maybe a Nothing <\> Maybe a _ = Maybe a forall a. Maybe a Nothing Maybe a x <\> Maybe a Nothing = Maybe a x instance (OverlappingGCDMonoid a, MonoidNull a) => OverlappingGCDMonoid (Maybe a) where overlap :: Maybe a -> Maybe a -> Maybe a overlap (Just a a) (Just a b) = a -> Maybe a forall a. a -> Maybe a Just (a -> a -> a forall m. OverlappingGCDMonoid m => m -> m -> m overlap a a a b) overlap Maybe a _ Maybe a _ = Maybe a forall a. Maybe a Nothing stripOverlap :: Maybe a -> Maybe a -> (Maybe a, Maybe a, Maybe a) stripOverlap (Just a a) (Just a b) = (if a -> Bool forall m. MonoidNull m => m -> Bool null a a' then Maybe a forall a. Maybe a Nothing else a -> Maybe a forall a. a -> Maybe a Just a a', a -> Maybe a forall a. a -> Maybe a Just a o, if a -> Bool forall m. MonoidNull m => m -> Bool null a b' then Maybe a forall a. Maybe a Nothing else a -> Maybe a forall a. a -> Maybe a Just a b') where (a a', a o, a b') = a -> a -> (a, a, a) forall m. OverlappingGCDMonoid m => m -> m -> (m, m, m) stripOverlap a a a b stripOverlap Maybe a a Maybe a b = (Maybe a a, Maybe a forall a. Maybe a Nothing, Maybe a b) stripPrefixOverlap :: Maybe a -> Maybe a -> Maybe a stripPrefixOverlap (Just a a) (Just a b) | a -> Bool forall m. MonoidNull m => m -> Bool null a b' = Maybe a forall a. Maybe a Nothing | Bool otherwise = a -> Maybe a forall a. a -> Maybe a Just a b' where b' :: a b' = a -> a -> a forall m. OverlappingGCDMonoid m => m -> m -> m stripPrefixOverlap a a a b stripPrefixOverlap Maybe a Nothing Maybe a x = Maybe a x stripPrefixOverlap Maybe a _ Maybe a Nothing = Maybe a forall a. Maybe a Nothing stripSuffixOverlap :: Maybe a -> Maybe a -> Maybe a stripSuffixOverlap (Just a a) (Just a b) | a -> Bool forall m. MonoidNull m => m -> Bool null a b' = Maybe a forall a. Maybe a Nothing | Bool otherwise = a -> Maybe a forall a. a -> Maybe a Just a b' where b' :: a b' = a -> a -> a forall m. OverlappingGCDMonoid m => m -> m -> m stripSuffixOverlap a a a b stripSuffixOverlap Maybe a Nothing Maybe a x = Maybe a x stripSuffixOverlap Maybe a _ Maybe a Nothing = Maybe a forall a. Maybe a Nothing -- Set instances -- | /O(m*log(n/m + 1)), m <= n/ instance Ord a => Monus (Set.Set a) where <\> :: Set a -> Set a -> Set a (<\>) = Set a -> Set a -> Set a forall a. Ord a => Set a -> Set a -> Set a (Set.\\) -- | /O(m*log(n/m + 1)), m <= n/ instance Ord a => OverlappingGCDMonoid (Set.Set a) where overlap :: Set a -> Set a -> Set a overlap = Set a -> Set a -> Set a forall a. Ord a => Set a -> Set a -> Set a Set.intersection stripOverlap :: Set a -> Set a -> (Set a, Set a, Set a) stripOverlap Set a a Set a b = (Set a -> Set a -> Set a forall a. Ord a => Set a -> Set a -> Set a Set.difference Set a a Set a b, Set a -> Set a -> Set a forall a. Ord a => Set a -> Set a -> Set a Set.intersection Set a a Set a b, Set a -> Set a -> Set a forall a. Ord a => Set a -> Set a -> Set a Set.difference Set a b Set a a) stripPrefixOverlap :: Set a -> Set a -> Set a stripPrefixOverlap Set a a Set a b = Set a b Set a -> Set a -> Set a forall m. Monus m => m -> m -> m <\> Set a a stripSuffixOverlap :: Set a -> Set a -> Set a stripSuffixOverlap Set a a Set a b = Set a b Set a -> Set a -> Set a forall m. Monus m => m -> m -> m <\> Set a a -- IntSet instances -- | /O(m+n)/ instance Monus IntSet.IntSet where <\> :: IntSet -> IntSet -> IntSet (<\>) = IntSet -> IntSet -> IntSet (IntSet.\\) -- | /O(m+n)/ instance OverlappingGCDMonoid IntSet.IntSet where overlap :: IntSet -> IntSet -> IntSet overlap = IntSet -> IntSet -> IntSet IntSet.intersection stripOverlap :: IntSet -> IntSet -> (IntSet, IntSet, IntSet) stripOverlap IntSet a IntSet b = (IntSet -> IntSet -> IntSet IntSet.difference IntSet a IntSet b, IntSet -> IntSet -> IntSet IntSet.intersection IntSet a IntSet b, IntSet -> IntSet -> IntSet IntSet.difference IntSet b IntSet a) stripPrefixOverlap :: IntSet -> IntSet -> IntSet stripPrefixOverlap IntSet a IntSet b = IntSet b IntSet -> IntSet -> IntSet forall m. Monus m => m -> m -> m <\> IntSet a stripSuffixOverlap :: IntSet -> IntSet -> IntSet stripSuffixOverlap IntSet a IntSet b = IntSet b IntSet -> IntSet -> IntSet forall m. Monus m => m -> m -> m <\> IntSet a -- Map instances -- | /O(m+n)/ instance (Ord k, Eq v) => OverlappingGCDMonoid (Map.Map k v) where overlap :: Map k v -> Map k v -> Map k v overlap = (Map k v -> Map k v -> Map k v) -> Map k v -> Map k v -> Map k v forall a b c. (a -> b -> c) -> b -> a -> c flip Map k v -> Map k v -> Map k v forall k a b. Ord k => Map k a -> Map k b -> Map k a Map.intersection stripOverlap :: Map k v -> Map k v -> (Map k v, Map k v, Map k v) stripOverlap Map k v a Map k v b = (Map k v -> Map k v -> Map k v forall m. OverlappingGCDMonoid m => m -> m -> m stripSuffixOverlap Map k v b Map k v a, Map k v -> Map k v -> Map k v forall m. OverlappingGCDMonoid m => m -> m -> m overlap Map k v a Map k v b, Map k v -> Map k v -> Map k v forall m. OverlappingGCDMonoid m => m -> m -> m stripPrefixOverlap Map k v a Map k v b) stripPrefixOverlap :: Map k v -> Map k v -> Map k v stripPrefixOverlap = (Map k v -> Map k v -> Map k v) -> Map k v -> Map k v -> Map k v forall a b c. (a -> b -> c) -> b -> a -> c flip Map k v -> Map k v -> Map k v forall k a b. Ord k => Map k a -> Map k b -> Map k a Map.difference stripSuffixOverlap :: Map k v -> Map k v -> Map k v stripSuffixOverlap Map k v a Map k v b = (v -> v -> Maybe v) -> Map k v -> Map k v -> Map k v forall k a b. Ord k => (a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a Map.differenceWith (\v x v y-> if v x v -> v -> Bool forall a. Eq a => a -> a -> Bool == v y then Maybe v forall a. Maybe a Nothing else v -> Maybe v forall a. a -> Maybe a Just v x) Map k v b Map k v a -- IntMap instances -- | /O(m+n)/ instance Eq a => OverlappingGCDMonoid (IntMap.IntMap a) where overlap :: IntMap a -> IntMap a -> IntMap a overlap = (IntMap a -> IntMap a -> IntMap a) -> IntMap a -> IntMap a -> IntMap a forall a b c. (a -> b -> c) -> b -> a -> c flip IntMap a -> IntMap a -> IntMap a forall a b. IntMap a -> IntMap b -> IntMap a IntMap.intersection stripOverlap :: IntMap a -> IntMap a -> (IntMap a, IntMap a, IntMap a) stripOverlap IntMap a a IntMap a b = (IntMap a -> IntMap a -> IntMap a forall m. OverlappingGCDMonoid m => m -> m -> m stripSuffixOverlap IntMap a b IntMap a a, IntMap a -> IntMap a -> IntMap a forall m. OverlappingGCDMonoid m => m -> m -> m overlap IntMap a a IntMap a b, IntMap a -> IntMap a -> IntMap a forall m. OverlappingGCDMonoid m => m -> m -> m stripPrefixOverlap IntMap a a IntMap a b) stripPrefixOverlap :: IntMap a -> IntMap a -> IntMap a stripPrefixOverlap = (IntMap a -> IntMap a -> IntMap a) -> IntMap a -> IntMap a -> IntMap a forall a b c. (a -> b -> c) -> b -> a -> c flip IntMap a -> IntMap a -> IntMap a forall a b. IntMap a -> IntMap b -> IntMap a IntMap.difference stripSuffixOverlap :: IntMap a -> IntMap a -> IntMap a stripSuffixOverlap IntMap a a IntMap a b = (a -> a -> Maybe a) -> IntMap a -> IntMap a -> IntMap a forall a b. (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a IntMap.differenceWith (\a x a y-> if a x a -> a -> Bool forall a. Eq a => a -> a -> Bool == a y then Maybe a forall a. Maybe a Nothing else a -> Maybe a forall a. a -> Maybe a Just a x) IntMap a b IntMap a a -- List instances -- | /O(m*n)/ instance Eq a => OverlappingGCDMonoid [a] where overlap :: [a] -> [a] -> [a] overlap [a] a [a] b = [a] -> [a] go [a] a where go :: [a] -> [a] go [a] x | [a] x [a] -> [a] -> Bool forall m. LeftReductive m => m -> m -> Bool `isPrefixOf` [a] b = [a] x | Bool otherwise = [a] -> [a] go ([a] -> [a] forall a. HasCallStack => [a] -> [a] tail [a] x) stripOverlap :: [a] -> [a] -> ([a], [a], [a]) stripOverlap [a] a [a] b = [a] -> [a] -> ([a], [a], [a]) go [] [a] a where go :: [a] -> [a] -> ([a], [a], [a]) go [a] p [a] o | Just [a] s <- [a] -> [a] -> Maybe [a] forall m. LeftReductive m => m -> m -> Maybe m stripPrefix [a] o [a] b = ([a] -> [a] forall a. [a] -> [a] reverse [a] p, [a] o, [a] s) | a x:[a] xs <- [a] o = [a] -> [a] -> ([a], [a], [a]) go (a xa -> [a] -> [a] forall a. a -> [a] -> [a] :[a] p) [a] xs | Bool otherwise = [Char] -> ([a], [a], [a]) forall a. HasCallStack => [Char] -> a error [Char] "impossible" stripPrefixOverlap :: [a] -> [a] -> [a] stripPrefixOverlap [a] a [a] b = [a] -> [a] go [a] a where go :: [a] -> [a] go [a] x | Just [a] s <- [a] -> [a] -> Maybe [a] forall m. LeftReductive m => m -> m -> Maybe m stripPrefix [a] x [a] b = [a] s | Bool otherwise = [a] -> [a] go ([a] -> [a] forall a. HasCallStack => [a] -> [a] tail [a] x) -- Seq instances -- | /O(min(m,n)^2)/ instance Eq a => OverlappingGCDMonoid (Sequence.Seq a) where overlap :: Seq a -> Seq a -> Seq a overlap Seq a a Seq a b = Seq a -> Seq a go (Int -> Seq a -> Seq a forall a. Int -> Seq a -> Seq a Sequence.drop (Seq a -> Int forall a. Seq a -> Int Sequence.length Seq a a Int -> Int -> Int forall a. Num a => a -> a -> a - Seq a -> Int forall a. Seq a -> Int Sequence.length Seq a b) Seq a a) where go :: Seq a -> Seq a go Seq a x | Seq a x Seq a -> Seq a -> Bool forall m. LeftReductive m => m -> m -> Bool `isPrefixOf` Seq a b = Seq a x | a _ :< Seq a x' <- Seq a -> ViewL a forall a. Seq a -> ViewL a Sequence.viewl Seq a x = Seq a -> Seq a go Seq a x' | Bool otherwise = [Char] -> Seq a forall a. HasCallStack => [Char] -> a error [Char] "impossible" stripOverlap :: Seq a -> Seq a -> (Seq a, Seq a, Seq a) stripOverlap Seq a a Seq a b = (Seq a -> Seq a -> (Seq a, Seq a, Seq a)) -> (Seq a, Seq a) -> (Seq a, Seq a, Seq a) forall a b c. (a -> b -> c) -> (a, b) -> c uncurry Seq a -> Seq a -> (Seq a, Seq a, Seq a) go (Int -> Seq a -> (Seq a, Seq a) forall a. Int -> Seq a -> (Seq a, Seq a) Sequence.splitAt (Seq a -> Int forall a. Seq a -> Int Sequence.length Seq a a Int -> Int -> Int forall a. Num a => a -> a -> a - Seq a -> Int forall a. Seq a -> Int Sequence.length Seq a b) Seq a a) where go :: Seq a -> Seq a -> (Seq a, Seq a, Seq a) go Seq a p Seq a o | Just Seq a s <- Seq a -> Seq a -> Maybe (Seq a) forall m. LeftReductive m => m -> m -> Maybe m stripPrefix Seq a o Seq a b = (Seq a p, Seq a o, Seq a s) | a x :< Seq a xs <- Seq a -> ViewL a forall a. Seq a -> ViewL a Sequence.viewl Seq a o = Seq a -> Seq a -> (Seq a, Seq a, Seq a) go (Seq a p Seq a -> a -> Seq a forall a. Seq a -> a -> Seq a |> a x) Seq a xs | Bool otherwise = [Char] -> (Seq a, Seq a, Seq a) forall a. HasCallStack => [Char] -> a error [Char] "impossible" -- Vector instances -- | /O(min(m,n)^2)/ instance Eq a => OverlappingGCDMonoid (Vector.Vector a) where stripOverlap :: Vector a -> Vector a -> (Vector a, Vector a, Vector a) stripOverlap Vector a a Vector a b = Int -> (Vector a, Vector a, Vector a) go (Int -> Int -> Int forall a. Ord a => a -> a -> a max Int alen Int blen) where alen :: Int alen = Vector a -> Int forall a. Vector a -> Int Vector.length Vector a a blen :: Int blen = Vector a -> Int forall a. Vector a -> Int Vector.length Vector a b go :: Int -> (Vector a, Vector a, Vector a) go Int i | Vector a as Vector a -> Vector a -> Bool forall a. Eq a => a -> a -> Bool == Vector a bp = (Vector a ap, Vector a as, Vector a bs) | Bool otherwise = Int -> (Vector a, Vector a, Vector a) go (Int -> Int forall a. Enum a => a -> a pred Int i) where (Vector a ap, Vector a as) = Int -> Vector a -> (Vector a, Vector a) forall a. Int -> Vector a -> (Vector a, Vector a) Vector.splitAt (Int alen Int -> Int -> Int forall a. Num a => a -> a -> a - Int i) Vector a a (Vector a bp, Vector a bs) = Int -> Vector a -> (Vector a, Vector a) forall a. Int -> Vector a -> (Vector a, Vector a) Vector.splitAt Int i Vector a b -- ByteString instances -- | /O(min(m,n)^2)/ instance OverlappingGCDMonoid ByteString.ByteString where stripOverlap :: ByteString -> ByteString -> (ByteString, ByteString, ByteString) stripOverlap ByteString a ByteString b = Int -> (ByteString, ByteString, ByteString) go (Int -> Int -> Int forall a. Ord a => a -> a -> a max Int alen Int blen) where alen :: Int alen = ByteString -> Int ByteString.length ByteString a blen :: Int blen = ByteString -> Int ByteString.length ByteString b go :: Int -> (ByteString, ByteString, ByteString) go Int i | ByteString as ByteString -> ByteString -> Bool forall a. Eq a => a -> a -> Bool == ByteString bp = (ByteString ap, ByteString as, ByteString bs) | Bool otherwise = Int -> (ByteString, ByteString, ByteString) go (Int -> Int forall a. Enum a => a -> a pred Int i) where (ByteString ap, ByteString as) = Int -> ByteString -> (ByteString, ByteString) ByteString.splitAt (Int alen Int -> Int -> Int forall a. Num a => a -> a -> a - Int i) ByteString a (ByteString bp, ByteString bs) = Int -> ByteString -> (ByteString, ByteString) ByteString.splitAt Int i ByteString b -- Lazy ByteString instances -- | /O(m*n)/ instance OverlappingGCDMonoid LazyByteString.ByteString where stripOverlap :: ByteString -> ByteString -> (ByteString, ByteString, ByteString) stripOverlap ByteString a ByteString b = Int64 -> (ByteString, ByteString, ByteString) go (Int64 -> Int64 -> Int64 forall a. Ord a => a -> a -> a max Int64 alen Int64 blen) where alen :: Int64 alen = ByteString -> Int64 LazyByteString.length ByteString a blen :: Int64 blen = ByteString -> Int64 LazyByteString.length ByteString b go :: Int64 -> (ByteString, ByteString, ByteString) go Int64 i | ByteString as ByteString -> ByteString -> Bool forall a. Eq a => a -> a -> Bool == ByteString bp = (ByteString ap, ByteString as, ByteString bs) | Bool otherwise = Int64 -> (ByteString, ByteString, ByteString) go (Int64 -> Int64 forall a. Enum a => a -> a pred Int64 i) where (ByteString ap, ByteString as) = Int64 -> ByteString -> (ByteString, ByteString) LazyByteString.splitAt (Int64 alen Int64 -> Int64 -> Int64 forall a. Num a => a -> a -> a - Int64 i) ByteString a (ByteString bp, ByteString bs) = Int64 -> ByteString -> (ByteString, ByteString) LazyByteString.splitAt Int64 i ByteString b -- Text instances -- | /O(min(m,n)^2)/ instance OverlappingGCDMonoid Text.Text where stripOverlap :: Text -> Text -> (Text, Text, Text) stripOverlap Text a Text b | Text -> Bool Text.null Text b = (Text a, Text b, Text b) | Bool otherwise = [(Text, Text)] -> (Text, Text, Text) go (HasCallStack => Text -> Text -> [(Text, Text)] Text -> Text -> [(Text, Text)] Text.breakOnAll (Int -> Text -> Text Text.take Int 1 Text b) Text a) where go :: [(Text, Text)] -> (Text, Text, Text) go [] = (Text a, Text forall a. Monoid a => a mempty, Text b) go ((Text ap, Text as):[(Text, Text)] breaks) | Just Text bs <- Text -> Text -> Maybe Text Text.stripPrefix Text as Text b = (Text ap, Text as, Text bs) | Bool otherwise = [(Text, Text)] -> (Text, Text, Text) go [(Text, Text)] breaks -- Lazy Text instances -- | /O(m*n)/ instance OverlappingGCDMonoid LazyText.Text where stripOverlap :: Text -> Text -> (Text, Text, Text) stripOverlap Text a Text b | Text -> Bool LazyText.null Text b = (Text a, Text b, Text b) | Bool otherwise = [(Text, Text)] -> (Text, Text, Text) go (HasCallStack => Text -> Text -> [(Text, Text)] Text -> Text -> [(Text, Text)] LazyText.breakOnAll (Int64 -> Text -> Text LazyText.take Int64 1 Text b) Text a) where go :: [(Text, Text)] -> (Text, Text, Text) go [] = (Text a, Text forall a. Monoid a => a mempty, Text b) go ((Text ap, Text as):[(Text, Text)] breaks) | Just Text bs <- Text -> Text -> Maybe Text LazyText.stripPrefix Text as Text b = (Text ap, Text as, Text bs) | Bool otherwise = [(Text, Text)] -> (Text, Text, Text) go [(Text, Text)] breaks