{- 
    Copyright 2013-2019 Mario Blazevic

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

-- | This module defines the 'GCDMonoid' subclass of the 'Monoid' class.
--
-- 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.
--
-- The 'GCDMonoid' class is for Abelian, /i.e./, 'Commutative' monoids. Since most practical monoids in Haskell are not
-- Abelian, there are also its three symmetric superclasses:
-- 
-- * 'LeftGCDMonoid'
-- 
-- * 'RightGCDMonoid'
-- 
-- * 'OverlappingGCDMonoid'

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

module Data.Monoid.GCD (
   GCDMonoid(..),
   LeftGCDMonoid(..), RightGCDMonoid(..), OverlappingGCDMonoid(..)
   )
where

import qualified Prelude

import Data.Monoid -- (Monoid, Dual(..), Sum(..), Product(..))
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.Encoding as TextEncoding
import qualified Data.Text.Internal as Internal
import qualified Data.Text.Internal.Lazy as LazyInternal
import           Data.Text.Unsafe (reverseIter)
#if MIN_VERSION_text(2,0,0)
import           Data.Text.Unsafe (Iter(..))
#endif
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Encoding as LazyEncoding
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 Numeric.Natural (Natural)

import Data.Semigroup.Cancellative
import Data.Monoid.Monus

import Prelude hiding (gcd)

-- | Class of Abelian monoids that allow the greatest common divisor 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 'Cancellative', 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 (Monoid m, Commutative m, Reductive m, LeftGCDMonoid m, RightGCDMonoid m, OverlappingGCDMonoid m) => GCDMonoid m where
   gcd :: m -> m -> m

-- | Class of monoids capable of finding the equivalent of greatest common divisor on the left side of two monoidal
-- values. 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
--
-- Furthermore, 'commonPrefix' must return the unique greatest common prefix that contains, as its prefix, any other
-- prefix @x@ of both values:
--
-- > not (x `isPrefixOf` a && x `isPrefixOf` b) || x `isPrefixOf` commonPrefix a b
--
-- and it cannot itself be a suffix of any other common prefix @y@ of both values:
--
-- > not (y `isPrefixOf` a && y `isPrefixOf` b && commonPrefix a b `isSuffixOf` y)
class (Monoid m, LeftReductive 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
_) = 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 = forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix m
x m
y
            Just m
x' = forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix m
p m
x
            Just m
y' = forall m. LeftReductive 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 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
--
-- Furthermore, 'commonSuffix' must return the unique greatest common suffix that contains, as its suffix, any other
-- suffix @x@ of both values:
--
-- > not (x `isSuffixOf` a && x `isSuffixOf` b) || x `isSuffixOf` commonSuffix a b
--
-- and it cannot itself be a prefix of any other common suffix @y@ of both values:
--
-- > not (y `isSuffixOf` a && y `isSuffixOf` b && commonSuffix a b `isPrefixOf` y)
class (Monoid m, RightReductive 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) = 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 = forall m. RightGCDMonoid m => m -> m -> m
commonSuffix m
x m
y
            Just m
x' = forall m. RightReductive m => m -> m -> Maybe m
stripSuffix m
s m
x
            Just m
y' = forall m. RightReductive m => m -> m -> Maybe m
stripSuffix m
s m
y
   {-# MINIMAL commonSuffix | stripCommonSuffix #-}

-- Unit instances

-- | /O(1)/
instance GCDMonoid () where
   gcd :: () -> () -> ()
gcd () () = ()

-- | /O(1)/
instance LeftGCDMonoid () where
   commonPrefix :: () -> () -> ()
commonPrefix () () = ()

-- | /O(1)/
instance RightGCDMonoid () where
   commonSuffix :: () -> () -> ()
commonSuffix () () = ()

-- Dual instances

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

instance LeftGCDMonoid a => RightGCDMonoid (Dual a) where
   commonSuffix :: Dual a -> Dual a -> Dual a
commonSuffix (Dual a
a) (Dual a
b) = forall a. a -> Dual a
Dual (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) = forall a. a -> Dual a
Dual (forall m. RightGCDMonoid m => m -> m -> m
commonSuffix a
a a
b)

-- Sum instances

-- | /O(1)/
instance GCDMonoid (Sum Natural) where
   gcd :: Sum Natural -> Sum Natural -> Sum Natural
gcd (Sum Natural
a) (Sum Natural
b) = forall a. a -> Sum a
Sum (forall a. Ord a => a -> a -> a
min Natural
a Natural
b)

-- | /O(1)/
instance LeftGCDMonoid (Sum Natural) where
   commonPrefix :: Sum Natural -> Sum Natural -> Sum Natural
commonPrefix Sum Natural
a Sum Natural
b = forall m. GCDMonoid m => m -> m -> m
gcd Sum Natural
a Sum Natural
b

-- | /O(1)/
instance RightGCDMonoid (Sum Natural) where
   commonSuffix :: Sum Natural -> Sum Natural -> Sum Natural
commonSuffix Sum Natural
a Sum Natural
b = forall m. GCDMonoid m => m -> m -> m
gcd Sum Natural
a Sum Natural
b

-- Product instances

-- | /O(1)/
instance GCDMonoid (Product Natural) where
   gcd :: Product Natural -> Product Natural -> Product Natural
gcd (Product Natural
a) (Product Natural
b) = forall a. a -> Product a
Product (forall a. Integral a => a -> a -> a
Prelude.gcd Natural
a Natural
b)

-- | /O(1)/
instance LeftGCDMonoid (Product Natural) where
   commonPrefix :: Product Natural -> Product Natural -> Product Natural
commonPrefix Product Natural
a Product Natural
b = forall m. GCDMonoid m => m -> m -> m
gcd Product Natural
a Product Natural
b

-- | /O(1)/
instance RightGCDMonoid (Product Natural) where
   commonSuffix :: Product Natural -> Product Natural -> Product Natural
commonSuffix Product Natural
a Product Natural
b = forall m. GCDMonoid m => m -> m -> m
gcd Product Natural
a Product Natural
b

-- Pair instances

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) = (forall m. GCDMonoid m => m -> m -> m
gcd a
a a
c, forall m. GCDMonoid m => m -> m -> m
gcd b
b b
d)

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) = (forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix a
a a
c, 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) = (forall m. RightGCDMonoid m => m -> m -> m
commonSuffix a
a a
c, forall m. RightGCDMonoid m => m -> m -> m
commonSuffix b
b b
d)

-- Triple instances

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) = (forall m. GCDMonoid m => m -> m -> m
gcd a
a1 a
a2, forall m. GCDMonoid m => m -> m -> m
gcd b
b1 b
b2, forall m. GCDMonoid m => m -> m -> m
gcd c
c1 c
c2)

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) = (forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix a
a1 a
a2, forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix b
b1 b
b2, 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) = (forall m. RightGCDMonoid m => m -> m -> m
commonSuffix a
a1 a
a2, forall m. RightGCDMonoid m => m -> m -> m
commonSuffix b
b1 b
b2, forall m. RightGCDMonoid m => m -> m -> m
commonSuffix c
c1 c
c2)

-- Quadruple instances

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) = (forall m. GCDMonoid m => m -> m -> m
gcd a
a1 a
a2, forall m. GCDMonoid m => m -> m -> m
gcd b
b1 b
b2, forall m. GCDMonoid m => m -> m -> m
gcd c
c1 c
c2, forall m. GCDMonoid m => m -> m -> m
gcd d
d1 d
d2)

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) =
      (forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix a
a1 a
a2, forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix b
b1 b
b2, forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix c
c1 c
c2, 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) =
      (forall m. RightGCDMonoid m => m -> m -> m
commonSuffix a
a1 a
a2, forall m. RightGCDMonoid m => m -> m -> m
commonSuffix b
b1 b
b2, forall m. RightGCDMonoid m => m -> m -> m
commonSuffix c
c1 c
c2, forall m. RightGCDMonoid m => m -> m -> m
commonSuffix d
d1 d
d2)

-- Maybe instances

instance LeftGCDMonoid x => LeftGCDMonoid (Maybe x) where
   commonPrefix :: Maybe x -> Maybe x -> Maybe x
commonPrefix (Just x
x) (Just x
y) = forall a. a -> Maybe a
Just (forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix x
x x
y)
   commonPrefix 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) = (forall a. a -> Maybe a
Just x
p, forall a. a -> Maybe a
Just x
x', forall a. a -> Maybe a
Just x
y')
      where (x
p, x
x', x
y') = forall m. LeftGCDMonoid m => m -> m -> (m, m, m)
stripCommonPrefix x
x x
y
   stripCommonPrefix Maybe x
x Maybe x
y = (forall a. Maybe a
Nothing, Maybe x
x, Maybe x
y)

instance RightGCDMonoid x => RightGCDMonoid (Maybe x) where
   commonSuffix :: Maybe x -> Maybe x -> Maybe x
commonSuffix (Just x
x) (Just x
y) = forall a. a -> Maybe a
Just (forall m. RightGCDMonoid m => m -> m -> m
commonSuffix x
x x
y)
   commonSuffix 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) = (forall a. a -> Maybe a
Just x
x', forall a. a -> Maybe a
Just x
y', forall a. a -> Maybe a
Just x
s)
      where (x
x', x
y', x
s) = 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, forall a. Maybe a
Nothing)

-- Set instances

-- | /O(m*log(n\/m + 1)), m <= n/
instance Ord a => LeftGCDMonoid (Set.Set a) where
   commonPrefix :: Set a -> Set a -> Set a
commonPrefix = forall a. Ord a => Set a -> Set a -> Set a
Set.intersection

-- | /O(m*log(n\/m + 1)), m <= n/
instance Ord a => RightGCDMonoid (Set.Set a) where
   commonSuffix :: Set a -> Set a -> Set a
commonSuffix = forall a. Ord a => Set a -> Set a -> Set a
Set.intersection

-- | /O(m*log(n\/m + 1)), m <= n/
instance Ord a => GCDMonoid (Set.Set a) where
   gcd :: Set a -> Set a -> Set a
gcd = forall a. Ord a => Set a -> Set a -> Set a
Set.intersection

-- IntSet instances

-- | /O(m+n)/
instance LeftGCDMonoid IntSet.IntSet where
   commonPrefix :: IntSet -> IntSet -> IntSet
commonPrefix = IntSet -> IntSet -> IntSet
IntSet.intersection

-- | /O(m+n)/
instance RightGCDMonoid IntSet.IntSet where
   commonSuffix :: IntSet -> IntSet -> IntSet
commonSuffix = IntSet -> IntSet -> IntSet
IntSet.intersection

-- | /O(m+n)/
instance GCDMonoid IntSet.IntSet where
   gcd :: IntSet -> IntSet -> IntSet
gcd = IntSet -> IntSet -> IntSet
IntSet.intersection

-- Map instances

-- | /O(m+n)/
instance (Ord k, Eq a) => LeftGCDMonoid (Map.Map k a) where
   commonPrefix :: Map k a -> Map k a -> Map k a
commonPrefix = 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 forall a. Eq a => a -> a -> Bool
== a
b then forall a. a -> Maybe a
Just a
a else forall a. Maybe a
Nothing) (forall a b. a -> b -> a
const forall k a. Map k a
Map.empty) (forall a b. a -> b -> a
const forall k a. Map k a
Map.empty)

-- IntMap instances

-- | /O(m+n)/
instance Eq a => LeftGCDMonoid (IntMap.IntMap a) where
   commonPrefix :: IntMap a -> IntMap a -> IntMap a
commonPrefix = 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 forall a. Eq a => a -> a -> Bool
== a
b then forall a. a -> Maybe a
Just a
a else forall a. Maybe a
Nothing)
                                       (forall a b. a -> b -> a
const forall a. IntMap a
IntMap.empty) (forall a b. a -> b -> a
const forall a. IntMap a
IntMap.empty)

-- List instances

-- | /O(prefixLength)/
instance Eq x => LeftGCDMonoid [x] where
   commonPrefix :: [x] -> [x] -> [x]
commonPrefix (x
x:[x]
xs) (x
y:[x]
ys) | x
x forall a. Eq a => a -> a -> Bool
== x
y = x
x forall a. a -> [a] -> [a]
: 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 = forall {a} {a}. Eq a => ([a] -> a) -> [a] -> [a] -> (a, [a], [a])
strip' 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 forall a. Eq a => a -> a -> Bool
== a
y = ([a] -> a) -> [a] -> [a] -> (a, [a], [a])
strip' ([a] -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
x forall a. a -> [a] -> [a]
:)) [a]
xs [a]
ys
            strip' [a] -> a
f [a]
x [a]
y = ([a] -> a
f [], [a]
x, [a]
y)

-- | @since 1.0
-- /O(m+n)/
instance Eq x => RightGCDMonoid [x] where
   stripCommonSuffix :: [x] -> [x] -> ([x], [x], [x])
stripCommonSuffix [x]
x0 [x]
y0 = forall {a} {a}. [a] -> [a] -> ([x], [x], [x])
go1 [x]
x0 [x]
y0
      where go1 :: [a] -> [a] -> ([x], [x], [x])
go1 (a
_:[a]
xs) (a
_:[a]
ys) = [a] -> [a] -> ([x], [x], [x])
go1 [a]
xs [a]
ys
            go1 [] [] = forall {a} {a} {b}.
Eq a =>
([a] -> a)
-> ([a] -> b) -> ([a] -> [a]) -> [a] -> [a] -> (a, b, [a])
go2 forall a. a -> a
id forall a. a -> a
id forall a. a -> a
id [x]
x0 [x]
y0
            go1 [] [a]
ys = forall {a} {a} {b}.
Eq a =>
([a] -> a)
-> ([a] -> b) -> ([a] -> [a]) -> [a] -> [a] -> (a, b, [a])
go2 forall a. a -> a
id [x] -> [x]
yp forall a. a -> a
id [x]
x0 [x]
yr
               where ([x] -> [x]
yp, [x]
yr) = forall {a} {c} {a}. ([a] -> c) -> [a] -> [a] -> ([a] -> c, [a])
splitAtLengthOf forall a. a -> a
id [a]
ys [x]
y0
            go1 [a]
xs [] = forall {a} {a} {b}.
Eq a =>
([a] -> a)
-> ([a] -> b) -> ([a] -> [a]) -> [a] -> [a] -> (a, b, [a])
go2 [x] -> [x]
xp forall a. a -> a
id forall a. a -> a
id [x]
xr [x]
y0
               where ([x] -> [x]
xp, [x]
xr) = forall {a} {c} {a}. ([a] -> c) -> [a] -> [a] -> ([a] -> c, [a])
splitAtLengthOf forall a. a -> a
id [a]
xs [x]
x0
            go2 :: ([a] -> a)
-> ([a] -> b) -> ([a] -> [a]) -> [a] -> [a] -> (a, b, [a])
go2 [a] -> a
xp [a] -> b
yp [a] -> [a]
cs [] [] = ([a] -> a
xp [], [a] -> b
yp [], [a] -> [a]
cs [])
            go2 [a] -> a
xp [a] -> b
yp [a] -> [a]
cs (a
x:[a]
xs) (a
y:[a]
ys)
               | a
x forall a. Eq a => a -> a -> Bool
== a
y = ([a] -> a)
-> ([a] -> b) -> ([a] -> [a]) -> [a] -> [a] -> (a, b, [a])
go2 [a] -> a
xp [a] -> b
yp ([a] -> [a]
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xforall a. a -> [a] -> [a]
:)) [a]
xs [a]
ys
               | Bool
otherwise = ([a] -> a)
-> ([a] -> b) -> ([a] -> [a]) -> [a] -> [a] -> (a, b, [a])
go2 ([a] -> a
xp forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xforall a. a -> [a] -> [a]
:)) ([a] -> b
yp forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
yforall a. a -> [a] -> [a]
:)) forall a. a -> a
id [a]
xs [a]
ys
            go2 [a] -> a
_ [a] -> b
_ [a] -> [a]
_ [a]
_ [a]
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"
            splitAtLengthOf :: ([a] -> c) -> [a] -> [a] -> ([a] -> c, [a])
splitAtLengthOf [a] -> c
yp (a
_:[a]
xs) (a
y:[a]
ys) = ([a] -> c) -> [a] -> [a] -> ([a] -> c, [a])
splitAtLengthOf ([a] -> c
yp forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
yforall a. a -> [a] -> [a]
:)) [a]
xs [a]
ys
            splitAtLengthOf [a] -> c
yp [] [a]
ys = ([a] -> c
yp, [a]
ys)
            splitAtLengthOf [a] -> c
_ [a]
_ [a]
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

-- Seq instances

-- | /O(prefixLength)/
instance Eq a => LeftGCDMonoid (Sequence.Seq a) where
   stripCommonPrefix :: Seq a -> Seq a -> (Seq a, Seq a, Seq a)
stripCommonPrefix = forall {a}.
Eq a =>
Seq a -> Seq a -> Seq a -> (Seq a, Seq a, Seq a)
findCommonPrefix 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 (forall a. Seq a -> ViewL a
Sequence.viewl Seq a
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 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 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)

-- | /O(suffixLength)/
instance Eq a => RightGCDMonoid (Sequence.Seq a) where
   stripCommonSuffix :: Seq a -> Seq a -> (Seq a, Seq a, Seq a)
stripCommonSuffix = forall {a}.
Eq a =>
Seq a -> Seq a -> Seq a -> (Seq a, Seq a, Seq a)
findCommonSuffix 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 (forall a. Seq a -> ViewR a
Sequence.viewr Seq a
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 forall a. Eq a => a -> a -> Bool
== a
b1 -> Seq a -> Seq a -> Seq a -> (Seq a, Seq a, Seq a)
findCommonSuffix (a
a1 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

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

-- | /O(suffixLength)/
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 (forall a. Vector a -> Key
Vector.length Vector a
x forall a. Num a => a -> a -> a
- Key
1) (forall a. Vector a -> Key
Vector.length Vector a
y 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 forall a. Ord a => a -> a -> Bool
>= Key
0 Bool -> Bool -> Bool
&& Key
n forall a. Ord a => a -> a -> Bool
>= Key
0 Bool -> Bool -> Bool
&& Vector a
x forall a. Vector a -> Key -> a
Vector.! Key
m forall a. Eq a => a -> a -> Bool
== Vector a
y forall a. Vector a -> Key -> a
Vector.! Key
n =
               Key -> Key -> (Vector a, Vector a, Vector a)
findSuffix (forall a. Enum a => a -> a
pred Key
m) (forall a. Enum a => a -> a
pred Key
n)
            findSuffix Key
m Key
n = (forall a. Key -> Vector a -> Vector a
Vector.take (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) = forall a. Key -> Vector a -> (Vector a, Vector a)
Vector.splitAt (forall a. Enum a => a -> a
succ Key
n) Vector a
y

-- ByteString instances

-- | /O(prefixLength)/
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 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 forall a. Ord a => a -> a -> Bool
< Key
len,
                                 ByteString -> Key -> Word8
ByteString.unsafeIndex ByteString
x Key
n forall a. Eq a => a -> a -> Bool
== ByteString -> Key -> Word8
ByteString.unsafeIndex ByteString
y Key
n =
                                    Key -> Key -> Key
prefixLength (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

-- | /O(suffixLength)/
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 forall a. Num a => a -> a -> a
- Key
1) (ByteString -> Key
ByteString.length ByteString
y forall a. Num a => a -> a -> a
- Key
1)
      where findSuffix :: Key -> Key -> (ByteString, ByteString, ByteString)
findSuffix Key
m Key
n | Key
m forall a. Ord a => a -> a -> Bool
>= Key
0, Key
n forall a. Ord a => a -> a -> Bool
>= Key
0,
                             ByteString -> Key -> Word8
ByteString.unsafeIndex ByteString
x Key
m forall a. Eq a => a -> a -> Bool
== ByteString -> Key -> Word8
ByteString.unsafeIndex ByteString
y Key
n =
                                Key -> Key -> (ByteString, ByteString, ByteString)
findSuffix (forall a. Enum a => a -> a
pred Key
m) (forall a. Enum a => a -> a
pred Key
n)
                           | Bool
otherwise = let (ByteString
yp, ByteString
ys) = Key -> ByteString -> (ByteString, ByteString)
ByteString.splitAt (forall a. Enum a => a -> a
succ Key
n) ByteString
y
                                         in (Key -> ByteString -> ByteString
ByteString.unsafeTake (forall a. Enum a => a -> a
succ Key
m) ByteString
x, ByteString
yp, ByteString
ys)

-- Lazy ByteString instances

-- | /O(prefixLength)/
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 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 forall a. Ord a => a -> a -> Bool
< Int64
len Bool -> Bool -> Bool
&& HasCallStack => ByteString -> Int64 -> Word8
LazyByteString.index ByteString
x Int64
n forall a. Eq a => a -> a -> Bool
== HasCallStack => ByteString -> Int64 -> Word8
LazyByteString.index ByteString
y Int64
n =
               Int64 -> Int64 -> Int64
prefixLength (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

-- | /O(suffixLength)/
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 forall a. Num a => a -> a -> a
- Int64
1) (ByteString -> Int64
LazyByteString.length ByteString
y forall a. Num a => a -> a -> a
- Int64
1)
      where findSuffix :: Int64 -> Int64 -> (ByteString, ByteString, ByteString)
findSuffix Int64
m Int64
n | Int64
m forall a. Ord a => a -> a -> Bool
>= Int64
0 Bool -> Bool -> Bool
&& Int64
n forall a. Ord a => a -> a -> Bool
>= Int64
0 Bool -> Bool -> Bool
&& HasCallStack => ByteString -> Int64 -> Word8
LazyByteString.index ByteString
x Int64
m forall a. Eq a => a -> a -> Bool
== HasCallStack => ByteString -> Int64 -> Word8
LazyByteString.index ByteString
y Int64
n =
               Int64 -> Int64 -> (ByteString, ByteString, ByteString)
findSuffix (forall a. Enum a => a -> a
pred Int64
m) (forall a. Enum a => a -> a
pred Int64
n)
            findSuffix Int64
m Int64
n = (Int64 -> ByteString -> ByteString
LazyByteString.take (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 (forall a. Enum a => a -> a
succ Int64
n) ByteString
y

-- Text instances

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

-- | @since 1.0
-- /O(suffixLength)/, except on GHCjs where it is /O(m+n)/
instance RightGCDMonoid Text.Text where
#if !ghcjs_HOST_OS
  stripCommonSuffix :: Text -> Text -> (Text, Text, Text)
stripCommonSuffix x :: Text
x@(Internal.Text Array
xarr Key
xoff Key
xlen) y :: Text
y@(Internal.Text Array
yarr Key
yoff Key
ylen) = Key -> Key -> (Text, Text, Text)
go (forall a. Enum a => a -> a
pred Key
xlen) (forall a. Enum a => a -> a
pred Key
ylen)
      where go :: Key -> Key -> (Text, Text, Text)
go Key
i Key
j | Key
i forall a. Ord a => a -> a -> Bool
>= Key
0 Bool -> Bool -> Bool
&& Key
j forall a. Ord a => a -> a -> Bool
>= Key
0 Bool -> Bool -> Bool
&& Char
xc forall a. Eq a => a -> a -> Bool
== Char
yc = Key -> Key -> (Text, Text, Text)
go (Key
iforall a. Num a => a -> a -> a
+Key
xd) (Key
jforall a. Num a => a -> a -> a
+Key
yd)
                   | Bool
otherwise = (Array -> Key -> Key -> Text
Internal.text Array
xarr Key
xoff (forall a. Enum a => a -> a
succ Key
i),
                                  Array -> Key -> Key -> Text
Internal.text Array
yarr Key
yoff (forall a. Enum a => a -> a
succ Key
j),
                                  Array -> Key -> Key -> Text
Internal.text Array
xarr (Key
xoffforall a. Num a => a -> a -> a
+Key
iforall a. Num a => a -> a -> a
+Key
1) (Key
xlenforall a. Num a => a -> a -> a
-Key
iforall a. Num a => a -> a -> a
-Key
1))
#if MIN_VERSION_text(2,0,0)
               where Iter xc xd = reverseIter x i
                     Iter yc yd = reverseIter y j
#else
               where (Char
xc, Key
xd) = Text -> Key -> (Char, Key)
reverseIter Text
x Key
i
                     (Char
yc, Key
yd) = Text -> Key -> (Char, Key)
reverseIter Text
y Key
j
#endif
#else
  stripCommonSuffix x y =
    let (xlist, ylist, slist) =
          stripCommonSuffix (TextEncoding.encodeUtf8 x) (TextEncoding.encodeUtf8 y)
    in (TextEncoding.decodeUtf8 xlist, TextEncoding.decodeUtf8 ylist, TextEncoding.decodeUtf8 slist)
#endif

-- Lazy Text instances

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

-- | @since 1.0
-- /O(m+n)/
instance RightGCDMonoid LazyText.Text where
#if !ghcjs_HOST_OS
   stripCommonSuffix :: Text -> Text -> (Text, Text, Text)
stripCommonSuffix Text
x0 Text
y0
      | Key
x0len forall a. Ord a => a -> a -> Bool
< Key
y0len = forall {a} {b}.
(Text -> a)
-> (Text -> b) -> (Text -> Text) -> Text -> Text -> (a, b, Text)
go forall a. a -> a
id Text -> Text
y0p forall a. a -> a
id Text
x0 Text
y0s
      | Key
x0len forall a. Ord a => a -> a -> Bool
> Key
y0len = forall {a} {b}.
(Text -> a)
-> (Text -> b) -> (Text -> Text) -> Text -> Text -> (a, b, Text)
go Text -> Text
x0p forall a. a -> a
id forall a. a -> a
id Text
x0s Text
y0
      | Bool
otherwise = forall {a} {b}.
(Text -> a)
-> (Text -> b) -> (Text -> Text) -> Text -> Text -> (a, b, Text)
go forall a. a -> a
id forall a. a -> a
id forall a. a -> a
id Text
x0 Text
y0
      where (Text -> Text
y0p, Text
y0s) = forall {c}. (Text -> c) -> Key -> Text -> (Text -> c, Text)
splitWord16 forall a. a -> a
id (Key
y0len forall a. Num a => a -> a -> a
- Key
x0len) Text
y0
            (Text -> Text
x0p, Text
x0s) = forall {c}. (Text -> c) -> Key -> Text -> (Text -> c, Text)
splitWord16 forall a. a -> a
id (Key
x0len forall a. Num a => a -> a -> a
- Key
y0len) Text
x0
            x0len :: Key
x0len = Text -> Key
lazyLengthWord16 Text
x0
            y0len :: Key
y0len = Text -> Key
lazyLengthWord16 Text
y0
            lazyLengthWord16 :: Text -> Key
lazyLengthWord16 = forall a. (a -> Text -> a) -> a -> Text -> a
LazyText.foldlChunks Key -> Text -> Key
addLength Key
0
            addLength :: Key -> Text -> Key
addLength Key
n Text
x = Key
n forall a. Num a => a -> a -> a
+ (\(Internal.Text Array
_ Key
_ Key
l) -> Key
l) Text
x
            splitWord16 :: (Text -> c) -> Key -> Text -> (Text -> c, Text)
splitWord16 Text -> c
xp Key
0 Text
x = (Text -> c
xp, Text
x)
            splitWord16 Text -> c
xp Key
n (LazyInternal.Chunk x :: Text
x@(Internal.Text Array
arr Key
off Key
len) Text
xs)
               | Key
n forall a. Ord a => a -> a -> Bool
< Key
len = (Text -> c
xp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
LazyInternal.chunk (Array -> Key -> Key -> Text
Internal.Text Array
arr Key
off Key
n),
                            Text -> Text -> Text
LazyInternal.chunk (Array -> Key -> Key -> Text
Internal.Text Array
arr (Key
offforall a. Num a => a -> a -> a
+Key
n) (Key
lenforall a. Num a => a -> a -> a
-Key
n)) Text
xs)
               | Bool
otherwise = (Text -> c) -> Key -> Text -> (Text -> c, Text)
splitWord16 (Text -> c
xp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
LazyInternal.chunk Text
x) (Key
n forall a. Num a => a -> a -> a
- Key
len) Text
xs
            splitWord16 Text -> c
_ Key
_ Text
LazyInternal.Empty = forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"
            go :: (Text -> a)
-> (Text -> b) -> (Text -> Text) -> Text -> Text -> (a, b, Text)
go Text -> a
xp Text -> b
yp Text -> Text
cs Text
LazyInternal.Empty Text
LazyInternal.Empty = (Text -> a
xp forall a. Monoid a => a
mempty, Text -> b
yp forall a. Monoid a => a
mempty, Text -> Text
cs forall a. Monoid a => a
mempty)
            go Text -> a
xp Text -> b
yp Text -> Text
cs (LazyInternal.Chunk x :: Text
x@(Internal.Text Array
xarr Key
xoff Key
xlen) Text
xs)
                        (LazyInternal.Chunk y :: Text
y@(Internal.Text Array
yarr Key
yoff Key
ylen) Text
ys)
               | Key
xlen forall a. Ord a => a -> a -> Bool
< Key
ylen = (Text -> a)
-> (Text -> b) -> (Text -> Text) -> Text -> Text -> (a, b, Text)
go Text -> a
xp Text -> b
yp Text -> Text
cs (Text -> Text -> Text
LazyInternal.Chunk Text
x Text
xs)
                                           (Text -> Text -> Text
LazyInternal.Chunk (Array -> Key -> Key -> Text
Internal.Text Array
yarr Key
yoff Key
xlen) forall a b. (a -> b) -> a -> b
$
                                            Text -> Text -> Text
LazyInternal.Chunk (Array -> Key -> Key -> Text
Internal.Text Array
yarr (Key
yoffforall a. Num a => a -> a -> a
+Key
xlen) (Key
ylenforall a. Num a => a -> a -> a
-Key
xlen)) Text
ys)
               | Key
xlen forall a. Ord a => a -> a -> Bool
> Key
ylen = (Text -> a)
-> (Text -> b) -> (Text -> Text) -> Text -> Text -> (a, b, Text)
go Text -> a
xp Text -> b
yp Text -> Text
cs (Text -> Text -> Text
LazyInternal.Chunk (Array -> Key -> Key -> Text
Internal.Text Array
xarr Key
xoff Key
ylen) forall a b. (a -> b) -> a -> b
$
                                            Text -> Text -> Text
LazyInternal.Chunk (Array -> Key -> Key -> Text
Internal.Text Array
xarr (Key
xoffforall a. Num a => a -> a -> a
+Key
ylen) (Key
xlenforall a. Num a => a -> a -> a
-Key
ylen)) Text
xs)
                                           (Text -> Text -> Text
LazyInternal.Chunk Text
y Text
ys)
               | Text
x forall a. Eq a => a -> a -> Bool
== Text
y = (Text -> a)
-> (Text -> b) -> (Text -> Text) -> Text -> Text -> (a, b, Text)
go Text -> a
xp Text -> b
yp (Text -> Text
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
LazyInternal.chunk Text
x) Text
xs Text
ys
               | (Text
x1p, Text
y1p, Text
c1s) <- forall m. RightGCDMonoid m => m -> m -> (m, m, m)
stripCommonSuffix Text
x Text
y =
                    (Text -> a)
-> (Text -> b) -> (Text -> Text) -> Text -> Text -> (a, b, Text)
go (Text -> a
xp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
LazyInternal.chunk Text
x1p) (Text -> b
yp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
LazyInternal.chunk Text
y1p) (Text -> Text -> Text
LazyInternal.chunk Text
c1s) Text
xs Text
ys
            go Text -> a
_ Text -> b
_ Text -> Text
_ Text
_ Text
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"
#else
  stripCommonSuffix x y =
    let (xlist, ylist, slist) =
          stripCommonSuffix (LazyEncoding.encodeUtf8 x) (LazyEncoding.encodeUtf8 y)
    in (LazyEncoding.decodeUtf8 xlist, LazyEncoding.decodeUtf8 ylist, LazyEncoding.decodeUtf8 slist)
#endif