{- 
    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.
--
-- == Non-commutative GCD monoids
--
--  Since most practical monoids in Haskell are not Abelian, the 'GCDMonoid'
--  class has three symmetric superclasses:
--
-- * 'LeftGCDMonoid'
--
--      Class of monoids for which it is possible to find the greatest common
--      /prefix/ of two monoidal values.
--
-- * 'RightGCDMonoid'
--
--      Class of monoids for which it is possible to find the greatest common
--      /suffix/ of two monoidal values.
--
-- * 'OverlappingGCDMonoid'
--
--      Class of monoids for which it is possible to find the greatest common
--      /overlap/ of two monoidal values.
--
-- == Distributive GCD monoids
--
-- Since some (but not all) GCD monoids are also distributive, there are three
-- subclasses that add distributivity:
--
-- * 'DistributiveGCDMonoid'
--
--     Subclass of 'GCDMonoid' with /symmetric/ distributivity.
--
-- * 'LeftDistributiveGCDMonoid'
--
--     Subclass of 'LeftGCDMonoid' with /left/-distributivity.
--
-- * 'RightDistributiveGCDMonoid'
--
--     Subclass of 'RightGCDMonoid' with /right/-distributivity.
--
{-# LANGUAGE CPP, Haskell2010, FlexibleInstances, Trustworthy #-}

module Data.Monoid.GCD
    ( GCDMonoid (..)
    , LeftGCDMonoid (..)
    , RightGCDMonoid (..)
    , OverlappingGCDMonoid (..)
    , DistributiveGCDMonoid
    , LeftDistributiveGCDMonoid
    , RightDistributiveGCDMonoid
    )
    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

-- These imports are marked as redundant, but are actually required by haddock:
import Data.Maybe (isJust)

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
--
-- In addition, the 'gcd' operation must satisfy the following properties:
--
-- __/Uniqueness/__
--
-- @
-- 'all' 'isJust'
--     [ a '</>' c
--     , b '</>' c
--     , c '</>' 'gcd' a b
--     ]
-- ==>
--     (c '==' 'gcd' a b)
-- @
--
-- __/Idempotence/__
--
-- @
-- 'gcd' a a '==' a
-- @
--
-- __/Identity/__
--
-- @
-- 'gcd' 'mempty' a '==' 'mempty'
-- @
-- @
-- 'gcd' a 'mempty' '==' 'mempty'
-- @
--
-- __/Commutativity/__
--
-- @
-- 'gcd' a b '==' 'gcd' b a
-- @
--
-- __/Associativity/__
--
-- @
-- 'gcd' ('gcd' a b) c '==' 'gcd' a ('gcd' 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)
--
-- In addition, the 'commonPrefix' operation must satisfy the following
-- properties:
--
-- __/Idempotence/__
--
-- @
-- 'commonPrefix' a a '==' a
-- @
--
-- __/Identity/__
--
-- @
-- 'commonPrefix' 'mempty' a '==' 'mempty'
-- @
-- @
-- 'commonPrefix' a 'mempty' '==' 'mempty'
-- @
--
-- __/Commutativity/__
--
-- @
-- 'commonPrefix' a b '==' 'commonPrefix' b a
-- @
--
-- __/Associativity/__
--
-- @
-- 'commonPrefix' ('commonPrefix' a b) c
-- '=='
-- 'commonPrefix' a ('commonPrefix' b c)
-- @
--
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
_) = m -> m -> (m, m, m)
forall m. LeftGCDMonoid m => m -> m -> (m, m, m)
stripCommonPrefix m
x m
y
   stripCommonPrefix m
x m
y = (m
p, m
x', m
y')
      where p :: m
p = m -> m -> m
forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix m
x m
y
            Just m
x' = m -> m -> Maybe m
forall m. LeftReductive m => m -> m -> Maybe m
stripPrefix m
p m
x
            Just m
y' = m -> m -> Maybe m
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)
--
-- In addition, the 'commonSuffix' operation must satisfy the following
-- properties:
--
-- __/Idempotence/__
--
-- @
-- 'commonSuffix' a a '==' a
-- @
--
-- __/Identity/__
--
-- @
-- 'commonSuffix' 'mempty' a '==' 'mempty'
-- @
-- @
-- 'commonSuffix' a 'mempty' '==' 'mempty'
-- @
--
-- __/Commutativity/__
--
-- @
-- 'commonSuffix' a b '==' 'commonSuffix' b a
-- @
--
-- __/Associativity/__
--
-- @
-- 'commonSuffix' ('commonSuffix' a b) c
-- '=='
-- 'commonSuffix' a ('commonSuffix' b c)
-- @
--
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) = m -> m -> (m, m, m)
forall m. RightGCDMonoid m => m -> m -> (m, m, m)
stripCommonSuffix m
x m
y
   stripCommonSuffix m
x m
y = (m
x', m
y', m
s)
      where s :: m
s = m -> m -> m
forall m. RightGCDMonoid m => m -> m -> m
commonSuffix m
x m
y
            Just m
x' = m -> m -> Maybe m
forall m. RightReductive m => m -> m -> Maybe m
stripSuffix m
s m
x
            Just m
y' = m -> m -> Maybe m
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) = a -> Dual a
forall a. a -> Dual a
Dual (a -> a -> a
forall m. GCDMonoid m => m -> m -> m
gcd a
a a
b)

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

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

-- Sum instances

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

-- | /O(1)/
instance LeftGCDMonoid (Sum Natural) where
   commonPrefix :: Sum Natural -> Sum Natural -> Sum Natural
commonPrefix Sum Natural
a Sum Natural
b = Sum Natural -> Sum Natural -> Sum Natural
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 = Sum Natural -> Sum Natural -> Sum Natural
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) = Natural -> Product Natural
forall a. a -> Product a
Product (Natural -> Natural -> Natural
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 = Product Natural -> Product Natural -> Product Natural
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 = Product Natural -> Product Natural -> Product Natural
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) = (a -> a -> a
forall m. GCDMonoid m => m -> m -> m
gcd a
a a
c, b -> b -> b
forall m. GCDMonoid m => m -> m -> m
gcd b
b b
d)

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

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

-- Triple instances

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

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

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

-- Quadruple instances

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

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

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

-- Maybe instances

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

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

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

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

-- Set instances

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

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

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

-- IntSet instances

-- | /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 = (k -> a -> a -> Maybe a)
-> (Map k a -> Map k a)
-> (Map k a -> Map k a)
-> Map k a
-> Map k a
-> Map k a
forall k a b c.
Ord k =>
(k -> a -> b -> Maybe c)
-> (Map k a -> Map k c)
-> (Map k b -> Map k c)
-> Map k a
-> Map k b
-> Map k c
Map.mergeWithKey (\k
_ a
a a
b -> if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b then a -> Maybe a
forall a. a -> Maybe a
Just a
a else Maybe a
forall a. Maybe a
Nothing) (Map k a -> Map k a -> Map k a
forall a b. a -> b -> a
const Map k a
forall k a. Map k a
Map.empty) (Map k a -> Map k a -> Map k a
forall a b. a -> b -> a
const Map k a
forall k a. Map k a
Map.empty)

-- IntMap instances

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

-- List instances

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

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

-- | @since 1.0
-- /O(m+n)/
instance Eq x => RightGCDMonoid [x] where
   stripCommonSuffix :: [x] -> [x] -> ([x], [x], [x])
stripCommonSuffix [x]
x0 [x]
y0 = [x] -> [x] -> ([x], [x], [x])
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 [] [] = ([x] -> [x])
-> ([x] -> [x]) -> ([x] -> [x]) -> [x] -> [x] -> ([x], [x], [x])
forall {a} {a} {b}.
Eq a =>
([a] -> a)
-> ([a] -> b) -> ([a] -> [a]) -> [a] -> [a] -> (a, b, [a])
go2 [x] -> [x]
forall a. a -> a
id [x] -> [x]
forall a. a -> a
id [x] -> [x]
forall a. a -> a
id [x]
x0 [x]
y0
            go1 [] [a]
ys = ([x] -> [x])
-> ([x] -> [x]) -> ([x] -> [x]) -> [x] -> [x] -> ([x], [x], [x])
forall {a} {a} {b}.
Eq a =>
([a] -> a)
-> ([a] -> b) -> ([a] -> [a]) -> [a] -> [a] -> (a, b, [a])
go2 [x] -> [x]
forall a. a -> a
id [x] -> [x]
yp [x] -> [x]
forall a. a -> a
id [x]
x0 [x]
yr
               where ([x] -> [x]
yp, [x]
yr) = ([x] -> [x]) -> [a] -> [x] -> ([x] -> [x], [x])
forall {a} {c} {a}. ([a] -> c) -> [a] -> [a] -> ([a] -> c, [a])
splitAtLengthOf [x] -> [x]
forall a. a -> a
id [a]
ys [x]
y0
            go1 [a]
xs [] = ([x] -> [x])
-> ([x] -> [x]) -> ([x] -> [x]) -> [x] -> [x] -> ([x], [x], [x])
forall {a} {a} {b}.
Eq a =>
([a] -> a)
-> ([a] -> b) -> ([a] -> [a]) -> [a] -> [a] -> (a, b, [a])
go2 [x] -> [x]
xp [x] -> [x]
forall a. a -> a
id [x] -> [x]
forall a. a -> a
id [x]
xr [x]
y0
               where ([x] -> [x]
xp, [x]
xr) = ([x] -> [x]) -> [a] -> [x] -> ([x] -> [x], [x])
forall {a} {c} {a}. ([a] -> c) -> [a] -> [a] -> ([a] -> c, [a])
splitAtLengthOf [x] -> [x]
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 a -> a -> Bool
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 ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xa -> [a] -> [a]
forall 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 ([a] -> a) -> ([a] -> [a]) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
cs ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) ([a] -> b
yp ([a] -> b) -> ([a] -> [a]) -> [a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
cs ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) [a] -> [a]
forall a. a -> a
id [a]
xs [a]
ys
            go2 [a] -> a
_ [a] -> b
_ [a] -> [a]
_ [a]
_ [a]
_ = [Char] -> (a, b, [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 ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) [a]
xs [a]
ys
            splitAtLengthOf [a] -> c
yp [] [a]
ys = ([a] -> c
yp, [a]
ys)
            splitAtLengthOf [a] -> c
_ [a]
_ [a]
_ = [Char] -> ([a] -> c, [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 = Seq a -> Seq a -> Seq a -> (Seq a, Seq a, Seq a)
forall {a}.
Eq a =>
Seq a -> Seq a -> Seq a -> (Seq a, Seq a, Seq a)
findCommonPrefix Seq a
forall a. Seq a
Sequence.empty
      where findCommonPrefix :: Seq a -> Seq a -> Seq a -> (Seq a, Seq a, Seq a)
findCommonPrefix Seq a
prefix Seq a
a Seq a
b = case (Seq a -> ViewL a
forall a. Seq a -> ViewL a
Sequence.viewl Seq a
a, Seq a -> ViewL a
forall a. Seq a -> ViewL a
Sequence.viewl Seq a
b)
                                          of (a
a1:<Seq a
a', a
b1:<Seq a
b') | a
a1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b1 -> Seq a -> Seq a -> Seq a -> (Seq a, Seq a, Seq a)
findCommonPrefix (Seq a
prefix Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
a1) Seq a
a' Seq a
b'
                                             (ViewL a, ViewL a)
_ -> (Seq a
prefix, Seq a
a, Seq a
b)

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

-- Vector instances

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

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

-- ByteString instances

-- | /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 Key -> Key -> Key
forall a. Ord a => a -> a -> a
`min` ByteString -> Key
ByteString.length ByteString
y)
            prefixLength :: Key -> Key -> Key
prefixLength Key
n Key
len | Key
n Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
len,
                                 ByteString -> Key -> Word8
ByteString.unsafeIndex ByteString
x Key
n Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Key -> Word8
ByteString.unsafeIndex ByteString
y Key
n =
                                    Key -> Key -> Key
prefixLength (Key -> Key
forall a. Enum a => a -> a
succ Key
n) Key
len
                               | Bool
otherwise = Key
n
            (ByteString
xp, ByteString
xs) = Key -> ByteString -> (ByteString, ByteString)
ByteString.splitAt Key
maxPrefixLength ByteString
x

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

-- Lazy ByteString instances

-- | /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 Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
`min` ByteString -> Int64
LazyByteString.length ByteString
y)
            prefixLength :: Int64 -> Int64 -> Int64
prefixLength Int64
n Int64
len | Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
len Bool -> Bool -> Bool
&& HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
LazyByteString.index ByteString
x Int64
n Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== HasCallStack => ByteString -> Int64 -> Word8
ByteString -> Int64 -> Word8
LazyByteString.index ByteString
y Int64
n =
               Int64 -> Int64 -> Int64
prefixLength (Int64 -> Int64
forall a. Enum a => a -> a
succ Int64
n) Int64
len
            prefixLength Int64
n Int64
_ = Int64
n
            (ByteString
xp, ByteString
xs) = Int64 -> ByteString -> (ByteString, ByteString)
LazyByteString.splitAt Int64
maxPrefixLength ByteString
x

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

-- Text instances

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

-- | @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 (Key -> Key
forall a. Enum a => a -> a
pred Key
xlen) (Key -> Key
forall a. Enum a => a -> a
pred Key
ylen)
      where go :: Key -> Key -> (Text, Text, Text)
go Key
i Key
j | Key
i Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
>= Key
0 Bool -> Bool -> Bool
&& Key
j Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
>= Key
0 Bool -> Bool -> Bool
&& Char
xc Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
yc = Key -> Key -> (Text, Text, Text)
go (Key
iKey -> Key -> Key
forall a. Num a => a -> a -> a
+Key
xd) (Key
jKey -> Key -> Key
forall a. Num a => a -> a -> a
+Key
yd)
                   | Bool
otherwise = (Array -> Key -> Key -> Text
Internal.text Array
xarr Key
xoff (Key -> Key
forall a. Enum a => a -> a
succ Key
i),
                                  Array -> Key -> Key -> Text
Internal.text Array
yarr Key
yoff (Key -> Key
forall a. Enum a => a -> a
succ Key
j),
                                  Array -> Key -> Key -> Text
Internal.text Array
xarr (Key
xoffKey -> Key -> Key
forall a. Num a => a -> a -> a
+Key
iKey -> Key -> Key
forall a. Num a => a -> a -> a
+Key
1) (Key
xlenKey -> Key -> Key
forall a. Num a => a -> a -> a
-Key
iKey -> Key -> Key
forall a. Num a => a -> a -> a
-Key
1))
#if MIN_VERSION_text(2,0,0)
               where Iter Char
xc Key
xd = Text -> Key -> Iter
reverseIter Text
x Key
i
                     Iter Char
yc Key
yd = Text -> Key -> Iter
reverseIter Text
y Key
j
#else
               where (xc, xd) = reverseIter x i
                     (yc, yd) = reverseIter y 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 = (Text, Text, Text)
-> ((Text, Text, Text) -> (Text, Text, Text))
-> Maybe (Text, Text, Text)
-> (Text, Text, Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
LazyText.empty, Text
x, Text
y) (Text, Text, Text) -> (Text, Text, Text)
forall a. a -> a
id (Text -> Text -> Maybe (Text, Text, Text)
LazyText.commonPrefixes Text
x Text
y)

-- | @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 Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
y0len = (Text -> Text)
-> (Text -> Text)
-> (Text -> Text)
-> Text
-> Text
-> (Text, Text, Text)
forall {a} {b}.
(Text -> a)
-> (Text -> b) -> (Text -> Text) -> Text -> Text -> (a, b, Text)
go Text -> Text
forall a. a -> a
id Text -> Text
y0p Text -> Text
forall a. a -> a
id Text
x0 Text
y0s
      | Key
x0len Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
> Key
y0len = (Text -> Text)
-> (Text -> Text)
-> (Text -> Text)
-> Text
-> Text
-> (Text, Text, Text)
forall {a} {b}.
(Text -> a)
-> (Text -> b) -> (Text -> Text) -> Text -> Text -> (a, b, Text)
go Text -> Text
x0p Text -> Text
forall a. a -> a
id Text -> Text
forall a. a -> a
id Text
x0s Text
y0
      | Bool
otherwise = (Text -> Text)
-> (Text -> Text)
-> (Text -> Text)
-> Text
-> Text
-> (Text, Text, Text)
forall {a} {b}.
(Text -> a)
-> (Text -> b) -> (Text -> Text) -> Text -> Text -> (a, b, Text)
go Text -> Text
forall a. a -> a
id Text -> Text
forall a. a -> a
id Text -> Text
forall a. a -> a
id Text
x0 Text
y0
      where (Text -> Text
y0p, Text
y0s) = (Text -> Text) -> Key -> Text -> (Text -> Text, Text)
forall {c}. (Text -> c) -> Key -> Text -> (Text -> c, Text)
splitWord16 Text -> Text
forall a. a -> a
id (Key
y0len Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
x0len) Text
y0
            (Text -> Text
x0p, Text
x0s) = (Text -> Text) -> Key -> Text -> (Text -> Text, Text)
forall {c}. (Text -> c) -> Key -> Text -> (Text -> c, Text)
splitWord16 Text -> Text
forall a. a -> a
id (Key
x0len Key -> Key -> Key
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 = (Key -> Text -> Key) -> Key -> Text -> Key
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 Key -> Key -> Key
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 Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
len = (Text -> c
xp (Text -> c) -> (Text -> Text) -> Text -> c
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
offKey -> Key -> Key
forall a. Num a => a -> a -> a
+Key
n) (Key
lenKey -> Key -> Key
forall a. Num a => a -> a -> a
-Key
n)) Text
xs)
               | Bool
otherwise = (Text -> c) -> Key -> Text -> (Text -> c, Text)
splitWord16 (Text -> c
xp (Text -> c) -> (Text -> Text) -> Text -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
LazyInternal.chunk Text
x) (Key
n Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
len) Text
xs
            splitWord16 Text -> c
_ Key
_ Text
LazyInternal.Empty = [Char] -> (Text -> c, Text)
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 Text
forall a. Monoid a => a
mempty, Text -> b
yp Text
forall a. Monoid a => a
mempty, Text -> Text
cs Text
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 Key -> Key -> Bool
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) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                                            Text -> Text -> Text
LazyInternal.Chunk (Array -> Key -> Key -> Text
Internal.Text Array
yarr (Key
yoffKey -> Key -> Key
forall a. Num a => a -> a -> a
+Key
xlen) (Key
ylenKey -> Key -> Key
forall a. Num a => a -> a -> a
-Key
xlen)) Text
ys)
               | Key
xlen Key -> Key -> Bool
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) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                                            Text -> Text -> Text
LazyInternal.Chunk (Array -> Key -> Key -> Text
Internal.Text Array
xarr (Key
xoffKey -> Key -> Key
forall a. Num a => a -> a -> a
+Key
ylen) (Key
xlenKey -> Key -> Key
forall a. Num a => a -> a -> a
-Key
ylen)) Text
xs)
                                           (Text -> Text -> Text
LazyInternal.Chunk Text
y Text
ys)
               | Text
x Text -> Text -> Bool
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 (Text -> Text) -> (Text -> Text) -> Text -> Text
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) <- Text -> Text -> (Text, Text, Text)
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 (Text -> a) -> (Text -> Text) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
cs (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
LazyInternal.chunk Text
x1p) (Text -> b
yp (Text -> b) -> (Text -> Text) -> Text -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
cs (Text -> Text) -> (Text -> Text) -> Text -> Text
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
_ = [Char] -> (a, b, 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

--------------------------------------------------------------------------------
-- DistributiveGCDMonoid
--------------------------------------------------------------------------------

-- | Class of /commutative/ GCD monoids with /symmetric/ distributivity.
--
-- In addition to the general 'GCDMonoid' laws, instances of this class
-- must also satisfy the following laws:
--
-- @
-- 'gcd' (a '<>' b) (a '<>' c) '==' a '<>' 'gcd' b c
-- @
-- @
-- 'gcd' (a '<>' c) (b '<>' c) '==' 'gcd' a b '<>' c
-- @
--
class (LeftDistributiveGCDMonoid m, RightDistributiveGCDMonoid m, GCDMonoid m)
    => DistributiveGCDMonoid m

instance DistributiveGCDMonoid ()
instance DistributiveGCDMonoid (Product Natural)
instance DistributiveGCDMonoid (Sum Natural)
instance DistributiveGCDMonoid IntSet.IntSet
instance DistributiveGCDMonoid a => DistributiveGCDMonoid (Dual a)
instance Ord a => DistributiveGCDMonoid (Set.Set a)

-------------------------------------------------------------------------------
-- LeftDistributiveGCDMonoid
--------------------------------------------------------------------------------

-- | Class of /left/ GCD monoids with /left/-distributivity.
--
-- In addition to the general 'LeftGCDMonoid' laws, instances of this class
-- must also satisfy the following law:
--
-- @
-- 'commonPrefix' (a '<>' b) (a '<>' c) '==' a '<>' 'commonPrefix' b c
-- @
--
class LeftGCDMonoid m => LeftDistributiveGCDMonoid m

-- Instances for non-commutative monoids:
instance Eq a => LeftDistributiveGCDMonoid [a]
instance Eq a => LeftDistributiveGCDMonoid (Sequence.Seq a)
instance Eq a => LeftDistributiveGCDMonoid (Vector.Vector a)
instance LeftDistributiveGCDMonoid ByteString.ByteString
instance LeftDistributiveGCDMonoid LazyByteString.ByteString
instance LeftDistributiveGCDMonoid Text.Text
instance LeftDistributiveGCDMonoid LazyText.Text

-- Instances for commutative monoids:
instance LeftDistributiveGCDMonoid ()
instance LeftDistributiveGCDMonoid (Product Natural)
instance LeftDistributiveGCDMonoid (Sum Natural)
instance LeftDistributiveGCDMonoid IntSet.IntSet
instance Ord a => LeftDistributiveGCDMonoid (Set.Set a)

-- Instances for monoid transformers:
instance RightDistributiveGCDMonoid a => LeftDistributiveGCDMonoid (Dual a)

--------------------------------------------------------------------------------
-- RightDistributiveGCDMonoid
--------------------------------------------------------------------------------

-- | Class of /right/ GCD monoids with /right/-distributivity.
--
-- In addition to the general 'RightGCDMonoid' laws, instances of this class
-- must also satisfy the following law:
--
-- @
-- 'commonSuffix' (a '<>' c) (b '<>' c) '==' 'commonSuffix' a b '<>' c
-- @
--
class RightGCDMonoid m => RightDistributiveGCDMonoid m

-- Instances for non-commutative monoids:
instance Eq a => RightDistributiveGCDMonoid [a]
instance Eq a => RightDistributiveGCDMonoid (Sequence.Seq a)
instance Eq a => RightDistributiveGCDMonoid (Vector.Vector a)
instance RightDistributiveGCDMonoid ByteString.ByteString
instance RightDistributiveGCDMonoid LazyByteString.ByteString
instance RightDistributiveGCDMonoid Text.Text
instance RightDistributiveGCDMonoid LazyText.Text

-- Instances for commutative monoids:
instance RightDistributiveGCDMonoid ()
instance RightDistributiveGCDMonoid (Product Natural)
instance RightDistributiveGCDMonoid (Sum Natural)
instance RightDistributiveGCDMonoid IntSet.IntSet
instance Ord a => RightDistributiveGCDMonoid (Set.Set a)

-- Instances for monoid transformers:
instance LeftDistributiveGCDMonoid a => RightDistributiveGCDMonoid (Dual a)