{- 
    Copyright 2013-2017 Mario Blazevic

    License: BSD3 (see BSD3-LICENSE.txt file)
-}

-- | This module defines the 'Monoid' => 'ReductiveMonoid' => ('CancellativeMonoid', 'GCDMonoid') class hierarchy. 
--
-- The 'ReductiveMonoid' class introduces operation '</>' which is the inverse of '<>'. For the 'Sum' monoid, this
-- operation is subtraction; for 'Product' it is division and for 'Set' it's the set difference. A 'ReductiveMonoid' is
-- not a full group because '</>' may return 'Nothing'.
--
-- The 'CancellativeMonoid' subclass does not add any operation but it provides the additional guarantee that '<>' can
-- always be undone with '</>'. Thus 'Sum' is a 'CancellativeMonoid' but 'Product' is not because @(0*n)/0@ is not
-- defined.
--
-- The 'GCDMonoid' subclass adds the 'gcd' operation which takes two monoidal arguments and finds their greatest common
-- divisor, or (more generally) the greatest monoid that can be extracted with the '</>' operation from both.
--
-- All monoid subclasses listed above are for Abelian, /i.e./, commutative or symmetric monoids. Since most practical
-- monoids in Haskell are not Abelian, each of the these classes has two symmetric superclasses:
-- 
-- * 'LeftReductiveMonoid'
-- 
-- * 'LeftCancellativeMonoid'
-- 
-- * 'LeftGCDMonoid'
-- 
-- * 'RightReductiveMonoid'
-- 
-- * 'RightCancellativeMonoid'
-- 
-- * 'RightGCDMonoid'

{-# LANGUAGE Haskell2010, Trustworthy #-}

module Data.Monoid.Cancellative (
   -- * Symmetric, commutative monoid classes
   CommutativeMonoid, ReductiveMonoid(..), CancellativeMonoid, GCDMonoid(..),
   -- * Asymmetric monoid classes
   LeftReductiveMonoid(..), RightReductiveMonoid(..),
   LeftCancellativeMonoid, RightCancellativeMonoid,
   LeftGCDMonoid(..), RightGCDMonoid(..)
   )
where

import qualified Prelude

import Control.Applicative ((<$>), (<*>))
import Data.Monoid -- (Monoid, Dual(..), Sum(..), Product(..))
import qualified Data.List as List
import Data.Maybe (isJust)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Unsafe 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((:<)), ViewR((:>)), (<|), (|>))
import qualified Data.Vector as Vector

import Prelude hiding (gcd)

-- | Class of all Abelian ({i.e.}, commutative) monoids that satisfy the commutativity property:
-- 
-- > a <> b == b <> a
class Monoid m => CommutativeMonoid m

-- | Class of Abelian monoids with a partial inverse for the Monoid '<>' operation. The inverse operation '</>' must
-- satisfy the following laws:
-- 
-- > maybe a (b <>) (a </> b) == a
-- > maybe a (<> b) (a </> b) == a
class (CommutativeMonoid m, LeftReductiveMonoid m, RightReductiveMonoid m) => ReductiveMonoid m where
   (</>) :: m -> m -> Maybe m

infix 5 </>

-- | Subclass of 'ReductiveMonoid' where '</>' is a complete inverse of the Monoid '<>' operation. The class instances
-- must satisfy the following additional laws:
--
-- > (a <> b) </> a == Just b
-- > (a <> b) </> b == Just a
class (LeftCancellativeMonoid m, RightCancellativeMonoid m, ReductiveMonoid m) => CancellativeMonoid m

-- | Class of Abelian monoids that allow the greatest common denominator to be found for any two given values. The
-- operations must satisfy the following laws:
--
-- > gcd a b == commonPrefix a b == commonSuffix a b
-- > Just a' = a </> p && Just b' = b </> p
-- >    where p = gcd a b
-- 
-- If a 'GCDMonoid' happens to also be a 'CancellativeMonoid', it should additionally satisfy the following laws:
-- 
-- > gcd (a <> b) (a <> c) == a <> gcd b c
-- > gcd (a <> c) (b <> c) == gcd a b <> c
class (ReductiveMonoid m, LeftGCDMonoid m, RightGCDMonoid m) => GCDMonoid m where
   gcd :: m -> m -> m

-- | Class of monoids with a left inverse of 'Data.Monoid.mappend', satisfying the following law:
-- 
-- > isPrefixOf a b == isJust (stripPrefix a b)
-- > maybe b (a <>) (stripPrefix a b) == b
-- > a `isPrefixOf` (a <> b)
-- 
-- | Every instance definition has to implement at least the 'stripPrefix' method. Its complexity should be no worse
-- than linear in the length of the prefix argument.
class Monoid m => LeftReductiveMonoid m where
   isPrefixOf :: m -> m -> Bool
   stripPrefix :: m -> m -> Maybe m

   isPrefixOf m
a m
b = Maybe m -> Bool
forall a. Maybe a -> Bool
isJust (m -> m -> Maybe m
forall m. LeftReductiveMonoid m => m -> m -> Maybe m
stripPrefix m
a m
b)
   {-# MINIMAL stripPrefix #-}

-- | Class of monoids with a right inverse of 'Data.Monoid.mappend', satisfying the following law:
-- 
-- > isSuffixOf a b == isJust (stripSuffix a b)
-- > maybe b (<> a) (stripSuffix a b) == b
-- > b `isSuffixOf` (a <> b)
-- 
-- | Every instance definition has to implement at least the 'stripSuffix' method. Its complexity should be no worse
-- than linear in the length of the suffix argument.
class Monoid m => RightReductiveMonoid m where
   isSuffixOf :: m -> m -> Bool
   stripSuffix :: m -> m -> Maybe m

   isSuffixOf m
a m
b = Maybe m -> Bool
forall a. Maybe a -> Bool
isJust (m -> m -> Maybe m
forall m. RightReductiveMonoid m => m -> m -> Maybe m
stripSuffix m
a m
b)
   {-# MINIMAL stripSuffix #-}

-- | Subclass of 'LeftReductiveMonoid' where 'stripPrefix' is a complete inverse of '<>', satisfying the following
-- additional law:
--
-- > stripPrefix a (a <> b) == Just b
class LeftReductiveMonoid m => LeftCancellativeMonoid m

-- | Subclass of 'LeftReductiveMonoid' where 'stripPrefix' is a complete inverse of '<>', satisfying the following
-- additional law:
--
-- > stripSuffix b (a <> b) == Just a
class RightReductiveMonoid m => RightCancellativeMonoid m

-- | Class of monoids capable of finding the equivalent of greatest common divisor on the left side of two monoidal
-- values. The methods' complexity should be no worse than linear in the length of the common prefix. The following laws
-- must be respected:
-- 
-- > stripCommonPrefix a b == (p, a', b')
-- >    where p = commonPrefix a b
-- >          Just a' = stripPrefix p a
-- >          Just b' = stripPrefix p b
-- > p == commonPrefix a b && p <> a' == a && p <> b' == b
-- >    where (p, a', b') = stripCommonPrefix a b
class LeftReductiveMonoid m => LeftGCDMonoid m where
   commonPrefix :: m -> m -> m
   stripCommonPrefix :: m -> m -> (m, m, m)

   commonPrefix m
x m
y = m
p
      where (m
p, m
_, m
_) = m -> m -> (m, m, m)
forall m. LeftGCDMonoid m => m -> m -> (m, m, m)
stripCommonPrefix m
x m
y
   stripCommonPrefix m
x m
y = (m
p, m
x', m
y')
      where p :: m
p = m -> m -> m
forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix m
x m
y
            Just m
x' = m -> m -> Maybe m
forall m. LeftReductiveMonoid m => m -> m -> Maybe m
stripPrefix m
p m
x
            Just m
y' = m -> m -> Maybe m
forall m. LeftReductiveMonoid m => m -> m -> Maybe m
stripPrefix m
p m
y
   {-# MINIMAL commonPrefix | stripCommonPrefix #-}

-- | Class of monoids capable of finding the equivalent of greatest common divisor on the right side of two monoidal
-- values. The methods' complexity must be no worse than linear in the length of the common suffix. The following laws
-- must be respected:
-- 
-- > stripCommonSuffix a b == (a', b', s)
-- >    where s = commonSuffix a b
-- >          Just a' = stripSuffix p a
-- >          Just b' = stripSuffix p b
-- > s == commonSuffix a b && a' <> s == a && b' <> s == b
-- >    where (a', b', s) = stripCommonSuffix a b
class RightReductiveMonoid m => RightGCDMonoid m where
   commonSuffix :: m -> m -> m
   stripCommonSuffix :: m -> m -> (m, m, m)

   commonSuffix m
x m
y = m
s
      where (m
_, m
_, m
s) = m -> m -> (m, m, m)
forall m. RightGCDMonoid m => m -> m -> (m, m, m)
stripCommonSuffix m
x m
y
   stripCommonSuffix m
x m
y = (m
x', m
y', m
s)
      where s :: m
s = m -> m -> m
forall m. RightGCDMonoid m => m -> m -> m
commonSuffix m
x m
y
            Just m
x' = m -> m -> Maybe m
forall m. RightReductiveMonoid m => m -> m -> Maybe m
stripSuffix m
s m
x
            Just m
y' = m -> m -> Maybe m
forall m. RightReductiveMonoid m => m -> m -> Maybe m
stripSuffix m
s m
y
   {-# MINIMAL commonSuffix | stripCommonSuffix #-}

-- Unit instances

instance CommutativeMonoid ()

instance ReductiveMonoid () where
   () </> :: () -> () -> Maybe ()
</> () = () -> Maybe ()
forall a. a -> Maybe a
Just ()

instance CancellativeMonoid ()

instance GCDMonoid () where
   gcd :: () -> () -> ()
gcd () () = ()

instance LeftReductiveMonoid () where
   stripPrefix :: () -> () -> Maybe ()
stripPrefix () () = () -> Maybe ()
forall a. a -> Maybe a
Just ()

instance RightReductiveMonoid () where
   stripSuffix :: () -> () -> Maybe ()
stripSuffix () () = () -> Maybe ()
forall a. a -> Maybe a
Just ()

instance LeftCancellativeMonoid ()

instance RightCancellativeMonoid ()

instance LeftGCDMonoid () where
   commonPrefix :: () -> () -> ()
commonPrefix () () = ()

instance RightGCDMonoid () where
   commonSuffix :: () -> () -> ()
commonSuffix () () = ()

-- Dual instances

instance CommutativeMonoid a => CommutativeMonoid (Dual a)

instance ReductiveMonoid a => ReductiveMonoid (Dual a) where
   Dual a
a </> :: Dual a -> Dual a -> Maybe (Dual a)
</> Dual a
b = (a -> Dual a) -> Maybe a -> Maybe (Dual a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Dual a
forall a. a -> Dual a
Dual (a
a a -> a -> Maybe a
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> a
b)

instance CancellativeMonoid a => CancellativeMonoid (Dual a)

instance GCDMonoid a => GCDMonoid (Dual a) where
   gcd :: Dual a -> Dual a -> Dual a
gcd (Dual a
a) (Dual a
b) = a -> Dual a
forall a. a -> Dual a
Dual (a -> a -> a
forall m. GCDMonoid m => m -> m -> m
gcd a
a a
b)

instance LeftReductiveMonoid a => RightReductiveMonoid (Dual a) where
   stripSuffix :: Dual a -> Dual a -> Maybe (Dual a)
stripSuffix (Dual a
a) (Dual a
b) = (a -> Dual a) -> Maybe a -> Maybe (Dual a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Dual a
forall a. a -> Dual a
Dual (a -> a -> Maybe a
forall m. LeftReductiveMonoid m => m -> m -> Maybe m
stripPrefix a
a a
b)
   Dual a
a isSuffixOf :: Dual a -> Dual a -> Bool
`isSuffixOf` Dual a
b = a
a a -> a -> Bool
forall m. LeftReductiveMonoid m => m -> m -> Bool
`isPrefixOf` a
b

instance RightReductiveMonoid a => LeftReductiveMonoid (Dual a) where
   stripPrefix :: Dual a -> Dual a -> Maybe (Dual a)
stripPrefix (Dual a
a) (Dual a
b) = (a -> Dual a) -> Maybe a -> Maybe (Dual a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Dual a
forall a. a -> Dual a
Dual (a -> a -> Maybe a
forall m. RightReductiveMonoid m => m -> m -> Maybe m
stripSuffix a
a a
b)
   Dual a
a isPrefixOf :: Dual a -> Dual a -> Bool
`isPrefixOf` Dual a
b = a
a a -> a -> Bool
forall m. RightReductiveMonoid m => m -> m -> Bool
`isSuffixOf` a
b

instance LeftCancellativeMonoid a => RightCancellativeMonoid (Dual a)

instance RightCancellativeMonoid a => LeftCancellativeMonoid (Dual a)

instance LeftGCDMonoid a => RightGCDMonoid (Dual a) where
   commonSuffix :: Dual a -> Dual a -> Dual a
commonSuffix (Dual a
a) (Dual a
b) = a -> Dual a
forall a. a -> Dual a
Dual (a -> a -> a
forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix a
a a
b)

instance RightGCDMonoid a => LeftGCDMonoid (Dual a) where
   commonPrefix :: Dual a -> Dual a -> Dual a
commonPrefix (Dual a
a) (Dual a
b) = a -> Dual a
forall a. a -> Dual a
Dual (a -> a -> a
forall m. RightGCDMonoid m => m -> m -> m
commonSuffix a
a a
b)

-- Sum instances

instance Num a => CommutativeMonoid (Sum a)

instance Integral a => ReductiveMonoid (Sum a) where
   Sum a
a </> :: Sum a -> Sum a -> Maybe (Sum a)
</> Sum a
b = Sum a -> Maybe (Sum a)
forall a. a -> Maybe a
Just (Sum a -> Maybe (Sum a)) -> Sum a -> Maybe (Sum a)
forall a b. (a -> b) -> a -> b
$ a -> Sum a
forall a. a -> Sum a
Sum (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
b)

instance Integral a => CancellativeMonoid (Sum a)

instance (Integral a, Ord a) => GCDMonoid (Sum a) where
   gcd :: Sum a -> Sum a -> Sum a
gcd (Sum a
a) (Sum a
b) = a -> Sum a
forall a. a -> Sum a
Sum (a -> a -> a
forall a. Ord a => a -> a -> a
min a
a a
b)

instance Integral a => LeftReductiveMonoid (Sum a) where
   stripPrefix :: Sum a -> Sum a -> Maybe (Sum a)
stripPrefix Sum a
a Sum a
b = Sum a
b Sum a -> Sum a -> Maybe (Sum a)
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> Sum a
a

instance Integral a => RightReductiveMonoid (Sum a) where
   stripSuffix :: Sum a -> Sum a -> Maybe (Sum a)
stripSuffix Sum a
a Sum a
b = Sum a
b Sum a -> Sum a -> Maybe (Sum a)
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> Sum a
a

instance Integral a => LeftCancellativeMonoid (Sum a)

instance Integral a => RightCancellativeMonoid (Sum a)

instance (Integral a, Ord a) => LeftGCDMonoid (Sum a) where
   commonPrefix :: Sum a -> Sum a -> Sum a
commonPrefix Sum a
a Sum a
b = Sum a -> Sum a -> Sum a
forall m. GCDMonoid m => m -> m -> m
gcd Sum a
a Sum a
b

instance (Integral a, Ord a) => RightGCDMonoid (Sum a) where
   commonSuffix :: Sum a -> Sum a -> Sum a
commonSuffix Sum a
a Sum a
b = Sum a -> Sum a -> Sum a
forall m. GCDMonoid m => m -> m -> m
gcd Sum a
a Sum a
b

-- Product instances

instance Num a => CommutativeMonoid (Product a)

instance Integral a => ReductiveMonoid (Product a) where
   Product a
0 </> :: Product a -> Product a -> Maybe (Product a)
</> Product a
0 = Product a -> Maybe (Product a)
forall a. a -> Maybe a
Just (a -> Product a
forall a. a -> Product a
Product a
0)
   Product a
_ </> Product a
0 = Maybe (Product a)
forall a. Maybe a
Nothing
   Product a
a </> Product a
b = if a
remainder a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then Product a -> Maybe (Product a)
forall a. a -> Maybe a
Just (a -> Product a
forall a. a -> Product a
Product a
quotient) else Maybe (Product a)
forall a. Maybe a
Nothing
      where (a
quotient, a
remainder) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
a a
b

instance Integral a => GCDMonoid (Product a) where
   gcd :: Product a -> Product a -> Product a
gcd (Product a
a) (Product a
b) = a -> Product a
forall a. a -> Product a
Product (a -> a -> a
forall a. Integral a => a -> a -> a
Prelude.gcd a
a a
b)

instance Integral a => LeftReductiveMonoid (Product a) where
   stripPrefix :: Product a -> Product a -> Maybe (Product a)
stripPrefix Product a
a Product a
b = Product a
b Product a -> Product a -> Maybe (Product a)
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> Product a
a

instance Integral a => RightReductiveMonoid (Product a) where
   stripSuffix :: Product a -> Product a -> Maybe (Product a)
stripSuffix Product a
a Product a
b = Product a
b Product a -> Product a -> Maybe (Product a)
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> Product a
a

instance Integral a => LeftGCDMonoid (Product a) where
   commonPrefix :: Product a -> Product a -> Product a
commonPrefix Product a
a Product a
b = Product a -> Product a -> Product a
forall m. GCDMonoid m => m -> m -> m
gcd Product a
a Product a
b

instance Integral a => RightGCDMonoid (Product a) where
   commonSuffix :: Product a -> Product a -> Product a
commonSuffix Product a
a Product a
b = Product a -> Product a -> Product a
forall m. GCDMonoid m => m -> m -> m
gcd Product a
a Product a
b

-- Pair instances

instance (CommutativeMonoid a, CommutativeMonoid b) => CommutativeMonoid (a, b)

instance (ReductiveMonoid a, ReductiveMonoid b) => ReductiveMonoid (a, b) where
   (a
a, b
b) </> :: (a, b) -> (a, b) -> Maybe (a, b)
</> (a
c, b
d) = case (a
a a -> a -> Maybe a
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> a
c, b
b b -> b -> Maybe b
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> b
d)
                       of (Just a
a', Just b
b') -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a', b
b')
                          (Maybe a, Maybe b)
_ -> Maybe (a, b)
forall a. Maybe a
Nothing

instance (CancellativeMonoid a, CancellativeMonoid b) => CancellativeMonoid (a, b)

instance (GCDMonoid a, GCDMonoid b) => GCDMonoid (a, b) where
   gcd :: (a, b) -> (a, b) -> (a, b)
gcd (a
a, b
b) (a
c, b
d) = (a -> a -> a
forall m. GCDMonoid m => m -> m -> m
gcd a
a a
c, b -> b -> b
forall m. GCDMonoid m => m -> m -> m
gcd b
b b
d)

instance (LeftReductiveMonoid a, LeftReductiveMonoid b) => LeftReductiveMonoid (a, b) where
   stripPrefix :: (a, b) -> (a, b) -> Maybe (a, b)
stripPrefix (a
a, b
b) (a
c, b
d) = case (a -> a -> Maybe a
forall m. LeftReductiveMonoid m => m -> m -> Maybe m
stripPrefix a
a a
c, b -> b -> Maybe b
forall m. LeftReductiveMonoid m => m -> m -> Maybe m
stripPrefix b
b b
d)
                               of (Just a
a', Just b
b') -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a', b
b')
                                  (Maybe a, Maybe b)
_ -> Maybe (a, b)
forall a. Maybe a
Nothing
   isPrefixOf :: (a, b) -> (a, b) -> Bool
isPrefixOf (a
a, b
b) (a
c, b
d) = a -> a -> Bool
forall m. LeftReductiveMonoid m => m -> m -> Bool
isPrefixOf a
a a
c Bool -> Bool -> Bool
&& b -> b -> Bool
forall m. LeftReductiveMonoid m => m -> m -> Bool
isPrefixOf b
b b
d

instance (RightReductiveMonoid a, RightReductiveMonoid b) => RightReductiveMonoid (a, b) where
   stripSuffix :: (a, b) -> (a, b) -> Maybe (a, b)
stripSuffix (a
a, b
b) (a
c, b
d) = case (a -> a -> Maybe a
forall m. RightReductiveMonoid m => m -> m -> Maybe m
stripSuffix a
a a
c, b -> b -> Maybe b
forall m. RightReductiveMonoid m => m -> m -> Maybe m
stripSuffix b
b b
d)
                               of (Just a
a', Just b
b') -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a', b
b')
                                  (Maybe a, Maybe b)
_ -> Maybe (a, b)
forall a. Maybe a
Nothing
   isSuffixOf :: (a, b) -> (a, b) -> Bool
isSuffixOf (a
a, b
b) (a
c, b
d) = a -> a -> Bool
forall m. RightReductiveMonoid m => m -> m -> Bool
isSuffixOf a
a a
c Bool -> Bool -> Bool
&& b -> b -> Bool
forall m. RightReductiveMonoid m => m -> m -> Bool
isSuffixOf b
b b
d

instance (LeftCancellativeMonoid a, LeftCancellativeMonoid b) => LeftCancellativeMonoid (a, b)

instance (RightCancellativeMonoid a, RightCancellativeMonoid b) => RightCancellativeMonoid (a, b)

instance (LeftGCDMonoid a, LeftGCDMonoid b) => LeftGCDMonoid (a, b) where
   commonPrefix :: (a, b) -> (a, b) -> (a, b)
commonPrefix (a
a, b
b) (a
c, b
d) = (a -> a -> a
forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix a
a a
c, b -> b -> b
forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix b
b b
d)

instance (RightGCDMonoid a, RightGCDMonoid b) => RightGCDMonoid (a, b) where
   commonSuffix :: (a, b) -> (a, b) -> (a, b)
commonSuffix (a
a, b
b) (a
c, b
d) = (a -> a -> a
forall m. RightGCDMonoid m => m -> m -> m
commonSuffix a
a a
c, b -> b -> b
forall m. RightGCDMonoid m => m -> m -> m
commonSuffix b
b b
d)

-- Triple instances

instance (CommutativeMonoid a, CommutativeMonoid b, CommutativeMonoid c) => CommutativeMonoid (a, b, c)

instance (ReductiveMonoid a, ReductiveMonoid b, ReductiveMonoid c) => ReductiveMonoid (a, b, c) where
   (a
a1, b
b1, c
c1) </> :: (a, b, c) -> (a, b, c) -> Maybe (a, b, c)
</> (a
a2, b
b2, c
c2) = (,,) (a -> b -> c -> (a, b, c))
-> Maybe a -> Maybe (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a
a1 a -> a -> Maybe a
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> a
a2) Maybe (b -> c -> (a, b, c)) -> Maybe b -> Maybe (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (b
b1 b -> b -> Maybe b
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> b
b2) Maybe (c -> (a, b, c)) -> Maybe c -> Maybe (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (c
c1 c -> c -> Maybe c
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> c
c2)

instance (CancellativeMonoid a, CancellativeMonoid b, CancellativeMonoid c) => CancellativeMonoid (a, b, c)

instance (GCDMonoid a, GCDMonoid b, GCDMonoid c) => GCDMonoid (a, b, c) where
   gcd :: (a, b, c) -> (a, b, c) -> (a, b, c)
gcd (a
a1, b
b1, c
c1) (a
a2, b
b2, c
c2) = (a -> a -> a
forall m. GCDMonoid m => m -> m -> m
gcd a
a1 a
a2, b -> b -> b
forall m. GCDMonoid m => m -> m -> m
gcd b
b1 b
b2, c -> c -> c
forall m. GCDMonoid m => m -> m -> m
gcd c
c1 c
c2)

instance (LeftReductiveMonoid a, LeftReductiveMonoid b, LeftReductiveMonoid c) => LeftReductiveMonoid (a, b, c) where
   stripPrefix :: (a, b, c) -> (a, b, c) -> Maybe (a, b, c)
stripPrefix (a
a1, b
b1, c
c1) (a
a2, b
b2, c
c2) = (,,) (a -> b -> c -> (a, b, c))
-> Maybe a -> Maybe (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> Maybe a
forall m. LeftReductiveMonoid m => m -> m -> Maybe m
stripPrefix a
a1 a
a2 Maybe (b -> c -> (a, b, c)) -> Maybe b -> Maybe (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> b -> Maybe b
forall m. LeftReductiveMonoid m => m -> m -> Maybe m
stripPrefix b
b1 b
b2 Maybe (c -> (a, b, c)) -> Maybe c -> Maybe (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> c -> Maybe c
forall m. LeftReductiveMonoid m => m -> m -> Maybe m
stripPrefix c
c1 c
c2
   isPrefixOf :: (a, b, c) -> (a, b, c) -> Bool
isPrefixOf (a
a1, b
b1, c
c1) (a
a2, b
b2, c
c2) = a -> a -> Bool
forall m. LeftReductiveMonoid m => m -> m -> Bool
isPrefixOf a
a1 a
a2 Bool -> Bool -> Bool
&& b -> b -> Bool
forall m. LeftReductiveMonoid m => m -> m -> Bool
isPrefixOf b
b1 b
b2 Bool -> Bool -> Bool
&& c -> c -> Bool
forall m. LeftReductiveMonoid m => m -> m -> Bool
isPrefixOf c
c1 c
c2

instance (RightReductiveMonoid a, RightReductiveMonoid b, RightReductiveMonoid c) =>
         RightReductiveMonoid (a, b, c) where
   stripSuffix :: (a, b, c) -> (a, b, c) -> Maybe (a, b, c)
stripSuffix (a
a1, b
b1, c
c1) (a
a2, b
b2, c
c2) = (,,) (a -> b -> c -> (a, b, c))
-> Maybe a -> Maybe (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> Maybe a
forall m. RightReductiveMonoid m => m -> m -> Maybe m
stripSuffix a
a1 a
a2 Maybe (b -> c -> (a, b, c)) -> Maybe b -> Maybe (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> b -> Maybe b
forall m. RightReductiveMonoid m => m -> m -> Maybe m
stripSuffix b
b1 b
b2 Maybe (c -> (a, b, c)) -> Maybe c -> Maybe (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> c -> Maybe c
forall m. RightReductiveMonoid m => m -> m -> Maybe m
stripSuffix c
c1 c
c2
   isSuffixOf :: (a, b, c) -> (a, b, c) -> Bool
isSuffixOf (a
a1, b
b1, c
c1) (a
a2, b
b2, c
c2) = a -> a -> Bool
forall m. RightReductiveMonoid m => m -> m -> Bool
isSuffixOf a
a1 a
a2 Bool -> Bool -> Bool
&& b -> b -> Bool
forall m. RightReductiveMonoid m => m -> m -> Bool
isSuffixOf b
b1 b
b2 Bool -> Bool -> Bool
&& c -> c -> Bool
forall m. RightReductiveMonoid m => m -> m -> Bool
isSuffixOf c
c1 c
c2

instance (LeftCancellativeMonoid a, LeftCancellativeMonoid b, LeftCancellativeMonoid c) =>
         LeftCancellativeMonoid (a, b, c)

instance (RightCancellativeMonoid a, RightCancellativeMonoid b, RightCancellativeMonoid c) =>
         RightCancellativeMonoid (a, b, c)

instance (LeftGCDMonoid a, LeftGCDMonoid b, LeftGCDMonoid c) => LeftGCDMonoid (a, b, c) where
   commonPrefix :: (a, b, c) -> (a, b, c) -> (a, b, c)
commonPrefix (a
a1, b
b1, c
c1) (a
a2, b
b2, c
c2) = (a -> a -> a
forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix a
a1 a
a2, b -> b -> b
forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix b
b1 b
b2, c -> c -> c
forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix c
c1 c
c2)

instance (RightGCDMonoid a, RightGCDMonoid b, RightGCDMonoid c) => RightGCDMonoid (a, b, c) where
   commonSuffix :: (a, b, c) -> (a, b, c) -> (a, b, c)
commonSuffix (a
a1, b
b1, c
c1) (a
a2, b
b2, c
c2) = (a -> a -> a
forall m. RightGCDMonoid m => m -> m -> m
commonSuffix a
a1 a
a2, b -> b -> b
forall m. RightGCDMonoid m => m -> m -> m
commonSuffix b
b1 b
b2, c -> c -> c
forall m. RightGCDMonoid m => m -> m -> m
commonSuffix c
c1 c
c2)

-- Quadruple instances

instance (CommutativeMonoid a, CommutativeMonoid b, CommutativeMonoid c, CommutativeMonoid d) =>
         CommutativeMonoid (a, b, c, d)

instance (ReductiveMonoid a, ReductiveMonoid b, ReductiveMonoid c, ReductiveMonoid d) =>
         ReductiveMonoid (a, b, c, d) where
   (a
a1, b
b1, c
c1, d
d1) </> :: (a, b, c, d) -> (a, b, c, d) -> Maybe (a, b, c, d)
</> (a
a2, b
b2, c
c2, d
d2) = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> Maybe a -> Maybe (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a
a1 a -> a -> Maybe a
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> a
a2) Maybe (b -> c -> d -> (a, b, c, d))
-> Maybe b -> Maybe (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (b
b1 b -> b -> Maybe b
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> b
b2) Maybe (c -> d -> (a, b, c, d))
-> Maybe c -> Maybe (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (c
c1 c -> c -> Maybe c
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> c
c2) Maybe (d -> (a, b, c, d)) -> Maybe d -> Maybe (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (d
d1 d -> d -> Maybe d
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> d
d2)

instance (CancellativeMonoid a, CancellativeMonoid b, CancellativeMonoid c, CancellativeMonoid d) =>
         CancellativeMonoid (a, b, c, d)

instance (GCDMonoid a, GCDMonoid b, GCDMonoid c, GCDMonoid d) => GCDMonoid (a, b, c, d) where
   gcd :: (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
gcd (a
a1, b
b1, c
c1, d
d1) (a
a2, b
b2, c
c2, d
d2) = (a -> a -> a
forall m. GCDMonoid m => m -> m -> m
gcd a
a1 a
a2, b -> b -> b
forall m. GCDMonoid m => m -> m -> m
gcd b
b1 b
b2, c -> c -> c
forall m. GCDMonoid m => m -> m -> m
gcd c
c1 c
c2, d -> d -> d
forall m. GCDMonoid m => m -> m -> m
gcd d
d1 d
d2)

instance (LeftReductiveMonoid a, LeftReductiveMonoid b, LeftReductiveMonoid c, LeftReductiveMonoid d) =>
         LeftReductiveMonoid (a, b, c, d) where
   stripPrefix :: (a, b, c, d) -> (a, b, c, d) -> Maybe (a, b, c, d)
stripPrefix (a
a1, b
b1, c
c1, d
d1) (a
a2, b
b2, c
c2, d
d2) =
      (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> Maybe a -> Maybe (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> Maybe a
forall m. LeftReductiveMonoid m => m -> m -> Maybe m
stripPrefix a
a1 a
a2 Maybe (b -> c -> d -> (a, b, c, d))
-> Maybe b -> Maybe (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> b -> Maybe b
forall m. LeftReductiveMonoid m => m -> m -> Maybe m
stripPrefix b
b1 b
b2 Maybe (c -> d -> (a, b, c, d))
-> Maybe c -> Maybe (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> c -> Maybe c
forall m. LeftReductiveMonoid m => m -> m -> Maybe m
stripPrefix c
c1 c
c2 Maybe (d -> (a, b, c, d)) -> Maybe d -> Maybe (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> d -> d -> Maybe d
forall m. LeftReductiveMonoid m => m -> m -> Maybe m
stripPrefix d
d1 d
d2
   isPrefixOf :: (a, b, c, d) -> (a, b, c, d) -> Bool
isPrefixOf (a
a1, b
b1, c
c1, d
d1) (a
a2, b
b2, c
c2, d
d2) =
      a -> a -> Bool
forall m. LeftReductiveMonoid m => m -> m -> Bool
isPrefixOf a
a1 a
a2 Bool -> Bool -> Bool
&& b -> b -> Bool
forall m. LeftReductiveMonoid m => m -> m -> Bool
isPrefixOf b
b1 b
b2 Bool -> Bool -> Bool
&& c -> c -> Bool
forall m. LeftReductiveMonoid m => m -> m -> Bool
isPrefixOf c
c1 c
c2 Bool -> Bool -> Bool
&& d -> d -> Bool
forall m. LeftReductiveMonoid m => m -> m -> Bool
isPrefixOf d
d1 d
d2

instance (RightReductiveMonoid a, RightReductiveMonoid b, RightReductiveMonoid c, RightReductiveMonoid d) =>
         RightReductiveMonoid (a, b, c, d) where
   stripSuffix :: (a, b, c, d) -> (a, b, c, d) -> Maybe (a, b, c, d)
stripSuffix (a
a1, b
b1, c
c1, d
d1) (a
a2, b
b2, c
c2, d
d2) =
      (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> Maybe a -> Maybe (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> Maybe a
forall m. RightReductiveMonoid m => m -> m -> Maybe m
stripSuffix a
a1 a
a2 Maybe (b -> c -> d -> (a, b, c, d))
-> Maybe b -> Maybe (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> b -> Maybe b
forall m. RightReductiveMonoid m => m -> m -> Maybe m
stripSuffix b
b1 b
b2 Maybe (c -> d -> (a, b, c, d))
-> Maybe c -> Maybe (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> c -> Maybe c
forall m. RightReductiveMonoid m => m -> m -> Maybe m
stripSuffix c
c1 c
c2 Maybe (d -> (a, b, c, d)) -> Maybe d -> Maybe (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> d -> d -> Maybe d
forall m. RightReductiveMonoid m => m -> m -> Maybe m
stripSuffix d
d1 d
d2
   isSuffixOf :: (a, b, c, d) -> (a, b, c, d) -> Bool
isSuffixOf (a
a1, b
b1, c
c1, d
d1) (a
a2, b
b2, c
c2, d
d2) =
      a -> a -> Bool
forall m. RightReductiveMonoid m => m -> m -> Bool
isSuffixOf a
a1 a
a2 Bool -> Bool -> Bool
&& b -> b -> Bool
forall m. RightReductiveMonoid m => m -> m -> Bool
isSuffixOf b
b1 b
b2 Bool -> Bool -> Bool
&& c -> c -> Bool
forall m. RightReductiveMonoid m => m -> m -> Bool
isSuffixOf c
c1 c
c2 Bool -> Bool -> Bool
&& d -> d -> Bool
forall m. RightReductiveMonoid m => m -> m -> Bool
isSuffixOf d
d1 d
d2

instance (LeftCancellativeMonoid a, LeftCancellativeMonoid b, LeftCancellativeMonoid c, LeftCancellativeMonoid d) =>
         LeftCancellativeMonoid (a, b, c, d)

instance (RightCancellativeMonoid a, RightCancellativeMonoid b, RightCancellativeMonoid c, RightCancellativeMonoid d) =>
         RightCancellativeMonoid (a, b, c, d)

instance (LeftGCDMonoid a, LeftGCDMonoid b, LeftGCDMonoid c, LeftGCDMonoid d) => LeftGCDMonoid (a, b, c, d) where
   commonPrefix :: (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
commonPrefix (a
a1, b
b1, c
c1, d
d1) (a
a2, b
b2, c
c2, d
d2) =
      (a -> a -> a
forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix a
a1 a
a2, b -> b -> b
forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix b
b1 b
b2, c -> c -> c
forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix c
c1 c
c2, d -> d -> d
forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix d
d1 d
d2)

instance (RightGCDMonoid a, RightGCDMonoid b, RightGCDMonoid c, RightGCDMonoid d) => RightGCDMonoid (a, b, c, d) where
   commonSuffix :: (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
commonSuffix (a
a1, b
b1, c
c1, d
d1) (a
a2, b
b2, c
c2, d
d2) =
      (a -> a -> a
forall m. RightGCDMonoid m => m -> m -> m
commonSuffix a
a1 a
a2, b -> b -> b
forall m. RightGCDMonoid m => m -> m -> m
commonSuffix b
b1 b
b2, c -> c -> c
forall m. RightGCDMonoid m => m -> m -> m
commonSuffix c
c1 c
c2, d -> d -> d
forall m. RightGCDMonoid m => m -> m -> m
commonSuffix d
d1 d
d2)

-- Maybe instances

instance LeftReductiveMonoid x => LeftReductiveMonoid (Maybe x) where
   stripPrefix :: Maybe x -> Maybe x -> Maybe (Maybe x)
stripPrefix Maybe x
Nothing Maybe x
y = Maybe x -> Maybe (Maybe x)
forall a. a -> Maybe a
Just Maybe x
y
   stripPrefix Just{} Maybe x
Nothing = Maybe (Maybe x)
forall a. Maybe a
Nothing
   stripPrefix (Just x
x) (Just x
y) = (x -> Maybe x) -> Maybe x -> Maybe (Maybe x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> Maybe x
forall a. a -> Maybe a
Just (Maybe x -> Maybe (Maybe x)) -> Maybe x -> Maybe (Maybe x)
forall a b. (a -> b) -> a -> b
$ x -> x -> Maybe x
forall m. LeftReductiveMonoid m => m -> m -> Maybe m
stripPrefix x
x x
y

instance LeftGCDMonoid x => LeftGCDMonoid (Maybe x) where
   commonPrefix :: Maybe x -> Maybe x -> Maybe x
commonPrefix (Just x
x) (Just x
y) = x -> Maybe x
forall a. a -> Maybe a
Just (x -> x -> x
forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix x
x x
y)
   commonPrefix Maybe x
_ Maybe x
_ = Maybe x
forall a. Maybe a
Nothing

   stripCommonPrefix :: Maybe x -> Maybe x -> (Maybe x, Maybe x, Maybe x)
stripCommonPrefix (Just x
x) (Just x
y) = (x -> Maybe x
forall a. a -> Maybe a
Just x
p, x -> Maybe x
forall a. a -> Maybe a
Just x
x', x -> Maybe x
forall a. a -> Maybe a
Just x
y')
      where (x
p, x
x', x
y') = x -> x -> (x, x, x)
forall m. LeftGCDMonoid m => m -> m -> (m, m, m)
stripCommonPrefix x
x x
y
   stripCommonPrefix Maybe x
x Maybe x
y = (Maybe x
forall a. Maybe a
Nothing, Maybe x
x, Maybe x
y)

instance RightReductiveMonoid x => RightReductiveMonoid (Maybe x) where
   stripSuffix :: Maybe x -> Maybe x -> Maybe (Maybe x)
stripSuffix Maybe x
Nothing Maybe x
y = Maybe x -> Maybe (Maybe x)
forall a. a -> Maybe a
Just Maybe x
y
   stripSuffix Just{} Maybe x
Nothing = Maybe (Maybe x)
forall a. Maybe a
Nothing
   stripSuffix (Just x
x) (Just x
y) = (x -> Maybe x) -> Maybe x -> Maybe (Maybe x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> Maybe x
forall a. a -> Maybe a
Just (Maybe x -> Maybe (Maybe x)) -> Maybe x -> Maybe (Maybe x)
forall a b. (a -> b) -> a -> b
$ x -> x -> Maybe x
forall m. RightReductiveMonoid m => m -> m -> Maybe m
stripSuffix x
x x
y

instance RightGCDMonoid x => RightGCDMonoid (Maybe x) where
   commonSuffix :: Maybe x -> Maybe x -> Maybe x
commonSuffix (Just x
x) (Just x
y) = x -> Maybe x
forall a. a -> Maybe a
Just (x -> x -> x
forall m. RightGCDMonoid m => m -> m -> m
commonSuffix x
x x
y)
   commonSuffix Maybe x
_ Maybe x
_ = Maybe x
forall a. Maybe a
Nothing

   stripCommonSuffix :: Maybe x -> Maybe x -> (Maybe x, Maybe x, Maybe x)
stripCommonSuffix (Just x
x) (Just x
y) = (x -> Maybe x
forall a. a -> Maybe a
Just x
x', x -> Maybe x
forall a. a -> Maybe a
Just x
y', x -> Maybe x
forall a. a -> Maybe a
Just x
s)
      where (x
x', x
y', x
s) = x -> x -> (x, x, x)
forall m. RightGCDMonoid m => m -> m -> (m, m, m)
stripCommonSuffix x
x x
y
   stripCommonSuffix Maybe x
x Maybe x
y = (Maybe x
x, Maybe x
y, Maybe x
forall a. Maybe a
Nothing)

-- Set instances

instance Ord a => CommutativeMonoid (Set.Set a)

instance Ord a => LeftReductiveMonoid (Set.Set a) where
   isPrefixOf :: Set a -> Set a -> Bool
isPrefixOf = Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf
   stripPrefix :: Set a -> Set a -> Maybe (Set a)
stripPrefix Set a
a Set a
b = Set a
b Set a -> Set a -> Maybe (Set a)
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> Set a
a

instance Ord a => RightReductiveMonoid (Set.Set a) where
   isSuffixOf :: Set a -> Set a -> Bool
isSuffixOf = Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf
   stripSuffix :: Set a -> Set a -> Maybe (Set a)
stripSuffix Set a
a Set a
b = Set a
b Set a -> Set a -> Maybe (Set a)
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> Set a
a

instance Ord a => ReductiveMonoid (Set.Set a) where
   Set a
a </> :: Set a -> Set a -> Maybe (Set a)
</> Set a
b | Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set a
b Set a
a = Set a -> Maybe (Set a)
forall a. a -> Maybe a
Just (Set a
a Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
b)
           | Bool
otherwise = Maybe (Set a)
forall a. Maybe a
Nothing

instance Ord a => LeftGCDMonoid (Set.Set a) where
   commonPrefix :: Set a -> Set a -> Set a
commonPrefix = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection

instance Ord a => RightGCDMonoid (Set.Set a) where
   commonSuffix :: Set a -> Set a -> Set a
commonSuffix = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection

instance Ord a => GCDMonoid (Set.Set a) where
   gcd :: Set a -> Set a -> Set a
gcd = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection

-- IntSet instances

instance CommutativeMonoid IntSet.IntSet

instance LeftReductiveMonoid IntSet.IntSet where
   isPrefixOf :: IntSet -> IntSet -> Bool
isPrefixOf = IntSet -> IntSet -> Bool
IntSet.isSubsetOf
   stripPrefix :: IntSet -> IntSet -> Maybe IntSet
stripPrefix IntSet
a IntSet
b = IntSet
b IntSet -> IntSet -> Maybe IntSet
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> IntSet
a

instance RightReductiveMonoid IntSet.IntSet where
   isSuffixOf :: IntSet -> IntSet -> Bool
isSuffixOf = IntSet -> IntSet -> Bool
IntSet.isSubsetOf
   stripSuffix :: IntSet -> IntSet -> Maybe IntSet
stripSuffix IntSet
a IntSet
b = IntSet
b IntSet -> IntSet -> Maybe IntSet
forall m. ReductiveMonoid m => m -> m -> Maybe m
</> IntSet
a

instance ReductiveMonoid IntSet.IntSet where
   IntSet
a </> :: IntSet -> IntSet -> Maybe IntSet
</> IntSet
b | IntSet -> IntSet -> Bool
IntSet.isSubsetOf IntSet
b IntSet
a = IntSet -> Maybe IntSet
forall a. a -> Maybe a
Just (IntSet
a IntSet -> IntSet -> IntSet
IntSet.\\ IntSet
b)
           | Bool
otherwise = Maybe IntSet
forall a. Maybe a
Nothing

instance LeftGCDMonoid IntSet.IntSet where
   commonPrefix :: IntSet -> IntSet -> IntSet
commonPrefix = IntSet -> IntSet -> IntSet
IntSet.intersection

instance RightGCDMonoid IntSet.IntSet where
   commonSuffix :: IntSet -> IntSet -> IntSet
commonSuffix = IntSet -> IntSet -> IntSet
IntSet.intersection

instance GCDMonoid IntSet.IntSet where
   gcd :: IntSet -> IntSet -> IntSet
gcd = IntSet -> IntSet -> IntSet
IntSet.intersection

-- Map instances

instance Ord k => LeftReductiveMonoid (Map.Map k a) where
   isPrefixOf :: Map k a -> Map k a -> Bool
isPrefixOf = (a -> a -> Bool) -> Map k a -> Map k a -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
Map.isSubmapOfBy (\a
_ a
_-> Bool
True)
   stripPrefix :: Map k a -> Map k a -> Maybe (Map k a)
stripPrefix Map k a
a Map k a
b | (a -> a -> Bool) -> Map k a -> Map k a -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
Map.isSubmapOfBy (\a
_ a
_-> Bool
True) Map k a
a Map k a
b = Map k a -> Maybe (Map k a)
forall a. a -> Maybe a
Just (Map k a
b Map k a -> Map k a -> Map k a
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map k a
a)
                   | Bool
otherwise = Maybe (Map k a)
forall a. Maybe a
Nothing

instance (Ord k, Eq a) => LeftGCDMonoid (Map.Map k a) where
   commonPrefix :: Map k a -> Map k a -> Map k a
commonPrefix = (k -> a -> a -> Maybe a)
-> (Map k a -> Map k a)
-> (Map k a -> Map k a)
-> Map k a
-> Map k a
-> Map k a
forall k a b c.
Ord k =>
(k -> a -> b -> Maybe c)
-> (Map k a -> Map k c)
-> (Map k b -> Map k c)
-> Map k a
-> Map k b
-> Map k c
Map.mergeWithKey (\k
_ a
a a
b -> if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b then a -> Maybe a
forall a. a -> Maybe a
Just a
a else Maybe a
forall a. Maybe a
Nothing) (Map k a -> Map k a -> Map k a
forall a b. a -> b -> a
const Map k a
forall k a. Map k a
Map.empty) (Map k a -> Map k a -> Map k a
forall a b. a -> b -> a
const Map k a
forall k a. Map k a
Map.empty)

-- IntMap instances

instance LeftReductiveMonoid (IntMap.IntMap a) where
   isPrefixOf :: IntMap a -> IntMap a -> Bool
isPrefixOf = (a -> a -> Bool) -> IntMap a -> IntMap a -> Bool
forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
IntMap.isSubmapOfBy (\a
_ a
_-> Bool
True)
   stripPrefix :: IntMap a -> IntMap a -> Maybe (IntMap a)
stripPrefix IntMap a
a IntMap a
b | (a -> a -> Bool) -> IntMap a -> IntMap a -> Bool
forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
IntMap.isSubmapOfBy (\a
_ a
_-> Bool
True) IntMap a
a IntMap a
b = IntMap a -> Maybe (IntMap a)
forall a. a -> Maybe a
Just (IntMap a
b IntMap a -> IntMap a -> IntMap a
forall a b. IntMap a -> IntMap b -> IntMap a
IntMap.\\ IntMap a
a)
                   | Bool
otherwise = Maybe (IntMap a)
forall a. Maybe a
Nothing

instance Eq a => LeftGCDMonoid (IntMap.IntMap a) where
   commonPrefix :: IntMap a -> IntMap a -> IntMap a
commonPrefix = (Key -> a -> a -> Maybe a)
-> (IntMap a -> IntMap a)
-> (IntMap a -> IntMap a)
-> IntMap a
-> IntMap a
-> IntMap a
forall a b c.
(Key -> a -> b -> Maybe c)
-> (IntMap a -> IntMap c)
-> (IntMap b -> IntMap c)
-> IntMap a
-> IntMap b
-> IntMap c
IntMap.mergeWithKey (\Key
_ a
a a
b -> if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b then a -> Maybe a
forall a. a -> Maybe a
Just a
a else Maybe a
forall a. Maybe a
Nothing)
                                      (IntMap a -> IntMap a -> IntMap a
forall a b. a -> b -> a
const IntMap a
forall a. IntMap a
IntMap.empty) (IntMap a -> IntMap a -> IntMap a
forall a b. a -> b -> a
const IntMap a
forall a. IntMap a
IntMap.empty)

-- List instances

instance Eq x => LeftReductiveMonoid [x] where
   stripPrefix :: [x] -> [x] -> Maybe [x]
stripPrefix = [x] -> [x] -> Maybe [x]
forall x. Eq x => [x] -> [x] -> Maybe [x]
List.stripPrefix
   isPrefixOf :: [x] -> [x] -> Bool
isPrefixOf = [x] -> [x] -> Bool
forall x. Eq x => [x] -> [x] -> Bool
List.isPrefixOf

instance Eq x => LeftCancellativeMonoid [x]

instance Eq x => LeftGCDMonoid [x] where
   commonPrefix :: [x] -> [x] -> [x]
commonPrefix (x
x:[x]
xs) (x
y:[x]
ys) | x
x x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
y = x
x x -> [x] -> [x]
forall a. a -> [a] -> [a]
: [x] -> [x] -> [x]
forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix [x]
xs [x]
ys
   commonPrefix [x]
_ [x]
_ = []

   stripCommonPrefix :: [x] -> [x] -> ([x], [x], [x])
stripCommonPrefix [x]
x0 [x]
y0 = ([x] -> [x]) -> [x] -> [x] -> ([x], [x], [x])
forall a a. Eq a => ([a] -> a) -> [a] -> [a] -> (a, [a], [a])
strip' [x] -> [x]
forall a. a -> a
id [x]
x0 [x]
y0
      where strip' :: ([a] -> a) -> [a] -> [a] -> (a, [a], [a])
strip' [a] -> a
f (a
x:[a]
xs) (a
y:[a]
ys) | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = ([a] -> a) -> [a] -> [a] -> (a, [a], [a])
strip' ([a] -> a
f ([a] -> a) -> ([a] -> [a]) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) [a]
xs [a]
ys
            strip' [a] -> a
f [a]
x [a]
y = ([a] -> a
f [], [a]
x, [a]
y)

-- Seq instances

instance Eq a => LeftReductiveMonoid (Sequence.Seq a) where
   stripPrefix :: Seq a -> Seq a -> Maybe (Seq a)
stripPrefix Seq a
p Seq a
s | Seq a
p Seq a -> Seq a -> Bool
forall a. Eq a => a -> a -> Bool
== Seq a
s1 = Seq a -> Maybe (Seq a)
forall a. a -> Maybe a
Just Seq a
s2
                   | Bool
otherwise = Maybe (Seq a)
forall a. Maybe a
Nothing
      where (Seq a
s1, Seq a
s2) = Key -> Seq a -> (Seq a, Seq a)
forall a. Key -> Seq a -> (Seq a, Seq a)
Sequence.splitAt (Seq a -> Key
forall a. Seq a -> Key
Sequence.length Seq a
p) Seq a
s

instance Eq a => RightReductiveMonoid (Sequence.Seq a) where
   stripSuffix :: Seq a -> Seq a -> Maybe (Seq a)
stripSuffix Seq a
p Seq a
s | Seq a
p Seq a -> Seq a -> Bool
forall a. Eq a => a -> a -> Bool
== Seq a
s2 = Seq a -> Maybe (Seq a)
forall a. a -> Maybe a
Just Seq a
s1
                   | Bool
otherwise = Maybe (Seq a)
forall a. Maybe a
Nothing
      where (Seq a
s1, Seq a
s2) = Key -> Seq a -> (Seq a, Seq a)
forall a. Key -> Seq a -> (Seq a, Seq a)
Sequence.splitAt (Seq a -> Key
forall a. Seq a -> Key
Sequence.length Seq a
s Key -> Key -> Key
forall a. Num a => a -> a -> a
- Seq a -> Key
forall a. Seq a -> Key
Sequence.length Seq a
p) Seq a
s

instance Eq a => LeftCancellativeMonoid (Sequence.Seq a)

instance Eq a => RightCancellativeMonoid (Sequence.Seq a)

instance Eq a => LeftGCDMonoid (Sequence.Seq a) where
   stripCommonPrefix :: Seq a -> Seq a -> (Seq a, Seq a, Seq a)
stripCommonPrefix = Seq a -> Seq a -> Seq a -> (Seq a, Seq a, Seq a)
forall a. Eq a => Seq a -> Seq a -> Seq a -> (Seq a, Seq a, Seq a)
findCommonPrefix Seq a
forall a. Seq a
Sequence.empty
      where findCommonPrefix :: Seq a -> Seq a -> Seq a -> (Seq a, Seq a, Seq a)
findCommonPrefix Seq a
prefix Seq a
a Seq a
b = case (Seq a -> ViewL a
forall a. Seq a -> ViewL a
Sequence.viewl Seq a
a, Seq a -> ViewL a
forall a. Seq a -> ViewL a
Sequence.viewl Seq a
b)
                                          of (a
a1:<Seq a
a', a
b1:<Seq a
b') | a
a1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b1 -> Seq a -> Seq a -> Seq a -> (Seq a, Seq a, Seq a)
findCommonPrefix (Seq a
prefix Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
a1) Seq a
a' Seq a
b'
                                             (ViewL a, ViewL a)
_ -> (Seq a
prefix, Seq a
a, Seq a
b)

instance Eq a => RightGCDMonoid (Sequence.Seq a) where
   stripCommonSuffix :: Seq a -> Seq a -> (Seq a, Seq a, Seq a)
stripCommonSuffix = Seq a -> Seq a -> Seq a -> (Seq a, Seq a, Seq a)
forall a. Eq a => Seq a -> Seq a -> Seq a -> (Seq a, Seq a, Seq a)
findCommonSuffix Seq a
forall a. Seq a
Sequence.empty
      where findCommonSuffix :: Seq a -> Seq a -> Seq a -> (Seq a, Seq a, Seq a)
findCommonSuffix Seq a
suffix Seq a
a Seq a
b = case (Seq a -> ViewR a
forall a. Seq a -> ViewR a
Sequence.viewr Seq a
a, Seq a -> ViewR a
forall a. Seq a -> ViewR a
Sequence.viewr Seq a
b)
                                          of (Seq a
a':>a
a1, Seq a
b':>a
b1) | a
a1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b1 -> Seq a -> Seq a -> Seq a -> (Seq a, Seq a, Seq a)
findCommonSuffix (a
a1 a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a
suffix) Seq a
a' Seq a
b'
                                             (ViewR a, ViewR a)
_ -> (Seq a
a, Seq a
b, Seq a
suffix)

-- Vector instances

instance Eq a => LeftReductiveMonoid (Vector.Vector a) where
   stripPrefix :: Vector a -> Vector a -> Maybe (Vector a)
stripPrefix Vector a
p Vector a
l | Key
prefixLength Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
> Vector a -> Key
forall a. Vector a -> Key
Vector.length Vector a
l = Maybe (Vector a)
forall a. Maybe a
Nothing
                    | Bool
otherwise = Key -> Maybe (Vector a)
strip Key
0
      where strip :: Key -> Maybe (Vector a)
strip Key
i | Key
i Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
prefixLength = Vector a -> Maybe (Vector a)
forall a. a -> Maybe a
Just (Key -> Vector a -> Vector a
forall a. Key -> Vector a -> Vector a
Vector.drop Key
prefixLength Vector a
l)
                    | Vector a
l Vector a -> Key -> a
forall a. Vector a -> Key -> a
Vector.! Key
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Vector a
p Vector a -> Key -> a
forall a. Vector a -> Key -> a
Vector.! Key
i = Key -> Maybe (Vector a)
strip (Key -> Key
forall a. Enum a => a -> a
succ Key
i)
                    | Bool
otherwise = Maybe (Vector a)
forall a. Maybe a
Nothing
            prefixLength :: Key
prefixLength = Vector a -> Key
forall a. Vector a -> Key
Vector.length Vector a
p
   isPrefixOf :: Vector a -> Vector a -> Bool
isPrefixOf Vector a
p Vector a
l | Key
prefixLength Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
> Vector a -> Key
forall a. Vector a -> Key
Vector.length Vector a
l = Bool
False
                  | Bool
otherwise = Key -> Bool
test Key
0
      where test :: Key -> Bool
test Key
i | Key
i Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
prefixLength = Bool
True
                   | Vector a
l Vector a -> Key -> a
forall a. Vector a -> Key -> a
Vector.! Key
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Vector a
p Vector a -> Key -> a
forall a. Vector a -> Key -> a
Vector.! Key
i = Key -> Bool
test (Key -> Key
forall a. Enum a => a -> a
succ Key
i)
                   | Bool
otherwise = Bool
False
            prefixLength :: Key
prefixLength = Vector a -> Key
forall a. Vector a -> Key
Vector.length Vector a
p

instance Eq a => RightReductiveMonoid (Vector.Vector a) where
   stripSuffix :: Vector a -> Vector a -> Maybe (Vector a)
stripSuffix Vector a
s Vector a
l | Key
suffixLength Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
> Vector a -> Key
forall a. Vector a -> Key
Vector.length Vector a
l = Maybe (Vector a)
forall a. Maybe a
Nothing
                   | Bool
otherwise = Key -> Maybe (Vector a)
strip (Key -> Key
forall a. Enum a => a -> a
pred Key
suffixLength)
      where strip :: Key -> Maybe (Vector a)
strip Key
i | Key
i Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== -Key
1 = Vector a -> Maybe (Vector a)
forall a. a -> Maybe a
Just (Key -> Vector a -> Vector a
forall a. Key -> Vector a -> Vector a
Vector.take Key
lengthDifference Vector a
l)
                    | Vector a
l Vector a -> Key -> a
forall a. Vector a -> Key -> a
Vector.! (Key
lengthDifference Key -> Key -> Key
forall a. Num a => a -> a -> a
+ Key
i) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Vector a
s Vector a -> Key -> a
forall a. Vector a -> Key -> a
Vector.! Key
i = Key -> Maybe (Vector a)
strip (Key -> Key
forall a. Enum a => a -> a
pred Key
i)
                    | Bool
otherwise = Maybe (Vector a)
forall a. Maybe a
Nothing
            suffixLength :: Key
suffixLength = Vector a -> Key
forall a. Vector a -> Key
Vector.length Vector a
s
            lengthDifference :: Key
lengthDifference = Vector a -> Key
forall a. Vector a -> Key
Vector.length Vector a
l Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
suffixLength
   isSuffixOf :: Vector a -> Vector a -> Bool
isSuffixOf Vector a
s Vector a
l | Key
suffixLength Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
> Vector a -> Key
forall a. Vector a -> Key
Vector.length Vector a
l = Bool
False
                  | Bool
otherwise = Key -> Bool
test (Key -> Key
forall a. Enum a => a -> a
pred Key
suffixLength)
      where test :: Key -> Bool
test Key
i | Key
i Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== -Key
1 = Bool
True
                   | Vector a
l Vector a -> Key -> a
forall a. Vector a -> Key -> a
Vector.! (Key
lengthDifference Key -> Key -> Key
forall a. Num a => a -> a -> a
+ Key
i) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Vector a
s Vector a -> Key -> a
forall a. Vector a -> Key -> a
Vector.! Key
i = Key -> Bool
test (Key -> Key
forall a. Enum a => a -> a
pred Key
i)
                   | Bool
otherwise = Bool
False
            suffixLength :: Key
suffixLength = Vector a -> Key
forall a. Vector a -> Key
Vector.length Vector a
s
            lengthDifference :: Key
lengthDifference = Vector a -> Key
forall a. Vector a -> Key
Vector.length Vector a
l Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
suffixLength

instance Eq a => LeftCancellativeMonoid (Vector.Vector a)

instance Eq a => RightCancellativeMonoid (Vector.Vector a)

instance Eq a => LeftGCDMonoid (Vector.Vector a) where
   stripCommonPrefix :: Vector a -> Vector a -> (Vector a, Vector a, Vector a)
stripCommonPrefix Vector a
x Vector a
y = (Vector a
xp, Vector a
xs, Key -> Vector a -> Vector a
forall a. Key -> Vector a -> Vector a
Vector.drop Key
maxPrefixLength Vector a
y)
      where maxPrefixLength :: Key
maxPrefixLength = Key -> Key -> Key
prefixLength Key
0 (Vector a -> Key
forall a. Vector a -> Key
Vector.length Vector a
x Key -> Key -> Key
forall a. Ord a => a -> a -> a
`min` Vector a -> Key
forall a. Vector a -> Key
Vector.length Vector a
y)
            prefixLength :: Key -> Key -> Key
prefixLength Key
n Key
len | Key
n Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
len Bool -> Bool -> Bool
&& Vector a
x Vector a -> Key -> a
forall a. Vector a -> Key -> a
Vector.! Key
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Vector a
y Vector a -> Key -> a
forall a. Vector a -> Key -> a
Vector.! Key
n = Key -> Key -> Key
prefixLength (Key -> Key
forall a. Enum a => a -> a
succ Key
n) Key
len
            prefixLength Key
n Key
_ = Key
n
            (Vector a
xp, Vector a
xs) = Key -> Vector a -> (Vector a, Vector a)
forall a. Key -> Vector a -> (Vector a, Vector a)
Vector.splitAt Key
maxPrefixLength Vector a
x

instance Eq a => RightGCDMonoid (Vector.Vector a) where
   stripCommonSuffix :: Vector a -> Vector a -> (Vector a, Vector a, Vector a)
stripCommonSuffix Vector a
x Vector a
y = Key -> Key -> (Vector a, Vector a, Vector a)
findSuffix (Vector a -> Key
forall a. Vector a -> Key
Vector.length Vector a
x Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
1) (Vector a -> Key
forall a. Vector a -> Key
Vector.length Vector a
y Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
1)
      where findSuffix :: Key -> Key -> (Vector a, Vector a, Vector a)
findSuffix Key
m Key
n | Key
m Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
>= Key
0 Bool -> Bool -> Bool
&& Key
n Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
>= Key
0 Bool -> Bool -> Bool
&& Vector a
x Vector a -> Key -> a
forall a. Vector a -> Key -> a
Vector.! Key
m a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Vector a
y Vector a -> Key -> a
forall a. Vector a -> Key -> a
Vector.! Key
n =
               Key -> Key -> (Vector a, Vector a, Vector a)
findSuffix (Key -> Key
forall a. Enum a => a -> a
pred Key
m) (Key -> Key
forall a. Enum a => a -> a
pred Key
n)
            findSuffix Key
m Key
n = (Key -> Vector a -> Vector a
forall a. Key -> Vector a -> Vector a
Vector.take (Key -> Key
forall a. Enum a => a -> a
succ Key
m) Vector a
x, Vector a
yp, Vector a
ys)
               where (Vector a
yp, Vector a
ys) = Key -> Vector a -> (Vector a, Vector a)
forall a. Key -> Vector a -> (Vector a, Vector a)
Vector.splitAt (Key -> Key
forall a. Enum a => a -> a
succ Key
n) Vector a
y

-- ByteString instances

instance LeftReductiveMonoid ByteString.ByteString where
   stripPrefix :: ByteString -> ByteString -> Maybe ByteString
stripPrefix ByteString
p ByteString
l = if ByteString -> ByteString -> Bool
ByteString.isPrefixOf ByteString
p ByteString
l
                     then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Key -> ByteString -> ByteString
ByteString.unsafeDrop (ByteString -> Key
ByteString.length ByteString
p) ByteString
l)
                     else Maybe ByteString
forall a. Maybe a
Nothing
   isPrefixOf :: ByteString -> ByteString -> Bool
isPrefixOf = ByteString -> ByteString -> Bool
ByteString.isPrefixOf

instance RightReductiveMonoid ByteString.ByteString where
   stripSuffix :: ByteString -> ByteString -> Maybe ByteString
stripSuffix ByteString
s ByteString
l = if ByteString -> ByteString -> Bool
ByteString.isSuffixOf ByteString
s ByteString
l
                     then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Key -> ByteString -> ByteString
ByteString.unsafeTake (ByteString -> Key
ByteString.length ByteString
l Key -> Key -> Key
forall a. Num a => a -> a -> a
- ByteString -> Key
ByteString.length ByteString
s) ByteString
l)
                     else Maybe ByteString
forall a. Maybe a
Nothing
   isSuffixOf :: ByteString -> ByteString -> Bool
isSuffixOf = ByteString -> ByteString -> Bool
ByteString.isSuffixOf

instance LeftCancellativeMonoid ByteString.ByteString

instance RightCancellativeMonoid ByteString.ByteString

instance LeftGCDMonoid ByteString.ByteString where
   stripCommonPrefix :: ByteString -> ByteString -> (ByteString, ByteString, ByteString)
stripCommonPrefix ByteString
x ByteString
y = (ByteString
xp, ByteString
xs, Key -> ByteString -> ByteString
ByteString.unsafeDrop Key
maxPrefixLength ByteString
y)
      where maxPrefixLength :: Key
maxPrefixLength = Key -> Key -> Key
prefixLength Key
0 (ByteString -> Key
ByteString.length ByteString
x Key -> Key -> Key
forall a. Ord a => a -> a -> a
`min` ByteString -> Key
ByteString.length ByteString
y)
            prefixLength :: Key -> Key -> Key
prefixLength Key
n Key
len | Key
n Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
len,
                                 ByteString -> Key -> Word8
ByteString.unsafeIndex ByteString
x Key
n Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Key -> Word8
ByteString.unsafeIndex ByteString
y Key
n =
                                    Key -> Key -> Key
prefixLength (Key -> Key
forall a. Enum a => a -> a
succ Key
n) Key
len
                               | Bool
otherwise = Key
n
            (ByteString
xp, ByteString
xs) = Key -> ByteString -> (ByteString, ByteString)
ByteString.splitAt Key
maxPrefixLength ByteString
x

instance RightGCDMonoid ByteString.ByteString where
   stripCommonSuffix :: ByteString -> ByteString -> (ByteString, ByteString, ByteString)
stripCommonSuffix ByteString
x ByteString
y = Key -> Key -> (ByteString, ByteString, ByteString)
findSuffix (ByteString -> Key
ByteString.length ByteString
x Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
1) (ByteString -> Key
ByteString.length ByteString
y Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
1)
      where findSuffix :: Key -> Key -> (ByteString, ByteString, ByteString)
findSuffix Key
m Key
n | Key
m Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
>= Key
0, Key
n Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
>= Key
0,
                             ByteString -> Key -> Word8
ByteString.unsafeIndex ByteString
x Key
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Key -> Word8
ByteString.unsafeIndex ByteString
y Key
n =
                                Key -> Key -> (ByteString, ByteString, ByteString)
findSuffix (Key -> Key
forall a. Enum a => a -> a
pred Key
m) (Key -> Key
forall a. Enum a => a -> a
pred Key
n)
                           | Bool
otherwise = let (ByteString
yp, ByteString
ys) = Key -> ByteString -> (ByteString, ByteString)
ByteString.splitAt (Key -> Key
forall a. Enum a => a -> a
succ Key
n) ByteString
y
                                         in (Key -> ByteString -> ByteString
ByteString.unsafeTake (Key -> Key
forall a. Enum a => a -> a
succ Key
m) ByteString
x, ByteString
yp, ByteString
ys)

-- Lazy ByteString instances

instance LeftReductiveMonoid LazyByteString.ByteString where
   stripPrefix :: ByteString -> ByteString -> Maybe ByteString
stripPrefix ByteString
p ByteString
l = if ByteString -> ByteString -> Bool
LazyByteString.isPrefixOf ByteString
p ByteString
l
                     then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Int64 -> ByteString -> ByteString
LazyByteString.drop (ByteString -> Int64
LazyByteString.length ByteString
p) ByteString
l)
                     else Maybe ByteString
forall a. Maybe a
Nothing
   isPrefixOf :: ByteString -> ByteString -> Bool
isPrefixOf = ByteString -> ByteString -> Bool
LazyByteString.isPrefixOf

instance RightReductiveMonoid LazyByteString.ByteString where
   stripSuffix :: ByteString -> ByteString -> Maybe ByteString
stripSuffix ByteString
s ByteString
l = if ByteString -> ByteString -> Bool
LazyByteString.isSuffixOf ByteString
s ByteString
l
                     then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Int64 -> ByteString -> ByteString
LazyByteString.take (ByteString -> Int64
LazyByteString.length ByteString
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- ByteString -> Int64
LazyByteString.length ByteString
s) ByteString
l)
                     else Maybe ByteString
forall a. Maybe a
Nothing
   isSuffixOf :: ByteString -> ByteString -> Bool
isSuffixOf = ByteString -> ByteString -> Bool
LazyByteString.isSuffixOf

instance LeftCancellativeMonoid LazyByteString.ByteString

instance RightCancellativeMonoid LazyByteString.ByteString

instance LeftGCDMonoid LazyByteString.ByteString where
   stripCommonPrefix :: ByteString -> ByteString -> (ByteString, ByteString, ByteString)
stripCommonPrefix ByteString
x ByteString
y = (ByteString
xp, ByteString
xs, Int64 -> ByteString -> ByteString
LazyByteString.drop Int64
maxPrefixLength ByteString
y)
      where maxPrefixLength :: Int64
maxPrefixLength = Int64 -> Int64 -> Int64
prefixLength Int64
0 (ByteString -> Int64
LazyByteString.length ByteString
x Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
`min` ByteString -> Int64
LazyByteString.length ByteString
y)
            prefixLength :: Int64 -> Int64 -> Int64
prefixLength Int64
n Int64
len | Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
len Bool -> Bool -> Bool
&& ByteString -> Int64 -> Word8
LazyByteString.index ByteString
x Int64
n Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int64 -> Word8
LazyByteString.index ByteString
y Int64
n =
               Int64 -> Int64 -> Int64
prefixLength (Int64 -> Int64
forall a. Enum a => a -> a
succ Int64
n) Int64
len
            prefixLength Int64
n Int64
_ = Int64
n
            (ByteString
xp, ByteString
xs) = Int64 -> ByteString -> (ByteString, ByteString)
LazyByteString.splitAt Int64
maxPrefixLength ByteString
x

instance RightGCDMonoid LazyByteString.ByteString where
   stripCommonSuffix :: ByteString -> ByteString -> (ByteString, ByteString, ByteString)
stripCommonSuffix ByteString
x ByteString
y = Int64 -> Int64 -> (ByteString, ByteString, ByteString)
findSuffix (ByteString -> Int64
LazyByteString.length ByteString
x Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1) (ByteString -> Int64
LazyByteString.length ByteString
y Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)
      where findSuffix :: Int64 -> Int64 -> (ByteString, ByteString, ByteString)
findSuffix Int64
m Int64
n | Int64
m Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0 Bool -> Bool -> Bool
&& Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0 Bool -> Bool -> Bool
&& ByteString -> Int64 -> Word8
LazyByteString.index ByteString
x Int64
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int64 -> Word8
LazyByteString.index ByteString
y Int64
n =
               Int64 -> Int64 -> (ByteString, ByteString, ByteString)
findSuffix (Int64 -> Int64
forall a. Enum a => a -> a
pred Int64
m) (Int64 -> Int64
forall a. Enum a => a -> a
pred Int64
n)
            findSuffix Int64
m Int64
n = (Int64 -> ByteString -> ByteString
LazyByteString.take (Int64 -> Int64
forall a. Enum a => a -> a
succ Int64
m) ByteString
x, ByteString
yp, ByteString
ys)
               where (ByteString
yp, ByteString
ys) = Int64 -> ByteString -> (ByteString, ByteString)
LazyByteString.splitAt (Int64 -> Int64
forall a. Enum a => a -> a
succ Int64
n) ByteString
y

-- Text instances

instance LeftReductiveMonoid Text.Text where
   stripPrefix :: Text -> Text -> Maybe Text
stripPrefix = Text -> Text -> Maybe Text
Text.stripPrefix
   isPrefixOf :: Text -> Text -> Bool
isPrefixOf = Text -> Text -> Bool
Text.isPrefixOf

instance RightReductiveMonoid Text.Text where
   stripSuffix :: Text -> Text -> Maybe Text
stripSuffix = Text -> Text -> Maybe Text
Text.stripSuffix
   isSuffixOf :: Text -> Text -> Bool
isSuffixOf = Text -> Text -> Bool
Text.isSuffixOf

instance LeftCancellativeMonoid Text.Text

instance RightCancellativeMonoid Text.Text

instance LeftGCDMonoid Text.Text where
   stripCommonPrefix :: Text -> Text -> (Text, Text, Text)
stripCommonPrefix Text
x Text
y = (Text, Text, Text)
-> ((Text, Text, Text) -> (Text, Text, Text))
-> Maybe (Text, Text, Text)
-> (Text, Text, Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
Text.empty, Text
x, Text
y) (Text, Text, Text) -> (Text, Text, Text)
forall a. a -> a
id (Text -> Text -> Maybe (Text, Text, Text)
Text.commonPrefixes Text
x Text
y)

-- Lazy Text instances

instance LeftReductiveMonoid LazyText.Text where
   stripPrefix :: Text -> Text -> Maybe Text
stripPrefix = Text -> Text -> Maybe Text
LazyText.stripPrefix
   isPrefixOf :: Text -> Text -> Bool
isPrefixOf = Text -> Text -> Bool
LazyText.isPrefixOf

instance RightReductiveMonoid LazyText.Text where
   stripSuffix :: Text -> Text -> Maybe Text
stripSuffix = Text -> Text -> Maybe Text
LazyText.stripSuffix
   isSuffixOf :: Text -> Text -> Bool
isSuffixOf = Text -> Text -> Bool
LazyText.isSuffixOf

instance LeftCancellativeMonoid LazyText.Text

instance RightCancellativeMonoid LazyText.Text

instance LeftGCDMonoid LazyText.Text where
   stripCommonPrefix :: Text -> Text -> (Text, Text, Text)
stripCommonPrefix Text
x Text
y = (Text, Text, Text)
-> ((Text, Text, Text) -> (Text, Text, Text))
-> Maybe (Text, Text, Text)
-> (Text, Text, Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
LazyText.empty, Text
x, Text
y) (Text, Text, Text) -> (Text, Text, Text)
forall a. a -> a
id (Text -> Text -> Maybe (Text, Text, Text)
LazyText.commonPrefixes Text
x Text
y)