{- 
    Copyright 2013-2019 Mario Blazevic

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

-- | This module defines the 'Semigroup' => 'Reductive' => 'Cancellative' class hierarchy.
--
-- @since 1.0
--
-- The 'Reductive' class introduces operation '</>' which is the inverse of '<>'. For the 'Sum' semigroup, this
-- operation is subtraction; for 'Product' it is division and for 'Set' it's the set difference. A 'Reductive'
-- semigroup is not a full group because '</>' may return 'Nothing'.
--
-- The 'Cancellative' subclass does not add any operation but it provides the additional guarantee that '<>' can
-- always be undone with '</>'. Thus 'Sum' is 'Cancellative' but 'Product' is not because @(0*n)/0@ is not defined.
--
-- All semigroup subclasses listed above are for Abelian, /i.e./, commutative or symmetric semigroups. Since most
-- practical semigroups in Haskell are not Abelian, each of the these classes has two symmetric superclasses:
-- 
-- * 'LeftReductive'
-- 
-- * 'LeftCancellative'
-- 
-- * 'RightReductive'
-- 
-- * 'RightCancellative'

{-# LANGUAGE Haskell2010, FlexibleInstances, Trustworthy #-}

module Data.Semigroup.Cancellative (
   -- * Symmetric, commutative semigroup classes
   Commutative, Reductive(..), Cancellative, SumCancellative(..),
   -- * Asymmetric semigroup classes
   LeftReductive(..), RightReductive(..),
   LeftCancellative, RightCancellative
   )
where

import Data.Semigroup -- (Semigroup, Dual(..), Sum(..), Product(..))
import Data.Semigroup.Commutative
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 qualified Data.Vector as Vector
import Numeric.Natural (Natural)
import Numeric.Product.Commutative (CommutativeProduct)

-- | Class of Abelian semigroups with a partial inverse for the Semigroup '<>' operation. The inverse operation '</>' must
-- satisfy the following laws:
-- 
-- > maybe a (b <>) (a </> b) == a
-- > maybe a (<> b) (a </> b) == a
--
-- The '</>' operator is a synonym for both 'stripPrefix' and 'stripSuffix', which must be equivalent as '<>' is both
-- associative and commutative.
--
-- > (</>) = flip stripPrefix
-- > (</>) = flip stripSuffix
class (Commutative m, LeftReductive m, RightReductive m) => Reductive m where
   (</>) :: m -> m -> Maybe m

infix 5 </>

-- | Subclass of 'Reductive' where '</>' is a complete inverse of the Semigroup '<>' operation. The class
-- instances must satisfy the following additional laws:
--
-- > (a <> b) </> a == Just b
-- > (a <> b) </> b == Just a
class (LeftCancellative m, RightCancellative m, Reductive m) => Cancellative m

-- | Class of semigroups with a left inverse of 'Data.Semigroup.<>', 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.
class Semigroup m => LeftReductive m where
   isPrefixOf :: m -> m -> Bool
   stripPrefix :: m -> m -> Maybe m

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

-- | Class of semigroups with a right inverse of 'Data.Semigroup.<>', 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.
class Semigroup m => RightReductive m where
   isSuffixOf :: m -> m -> Bool
   stripSuffix :: m -> m -> Maybe m

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

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

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

-- Unit instances

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

instance Cancellative ()

-- | /O(1)/
instance LeftReductive () where
   stripPrefix :: () -> () -> Maybe ()
stripPrefix () () = forall a. a -> Maybe a
Just ()

-- | /O(1)/
instance RightReductive () where
   stripSuffix :: () -> () -> Maybe ()
stripSuffix () () = forall a. a -> Maybe a
Just ()

instance LeftCancellative ()

instance RightCancellative ()

-- Dual instances

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

instance Cancellative a => Cancellative (Dual a)

instance LeftReductive a => RightReductive (Dual a) where
   stripSuffix :: Dual a -> Dual a -> Maybe (Dual a)
stripSuffix (Dual a
a) (Dual a
b) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Dual a
Dual (forall m. LeftReductive 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 forall m. LeftReductive m => m -> m -> Bool
`isPrefixOf` a
b

instance RightReductive a => LeftReductive (Dual a) where
   stripPrefix :: Dual a -> Dual a -> Maybe (Dual a)
stripPrefix (Dual a
a) (Dual a
b) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Dual a
Dual (forall m. RightReductive 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 forall m. RightReductive m => m -> m -> Bool
`isSuffixOf` a
b

instance LeftCancellative a => RightCancellative (Dual a)

instance RightCancellative a => LeftCancellative (Dual a)

-- Sum instances

-- | Helper class to avoid @FlexibleInstances@
class Num a => SumCancellative a where
   cancelAddition :: a -> a -> Maybe a
   cancelAddition a
a a
b = forall a. a -> Maybe a
Just (a
a forall a. Num a => a -> a -> a
- a
b)

instance SumCancellative Int
instance SumCancellative Integer
instance SumCancellative Rational

instance SumCancellative Natural where
   cancelAddition :: Natural -> Natural -> Maybe Natural
cancelAddition Natural
a Natural
b
      | Natural
a forall a. Ord a => a -> a -> Bool
< Natural
b = forall a. Maybe a
Nothing
      | Bool
otherwise = forall a. a -> Maybe a
Just (Natural
a forall a. Num a => a -> a -> a
- Natural
b)

-- | /O(1)/
instance SumCancellative a => Reductive (Sum a) where
   Sum a
a </> :: Sum a -> Sum a -> Maybe (Sum a)
</> Sum a
b = forall a. a -> Sum a
Sum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SumCancellative a => a -> a -> Maybe a
cancelAddition a
a a
b

-- | /O(1)/
instance SumCancellative a => LeftReductive (Sum a) where
   stripPrefix :: Sum a -> Sum a -> Maybe (Sum a)
stripPrefix Sum a
a Sum a
b = Sum a
b forall m. Reductive m => m -> m -> Maybe m
</> Sum a
a

-- | /O(1)/
instance SumCancellative a => RightReductive (Sum a) where
   stripSuffix :: Sum a -> Sum a -> Maybe (Sum a)
stripSuffix Sum a
a Sum a
b = Sum a
b forall m. Reductive m => m -> m -> Maybe m
</> Sum a
a

instance SumCancellative a => Cancellative (Sum a)
instance SumCancellative a => LeftCancellative (Sum a)
instance SumCancellative a => RightCancellative (Sum a)

-- Product instances

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

instance (CommutativeProduct a, Integral a) => LeftReductive (Product a) where
   stripPrefix :: Product a -> Product a -> Maybe (Product a)
stripPrefix Product a
a Product a
b = Product a
b forall m. Reductive m => m -> m -> Maybe m
</> Product a
a

instance (CommutativeProduct a, Integral a) => RightReductive (Product a) where
   stripSuffix :: Product a -> Product a -> Maybe (Product a)
stripSuffix Product a
a Product a
b = Product a
b forall m. Reductive m => m -> m -> Maybe m
</> Product a
a

-- Pair instances

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

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

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

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

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

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

-- Triple instances

instance (Reductive a, Reductive b, Reductive c) => Reductive (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) = (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a
a1 forall m. Reductive m => m -> m -> Maybe m
</> a
a2) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (b
b1 forall m. Reductive m => m -> m -> Maybe m
</> b
b2) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (c
c1 forall m. Reductive m => m -> m -> Maybe m
</> c
c2)

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

instance (LeftReductive a, LeftReductive b, LeftReductive c) => LeftReductive (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) = (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix a
a1 a
a2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix b
b1 b
b2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall m. LeftReductive 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) = forall m. LeftReductive m => m -> m -> Bool
isPrefixOf a
a1 a
a2 Bool -> Bool -> Bool
&& forall m. LeftReductive m => m -> m -> Bool
isPrefixOf b
b1 b
b2 Bool -> Bool -> Bool
&& forall m. LeftReductive m => m -> m -> Bool
isPrefixOf c
c1 c
c2

instance (RightReductive a, RightReductive b, RightReductive c) => RightReductive (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) = (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m. RightReductive m => m -> m -> Maybe m
stripSuffix a
a1 a
a2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall m. RightReductive m => m -> m -> Maybe m
stripSuffix b
b1 b
b2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall m. RightReductive 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) = forall m. RightReductive m => m -> m -> Bool
isSuffixOf a
a1 a
a2 Bool -> Bool -> Bool
&& forall m. RightReductive m => m -> m -> Bool
isSuffixOf b
b1 b
b2 Bool -> Bool -> Bool
&& forall m. RightReductive m => m -> m -> Bool
isSuffixOf c
c1 c
c2

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

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

-- Quadruple instances

instance (Reductive a, Reductive b, Reductive c, Reductive d) => Reductive (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) = (,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a
a1 forall m. Reductive m => m -> m -> Maybe m
</> a
a2) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (b
b1 forall m. Reductive m => m -> m -> Maybe m
</> b
b2) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (c
c1 forall m. Reductive m => m -> m -> Maybe m
</> c
c2) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (d
d1 forall m. Reductive m => m -> m -> Maybe m
</> d
d2)

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

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

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

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

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

-- Maybe instances

-- | @since 1.0
instance Reductive x => Reductive (Maybe x) where
   Just x
x </> :: Maybe x -> Maybe x -> Maybe (Maybe x)
</> Just x
y = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x
x forall m. Reductive m => m -> m -> Maybe m
</> x
y
   Maybe x
x </> Maybe x
Nothing = forall a. a -> Maybe a
Just Maybe x
x
   Maybe x
Nothing </> Maybe x
_ = forall a. Maybe a
Nothing

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

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

-- Set instances

-- | /O(m*log(n/m + 1)), m <= n/
instance Ord a => LeftReductive (Set.Set a) where
   isPrefixOf :: Set a -> Set a -> Bool
isPrefixOf = 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 forall m. Reductive m => m -> m -> Maybe m
</> Set a
a

-- | /O(m*log(n/m + 1)), m <= n/
instance Ord a => RightReductive (Set.Set a) where
   isSuffixOf :: Set a -> Set a -> Bool
isSuffixOf = 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 forall m. Reductive m => m -> m -> Maybe m
</> Set a
a

-- | /O(m*log(n/m + 1)), m <= n/
instance Ord a => Reductive (Set.Set a) where
   Set a
a </> :: Set a -> Set a -> Maybe (Set a)
</> Set a
b | forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set a
b Set a
a = forall a. a -> Maybe a
Just (Set a
a forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
b)
           | Bool
otherwise = forall a. Maybe a
Nothing

-- IntSet instances

-- | /O(m+n)/
instance LeftReductive 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 forall m. Reductive m => m -> m -> Maybe m
</> IntSet
a

-- | /O(m+n)/
instance RightReductive 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 forall m. Reductive m => m -> m -> Maybe m
</> IntSet
a

-- | /O(m+n)/
instance Reductive IntSet.IntSet where
   IntSet
a </> :: IntSet -> IntSet -> Maybe IntSet
</> IntSet
b | IntSet -> IntSet -> Bool
IntSet.isSubsetOf IntSet
b IntSet
a = forall a. a -> Maybe a
Just (IntSet
a IntSet -> IntSet -> IntSet
IntSet.\\ IntSet
b)
           | Bool
otherwise = forall a. Maybe a
Nothing

-- Map instances

-- | /O(m+n)/
instance (Ord k, Eq a) => LeftReductive (Map.Map k a) where
   isPrefixOf :: Map k a -> Map k a -> Bool
isPrefixOf = forall k a. (Ord k, Eq a) => Map k a -> Map k a -> Bool
Map.isSubmapOf
   stripPrefix :: Map k a -> Map k a -> Maybe (Map k a)
stripPrefix Map k a
a Map k a
b | forall k a. (Ord k, Eq a) => Map k a -> Map k a -> Bool
Map.isSubmapOf Map k a
a Map k a
b = forall a. a -> Maybe a
Just (Map k a
b forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map k a
a)
                   | Bool
otherwise = forall a. Maybe a
Nothing

-- | /O(m+n)/
instance (Ord k, Eq a) => RightReductive (Map.Map k a) where
   isSuffixOf :: Map k a -> Map k a -> Bool
isSuffixOf = forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
Map.isSubmapOfBy (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Bool
True)
   stripSuffix :: Map k a -> Map k a -> Maybe (Map k a)
stripSuffix Map k a
a Map k a
b | Map k a
a forall m. RightReductive m => m -> m -> Bool
`isSuffixOf` Map k a
b = forall a. a -> Maybe a
Just (forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith (\a
x a
y-> if a
x forall a. Eq a => a -> a -> Bool
== a
y then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just a
x) Map k a
b Map k a
a)
                   | Bool
otherwise = forall a. Maybe a
Nothing

-- IntMap instances

-- | /O(m+n)/
instance Eq a => LeftReductive (IntMap.IntMap a) where
   isPrefixOf :: IntMap a -> IntMap a -> Bool
isPrefixOf = forall a. Eq a => IntMap a -> IntMap a -> Bool
IntMap.isSubmapOf
   stripPrefix :: IntMap a -> IntMap a -> Maybe (IntMap a)
stripPrefix IntMap a
a IntMap a
b | forall a. Eq a => IntMap a -> IntMap a -> Bool
IntMap.isSubmapOf IntMap a
a IntMap a
b = forall a. a -> Maybe a
Just (IntMap a
b forall a b. IntMap a -> IntMap b -> IntMap a
IntMap.\\ IntMap a
a)
                   | Bool
otherwise = forall a. Maybe a
Nothing

-- | /O(m+n)/
instance Eq a => RightReductive (IntMap.IntMap a) where
   isSuffixOf :: IntMap a -> IntMap a -> Bool
isSuffixOf = forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
IntMap.isSubmapOfBy (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Bool
True)
   stripSuffix :: IntMap a -> IntMap a -> Maybe (IntMap a)
stripSuffix IntMap a
a IntMap a
b | IntMap a
a forall m. RightReductive m => m -> m -> Bool
`isSuffixOf` IntMap a
b = forall a. a -> Maybe a
Just (forall a b. (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
IntMap.differenceWith (\a
x a
y-> if a
x forall a. Eq a => a -> a -> Bool
== a
y then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just a
x) IntMap a
b IntMap a
a)
                   | Bool
otherwise = forall a. Maybe a
Nothing

-- List instances

-- | /O(prefixLength)/
instance Eq x => LeftReductive [x] where
   stripPrefix :: [x] -> [x] -> Maybe [x]
stripPrefix = forall x. Eq x => [x] -> [x] -> Maybe [x]
List.stripPrefix
   isPrefixOf :: [x] -> [x] -> Bool
isPrefixOf = forall x. Eq x => [x] -> [x] -> Bool
List.isPrefixOf

-- | @since 1.0
-- /O(m+n)/
instance Eq x => RightReductive [x] where
   isSuffixOf :: [x] -> [x] -> Bool
isSuffixOf = forall x. Eq x => [x] -> [x] -> Bool
List.isSuffixOf
   stripSuffix :: [x] -> [x] -> Maybe [x]
stripSuffix [x]
xs0 [x]
ys0 = forall {a} {a}. [a] -> [a] -> Maybe [x]
go1 [x]
xs0 [x]
ys0
      where go1 :: [a] -> [a] -> Maybe [x]
go1 (a
_:[a]
xs) (a
_:[a]
ys) = [a] -> [a] -> Maybe [x]
go1 [a]
xs [a]
ys
            go1 [] [a]
ys = forall {a} {a}. ([x] -> a) -> [a] -> [x] -> Maybe a
go2 forall a. a -> a
id [a]
ys [x]
ys0
            go1  [a]
_ [] = forall a. Maybe a
Nothing
            go2 :: ([x] -> a) -> [a] -> [x] -> Maybe a
go2 [x] -> a
fy (a
_:[a]
zs) (x
y:[x]
ys) = ([x] -> a) -> [a] -> [x] -> Maybe a
go2 ([x] -> a
fy forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x
yforall a. a -> [a] -> [a]
:)) [a]
zs [x]
ys
            go2 [x] -> a
fy [] [x]
ys
               | [x]
xs0 forall a. Eq a => a -> a -> Bool
== [x]
ys = forall a. a -> Maybe a
Just ([x] -> a
fy [])
               | Bool
otherwise = forall a. Maybe a
Nothing
            go2 [x] -> a
_ [a]
_ [x]
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

instance Eq x => LeftCancellative [x]

-- | @since 1.0
instance Eq x => RightCancellative [x]

-- Seq instances

-- | /O(log(min(m,n−m)) + prefixLength)/
instance Eq a => LeftReductive (Sequence.Seq a) where
   stripPrefix :: Seq a -> Seq a -> Maybe (Seq a)
stripPrefix Seq a
p Seq a
s | Seq a
p forall a. Eq a => a -> a -> Bool
== Seq a
s1 = forall a. a -> Maybe a
Just Seq a
s2
                   | Bool
otherwise = forall a. Maybe a
Nothing
      where (Seq a
s1, Seq a
s2) = forall a. Int -> Seq a -> (Seq a, Seq a)
Sequence.splitAt (forall a. Seq a -> Int
Sequence.length Seq a
p) Seq a
s

-- | /O(log(min(m,n−m)) + suffixLength)/
instance Eq a => RightReductive (Sequence.Seq a) where
   stripSuffix :: Seq a -> Seq a -> Maybe (Seq a)
stripSuffix Seq a
p Seq a
s | Seq a
p forall a. Eq a => a -> a -> Bool
== Seq a
s2 = forall a. a -> Maybe a
Just Seq a
s1
                   | Bool
otherwise = forall a. Maybe a
Nothing
      where (Seq a
s1, Seq a
s2) = forall a. Int -> Seq a -> (Seq a, Seq a)
Sequence.splitAt (forall a. Seq a -> Int
Sequence.length Seq a
s forall a. Num a => a -> a -> a
- forall a. Seq a -> Int
Sequence.length Seq a
p) Seq a
s

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

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

-- Vector instances

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

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

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

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

-- ByteString instances

-- | /O(n)/
instance LeftReductive ByteString.ByteString where
   stripPrefix :: ByteString -> ByteString -> Maybe ByteString
stripPrefix ByteString
p ByteString
l = if ByteString -> ByteString -> Bool
ByteString.isPrefixOf ByteString
p ByteString
l
                     then forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
ByteString.unsafeDrop (ByteString -> Int
ByteString.length ByteString
p) ByteString
l)
                     else forall a. Maybe a
Nothing
   isPrefixOf :: ByteString -> ByteString -> Bool
isPrefixOf = ByteString -> ByteString -> Bool
ByteString.isPrefixOf

-- | /O(n)/
instance RightReductive ByteString.ByteString where
   stripSuffix :: ByteString -> ByteString -> Maybe ByteString
stripSuffix ByteString
s ByteString
l = if ByteString -> ByteString -> Bool
ByteString.isSuffixOf ByteString
s ByteString
l
                     then forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
ByteString.unsafeTake (ByteString -> Int
ByteString.length ByteString
l forall a. Num a => a -> a -> a
- ByteString -> Int
ByteString.length ByteString
s) ByteString
l)
                     else forall a. Maybe a
Nothing
   isSuffixOf :: ByteString -> ByteString -> Bool
isSuffixOf = ByteString -> ByteString -> Bool
ByteString.isSuffixOf

instance LeftCancellative ByteString.ByteString

instance RightCancellative ByteString.ByteString

-- Lazy ByteString instances

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

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

instance LeftCancellative LazyByteString.ByteString

instance RightCancellative LazyByteString.ByteString

-- Text instances

-- | /O(n)/
instance LeftReductive 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

-- | /O(n)/
instance RightReductive 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 LeftCancellative Text.Text

instance RightCancellative Text.Text

-- Lazy Text instances

-- | /O(n)/
instance LeftReductive 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

-- | /O(n)/
instance RightReductive 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 LeftCancellative LazyText.Text

instance RightCancellative LazyText.Text