```{-
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.Functor.Const
import Data.Functor.Identity
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 = Maybe m -> Bool
forall a. Maybe a -> Bool
isJust (m -> m -> Maybe m
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 = Maybe m -> Bool
forall a. Maybe a -> Bool
isJust (m -> m -> Maybe m
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 ()
</> () = () -> Maybe ()
forall a. a -> Maybe a
Just ()

instance Cancellative ()

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

-- | /O(1)/
instance RightReductive () where
stripSuffix :: () -> () -> Maybe ()
stripSuffix () () = () -> Maybe ()
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 = (a -> Dual a) -> Maybe a -> Maybe (Dual a)
forall a b. (a -> b) -> Maybe a -> Maybe b
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. 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) = (a -> Dual a) -> Maybe a -> Maybe (Dual a)
forall a b. (a -> b) -> Maybe a -> Maybe b
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. 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 a -> a -> Bool
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) = (a -> Dual a) -> Maybe a -> Maybe (Dual a)
forall a b. (a -> b) -> Maybe a -> Maybe b
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. 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 a -> a -> Bool
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 = a -> Maybe a
forall a. a -> Maybe a
Just (a
a a -> 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 Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
b = Maybe Natural
forall a. Maybe a
Nothing
| Bool
otherwise = Natural -> Maybe Natural
forall a. a -> Maybe a
Just (Natural
a Natural -> Natural -> Natural
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 = a -> Sum a
forall a. a -> Sum a
Sum (a -> Sum a) -> Maybe a -> Maybe (Sum a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<\$> a -> a -> Maybe a
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 Sum a -> Sum a -> Maybe (Sum a)
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 Sum a -> Sum a -> Maybe (Sum a)
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 = 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 (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 Product a -> Product a -> Maybe (Product a)
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 Product a -> Product a -> Maybe (Product a)
forall m. Reductive m => m -> m -> Maybe m
</> Product a
a

-- Max & Min instances

instance Ord a => Reductive (Max a) where
Max a
a </> :: Max a -> Max a -> Maybe (Max a)
</> Max a
b = if Max a
b Max a -> Max a -> Bool
forall a. Ord a => a -> a -> Bool
<= Max a
a then Max a -> Maybe (Max a)
forall a. a -> Maybe a
Just Max a
a else Maybe (Max a)
forall a. Maybe a
Nothing
instance Ord a => Reductive (Min a) where
Min a
a </> :: Min a -> Min a -> Maybe (Min a)
</> Min a
b = if Min a
a Min a -> Min a -> Bool
forall a. Ord a => a -> a -> Bool
<= Min a
b then Min a -> Maybe (Min a)
forall a. a -> Maybe a
Just Min a
a else Maybe (Min a)
forall a. Maybe a
Nothing

instance Ord a => LeftReductive (Max a) where
isPrefixOf :: Max a -> Max a -> Bool
isPrefixOf Max a
a Max a
b = Max a
a Max a -> Max a -> Bool
forall a. Ord a => a -> a -> Bool
<= Max a
b
stripPrefix :: Max a -> Max a -> Maybe (Max a)
stripPrefix Max a
a Max a
b = Max a
b Max a -> Max a -> Maybe (Max a)
forall m. Reductive m => m -> m -> Maybe m
</> Max a
a
instance Ord a => LeftReductive (Min a) where
isPrefixOf :: Min a -> Min a -> Bool
isPrefixOf Min a
a Min a
b = Min a
b Min a -> Min a -> Bool
forall a. Ord a => a -> a -> Bool
<= Min a
a
stripPrefix :: Min a -> Min a -> Maybe (Min a)
stripPrefix Min a
a Min a
b = Min a
b Min a -> Min a -> Maybe (Min a)
forall m. Reductive m => m -> m -> Maybe m
</> Min a
a

instance Ord a => RightReductive (Max a) where
isSuffixOf :: Max a -> Max a -> Bool
isSuffixOf Max a
a Max a
b = Max a
a Max a -> Max a -> Bool
forall a. Ord a => a -> a -> Bool
<= Max a
b
stripSuffix :: Max a -> Max a -> Maybe (Max a)
stripSuffix Max a
a Max a
b = Max a
b Max a -> Max a -> Maybe (Max a)
forall m. Reductive m => m -> m -> Maybe m
</> Max a
a
instance Ord a => RightReductive (Min a) where
isSuffixOf :: Min a -> Min a -> Bool
isSuffixOf Min a
a Min a
b = Min a
b Min a -> Min a -> Bool
forall a. Ord a => a -> a -> Bool
<= Min a
a
stripSuffix :: Min a -> Min a -> Maybe (Min a)
stripSuffix Min a
a Min a
b = Min a
b Min a -> Min a -> Maybe (Min a)
forall m. Reductive m => m -> m -> Maybe m
</> Min a
a

-- Any & All instances

instance Reductive Any where
Any
a </> :: Any -> Any -> Maybe Any
</> Any
b = if Any
b Any -> Any -> Bool
forall a. Ord a => a -> a -> Bool
<= Any
a then Any -> Maybe Any
forall a. a -> Maybe a
Just Any
a else Maybe Any
forall a. Maybe a
Nothing
instance Reductive All where
All
a </> :: All -> All -> Maybe All
</> All
b = if All
a All -> All -> Bool
forall a. Ord a => a -> a -> Bool
<= All
b then All -> Maybe All
forall a. a -> Maybe a
Just All
a else Maybe All
forall a. Maybe a
Nothing

instance LeftReductive Any where
isPrefixOf :: Any -> Any -> Bool
isPrefixOf Any
a Any
b = Any
a Any -> Any -> Bool
forall a. Ord a => a -> a -> Bool
<= Any
b
stripPrefix :: Any -> Any -> Maybe Any
stripPrefix Any
a Any
b = Any
b Any -> Any -> Maybe Any
forall m. Reductive m => m -> m -> Maybe m
</> Any
a
instance LeftReductive All where
isPrefixOf :: All -> All -> Bool
isPrefixOf All
a All
b = All
b All -> All -> Bool
forall a. Ord a => a -> a -> Bool
<= All
a
stripPrefix :: All -> All -> Maybe All
stripPrefix All
a All
b = All
b All -> All -> Maybe All
forall m. Reductive m => m -> m -> Maybe m
</> All
a

instance RightReductive Any where
isSuffixOf :: Any -> Any -> Bool
isSuffixOf Any
a Any
b = Any
a Any -> Any -> Bool
forall a. Ord a => a -> a -> Bool
<= Any
b
stripSuffix :: Any -> Any -> Maybe Any
stripSuffix Any
a Any
b = Any
b Any -> Any -> Maybe Any
forall m. Reductive m => m -> m -> Maybe m
</> Any
a
instance RightReductive All where
isSuffixOf :: All -> All -> Bool
isSuffixOf All
a All
b = All
b All -> All -> Bool
forall a. Ord a => a -> a -> Bool
<= All
a
stripSuffix :: All -> All -> Maybe All
stripSuffix All
a All
b = All
b All -> All -> Maybe All
forall m. Reductive m => m -> m -> Maybe m
</> All
a

-- Identity & Const instances

instance Reductive a => Reductive (Identity a) where
Identity a
a </> :: Identity a -> Identity a -> Maybe (Identity a)
</> Identity a
b = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> Maybe a -> Maybe (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<\$> (a
a a -> a -> Maybe a
forall m. Reductive m => m -> m -> Maybe m
</> a
b)
instance Reductive a => Reductive (Const a x) where
Const a
a </> :: Const a x -> Const a x -> Maybe (Const a x)
</> Const a
b = a -> Const a x
forall {k} a (b :: k). a -> Const a b
Const (a -> Const a x) -> Maybe a -> Maybe (Const a x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<\$> (a
a a -> a -> Maybe a
forall m. Reductive m => m -> m -> Maybe m
</> a
b)

instance Cancellative a => Cancellative (Identity a)
instance Cancellative a => Cancellative (Const a x)

instance LeftReductive a => LeftReductive (Identity a) where
stripPrefix :: Identity a -> Identity a -> Maybe (Identity a)
stripPrefix (Identity a
a) (Identity a
b) = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> Maybe a -> Maybe (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<\$> a -> a -> Maybe a
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix a
a a
b
isPrefixOf :: Identity a -> Identity a -> Bool
isPrefixOf (Identity a
a) (Identity a
b) = a -> a -> Bool
forall m. LeftReductive m => m -> m -> Bool
isPrefixOf a
a a
b
instance LeftReductive a => LeftReductive (Const a x) where
stripPrefix :: Const a x -> Const a x -> Maybe (Const a x)
stripPrefix (Const a
a) (Const a
b) = a -> Const a x
forall {k} a (b :: k). a -> Const a b
Const (a -> Const a x) -> Maybe a -> Maybe (Const a x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<\$> a -> a -> Maybe a
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix a
a a
b
isPrefixOf :: Const a x -> Const a x -> Bool
isPrefixOf (Const a
a) (Const a
b) = a -> a -> Bool
forall m. LeftReductive m => m -> m -> Bool
isPrefixOf a
a a
b

instance RightReductive a => RightReductive (Identity a) where
stripSuffix :: Identity a -> Identity a -> Maybe (Identity a)
stripSuffix (Identity a
a) (Identity a
b) = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> Maybe a -> Maybe (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<\$> a -> a -> Maybe a
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix a
a a
b
isSuffixOf :: Identity a -> Identity a -> Bool
isSuffixOf (Identity a
a) (Identity a
b) = a -> a -> Bool
forall m. RightReductive m => m -> m -> Bool
isSuffixOf a
a a
b
instance RightReductive a => RightReductive (Const a x) where
stripSuffix :: Const a x -> Const a x -> Maybe (Const a x)
stripSuffix (Const a
a) (Const a
b) = a -> Const a x
forall {k} a (b :: k). a -> Const a b
Const (a -> Const a x) -> Maybe a -> Maybe (Const a x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<\$> a -> a -> Maybe a
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix a
a a
b
isSuffixOf :: Const a x -> Const a x -> Bool
isSuffixOf (Const a
a) (Const a
b) = a -> a -> Bool
forall m. RightReductive m => m -> m -> Bool
isSuffixOf a
a a
b

instance LeftCancellative a => LeftCancellative (Identity a)
instance LeftCancellative a => LeftCancellative (Const a x)

instance RightCancellative a => RightCancellative (Identity a)
instance RightCancellative a => RightCancellative (Const a x)

-- 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 a -> a -> Maybe a
forall m. Reductive m => m -> m -> Maybe m
</> a
c, b
b b -> b -> Maybe b
forall m. Reductive 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 (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 (a -> a -> Maybe a
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix a
a a
c, b -> b -> Maybe b
forall m. LeftReductive 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. LeftReductive m => m -> m -> Bool
isPrefixOf a
a a
c Bool -> Bool -> Bool
&& b -> b -> 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 (a -> a -> Maybe a
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix a
a a
c, b -> b -> Maybe b
forall m. RightReductive 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. RightReductive m => m -> m -> Bool
isSuffixOf a
a a
c Bool -> Bool -> Bool
&& b -> b -> 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) = (,,) (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. Reductive m => m -> m -> Maybe m
</> a
a2) Maybe (b -> c -> (a, b, c)) -> Maybe b -> Maybe (c -> (a, b, c))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (b
b1 b -> b -> Maybe b
forall m. Reductive m => m -> m -> Maybe m
</> b
b2) Maybe (c -> (a, b, c)) -> Maybe c -> Maybe (a, b, c)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (c
c1 c -> c -> Maybe c
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) = (,,) (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. LeftReductive m => m -> m -> Maybe m
stripPrefix a
a1 a
a2 Maybe (b -> c -> (a, b, c)) -> Maybe b -> Maybe (c -> (a, b, c))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> b -> Maybe b
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix b
b1 b
b2 Maybe (c -> (a, b, c)) -> Maybe c -> Maybe (a, b, c)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> c -> Maybe c
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) = a -> a -> Bool
forall m. LeftReductive m => m -> m -> Bool
isPrefixOf a
a1 a
a2 Bool -> Bool -> Bool
&& b -> b -> Bool
forall m. LeftReductive m => m -> m -> Bool
isPrefixOf b
b1 b
b2 Bool -> Bool -> Bool
&& c -> c -> 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) = (,,) (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. RightReductive m => m -> m -> Maybe m
stripSuffix a
a1 a
a2 Maybe (b -> c -> (a, b, c)) -> Maybe b -> Maybe (c -> (a, b, c))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> b -> Maybe b
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix b
b1 b
b2 Maybe (c -> (a, b, c)) -> Maybe c -> Maybe (a, b, c)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> c -> Maybe c
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) = a -> a -> Bool
forall m. RightReductive m => m -> m -> Bool
isSuffixOf a
a1 a
a2 Bool -> Bool -> Bool
&& b -> b -> Bool
forall m. RightReductive m => m -> m -> Bool
isSuffixOf b
b1 b
b2 Bool -> Bool -> Bool
&& c -> c -> 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) = (,,,) (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. Reductive 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 a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (b
b1 b -> b -> Maybe b
forall m. Reductive m => m -> m -> Maybe m
</> b
b2) Maybe (c -> d -> (a, b, c, d))
-> Maybe c -> Maybe (d -> (a, b, c, d))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (c
c1 c -> c -> Maybe c
forall m. Reductive m => m -> m -> Maybe m
</> c
c2) Maybe (d -> (a, b, c, d)) -> Maybe d -> Maybe (a, b, c, d)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (d
d1 d -> d -> Maybe d
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) =
(,,,) (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. LeftReductive 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 a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> b -> Maybe b
forall m. LeftReductive 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 a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> c -> Maybe c
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix c
c1 c
c2 Maybe (d -> (a, b, c, d)) -> Maybe d -> Maybe (a, b, c, d)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> d -> d -> Maybe d
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) =
a -> a -> Bool
forall m. LeftReductive m => m -> m -> Bool
isPrefixOf a
a1 a
a2 Bool -> Bool -> Bool
&& b -> b -> Bool
forall m. LeftReductive m => m -> m -> Bool
isPrefixOf b
b1 b
b2 Bool -> Bool -> Bool
&& c -> c -> Bool
forall m. LeftReductive m => m -> m -> Bool
isPrefixOf c
c1 c
c2 Bool -> Bool -> Bool
&& d -> d -> 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) =
(,,,) (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. RightReductive 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 a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> b -> Maybe b
forall m. RightReductive 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 a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> c -> Maybe c
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix c
c1 c
c2 Maybe (d -> (a, b, c, d)) -> Maybe d -> Maybe (a, b, c, d)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> d -> d -> Maybe d
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) =
a -> a -> Bool
forall m. RightReductive m => m -> m -> Bool
isSuffixOf a
a1 a
a2 Bool -> Bool -> Bool
&& b -> b -> Bool
forall m. RightReductive m => m -> m -> Bool
isSuffixOf b
b1 b
b2 Bool -> Bool -> Bool
&& c -> c -> Bool
forall m. RightReductive m => m -> m -> Bool
isSuffixOf c
c1 c
c2 Bool -> Bool -> Bool
&& d -> d -> 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 = x -> Maybe x
forall a. a -> Maybe a
Just (x -> Maybe x) -> Maybe x -> Maybe (Maybe x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<\$> x
x x -> x -> Maybe x
forall m. Reductive m => m -> m -> Maybe m
</> x
y
Maybe x
x </> Maybe x
Nothing = Maybe x -> Maybe (Maybe x)
forall a. a -> Maybe a
Just Maybe x
x
Maybe x
Nothing </> Maybe x
_ = Maybe (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 = 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 a b. (a -> b) -> Maybe a -> Maybe b
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. 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 = 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 a b. (a -> b) -> Maybe a -> Maybe b
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. 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 = 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. 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 = 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. 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 | 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

-- 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 IntSet -> IntSet -> Maybe IntSet
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 IntSet -> IntSet -> Maybe IntSet
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 = 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

-- 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 = Map k a -> Map k a -> Bool
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 | Map k a -> Map k a -> Bool
forall k a. (Ord k, Eq a) => Map k a -> Map k a -> Bool
Map.isSubmapOf 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

-- | /O(m+n)/
instance (Ord k, Eq a) => RightReductive (Map.Map k a) where
isSuffixOf :: Map k a -> Map k a -> Bool
isSuffixOf = (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 -> Bool) -> a -> a -> Bool
forall a b. a -> b -> a
const ((a -> Bool) -> a -> a -> Bool) -> (a -> Bool) -> a -> a -> Bool
forall a b. (a -> b) -> a -> b
\$ Bool -> a -> Bool
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 Map k a -> Map k a -> Bool
forall m. RightReductive m => m -> m -> Bool
`isSuffixOf` Map k a
b = Map k a -> Maybe (Map k a)
forall a. a -> Maybe a
Just ((a -> a -> Maybe a) -> Map k a -> Map k a -> Map k a
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
x) Map k a
b Map k a
a)
| Bool
otherwise = Maybe (Map k a)
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 = IntMap a -> IntMap a -> Bool
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 | IntMap a -> IntMap a -> Bool
forall a. Eq a => IntMap a -> IntMap a -> Bool
IntMap.isSubmapOf 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

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

-- List instances

-- | /O(prefixLength)/
instance Eq x => LeftReductive [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

-- | @since 1.0
-- /O(m+n)/
instance Eq x => RightReductive [x] where
isSuffixOf :: [x] -> [x] -> Bool
isSuffixOf = [x] -> [x] -> Bool
forall x. Eq x => [x] -> [x] -> Bool
List.isSuffixOf
stripSuffix :: [x] -> [x] -> Maybe [x]
stripSuffix [x]
xs0 [x]
ys0 = [x] -> [x] -> Maybe [x]
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 = ([x] -> [x]) -> [a] -> [x] -> Maybe [x]
forall {a} {a}. ([x] -> a) -> [a] -> [x] -> Maybe a
go2 [x] -> [x]
forall a. a -> a
id [a]
ys [x]
ys0
go1  [a]
_ [] = Maybe [x]
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 ([x] -> a) -> ([x] -> [x]) -> [x] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x
yx -> [x] -> [x]
forall a. a -> [a] -> [a]
:)) [a]
zs [x]
ys
go2 [x] -> a
fy [] [x]
ys
| [x]
xs0 [x] -> [x] -> Bool
forall a. Eq a => a -> a -> Bool
== [x]
ys = a -> Maybe a
forall a. a -> Maybe a
Just ([x] -> a
fy [])
| Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
go2 [x] -> a
_ [a]
_ [x]
_ = [Char] -> Maybe a
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 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) = Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Sequence.splitAt (Seq a -> Int
forall a. Seq a -> Int
Sequence.length Seq a
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 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) = Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Sequence.splitAt (Seq a -> Int
forall a. Seq a -> Int
Sequence.length Seq a
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Seq a -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Vector a -> Int
forall a. Vector a -> Int
Vector.length Vector a
l = Maybe (Vector a)
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
prefixLength = Vector a -> Maybe (Vector a)
forall a. a -> Maybe a
Just (Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
Vector.drop Int
prefixLength Vector a
l)
| Vector a
l Vector a -> Int -> a
forall a. Vector a -> Int -> a
Vector.! Int
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Vector a
p Vector a -> Int -> a
forall a. Vector a -> Int -> a
Vector.! Int
i = Int -> Maybe (Vector a)
strip (Int -> Int
forall a. Enum a => a -> a
succ Int
i)
| Bool
otherwise = Maybe (Vector a)
forall a. Maybe a
Nothing
prefixLength :: Int
prefixLength = Vector a -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Vector a -> Int
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
prefixLength = Bool
True
| Vector a
l Vector a -> Int -> a
forall a. Vector a -> Int -> a
Vector.! Int
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Vector a
p Vector a -> Int -> a
forall a. Vector a -> Int -> a
Vector.! Int
i = Int -> Bool
test (Int -> Int
forall a. Enum a => a -> a
succ Int
i)
| Bool
otherwise = Bool
False
prefixLength :: Int
prefixLength = Vector a -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Vector a -> Int
forall a. Vector a -> Int
Vector.length Vector a
l = Maybe (Vector a)
forall a. Maybe a
Nothing
| Bool
otherwise = Int -> Maybe (Vector a)
strip (Int -> Int
forall a. Enum a => a -> a
pred Int
suffixLength)
where strip :: Int -> Maybe (Vector a)
strip Int
i | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 = Vector a -> Maybe (Vector a)
forall a. a -> Maybe a
Just (Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
Vector.take Int
lengthDifference Vector a
l)
| Vector a
l Vector a -> Int -> a
forall a. Vector a -> Int -> a
Vector.! (Int
lengthDifference Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Vector a
s Vector a -> Int -> a
forall a. Vector a -> Int -> a
Vector.! Int
i = Int -> Maybe (Vector a)
strip (Int -> Int
forall a. Enum a => a -> a
pred Int
i)
| Bool
otherwise = Maybe (Vector a)
forall a. Maybe a
Nothing
suffixLength :: Int
suffixLength = Vector a -> Int
forall a. Vector a -> Int
Vector.length Vector a
s
lengthDifference :: Int
lengthDifference = Vector a -> Int
forall a. Vector a -> Int
Vector.length Vector a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
suffixLength
isSuffixOf :: Vector a -> Vector a -> Bool
isSuffixOf Vector a
s Vector a
l | Int
suffixLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Vector a -> Int
forall a. Vector a -> Int
Vector.length Vector a
l = Bool
False
| Bool
otherwise = Int -> Bool
test (Int -> Int
forall a. Enum a => a -> a
pred Int
suffixLength)
where test :: Int -> Bool
test Int
i | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 = Bool
True
| Vector a
l Vector a -> Int -> a
forall a. Vector a -> Int -> a
Vector.! (Int
lengthDifference Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Vector a
s Vector a -> Int -> a
forall a. Vector a -> Int -> a
Vector.! Int
i = Int -> Bool
test (Int -> Int
forall a. Enum a => a -> a
pred Int
i)
| Bool
otherwise = Bool
False
suffixLength :: Int
suffixLength = Vector a -> Int
forall a. Vector a -> Int
Vector.length Vector a
s
lengthDifference :: Int
lengthDifference = Vector a -> Int
forall a. Vector a -> Int
Vector.length Vector a
l Int -> Int -> Int
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 ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
ByteString.unsafeDrop (ByteString -> Int
ByteString.length ByteString
p) ByteString
l)
else Maybe ByteString
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 ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
ByteString.unsafeTake (ByteString -> Int
ByteString.length ByteString
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
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 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 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

-- | /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 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 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
```