module Data.Monoid.Cancellative (
CancellativeMonoid, GCDMonoid,
LeftCancellativeMonoid(..), RightCancellativeMonoid(..),
LeftGCDMonoid(..), RightGCDMonoid(..)
) where
import Data.Monoid (Monoid (mappend))
import qualified Data.List as List
import qualified Data.ByteString as ByteString
import qualified Data.Text as Text
import Data.ByteString (ByteString)
import Data.Text (Text)
class Monoid m => LeftCancellativeMonoid m where
mstripPrefix :: m -> m -> Maybe m
class Monoid m => RightCancellativeMonoid m where
mstripSuffix :: m -> m -> Maybe m
class LeftCancellativeMonoid m => LeftGCDMonoid m where
commonPrefix :: m -> m -> m
class RightCancellativeMonoid m => RightGCDMonoid m where
commonSuffix :: m -> m -> m
class (LeftCancellativeMonoid m, RightCancellativeMonoid m) => CancellativeMonoid m
class (CancellativeMonoid m, LeftGCDMonoid m, RightGCDMonoid m) => GCDMonoid m
instance Eq x => LeftCancellativeMonoid [x] where
mstripPrefix = List.stripPrefix
instance Eq x => LeftGCDMonoid [x] where
commonPrefix (x:xs) (y:ys) | x == y = x : commonPrefix xs ys
commonPrefix _ _ = []
instance Eq x => RightCancellativeMonoid [x] where
mstripSuffix s l = fmap List.reverse (mstripPrefix (List.reverse s) (List.reverse l))
instance Eq x => RightGCDMonoid [x] where
commonSuffix xs ys = List.reverse (commonPrefix (List.reverse xs) (List.reverse ys))
instance Eq x => CancellativeMonoid [x]
instance Eq x => GCDMonoid [x]
instance LeftCancellativeMonoid ByteString where
mstripPrefix p l = if ByteString.isPrefixOf p l
then Just (ByteString.drop (ByteString.length p) l)
else Nothing
instance RightCancellativeMonoid ByteString where
mstripSuffix s l = if ByteString.isSuffixOf s l
then Just (ByteString.take (ByteString.length l ByteString.length s) l)
else Nothing
instance CancellativeMonoid ByteString
instance LeftGCDMonoid ByteString where
commonPrefix x y = ByteString.take maxPrefixLength x
where maxPrefixLength = prefixLength 0
prefixLength n | ByteString.index x 0 == ByteString.index y 0 = prefixLength (succ n)
prefixLength n = n
instance RightGCDMonoid ByteString where
commonSuffix x y = ByteString.drop minNonSuffixLength x
where minNonSuffixLength = nonSuffixLength (ByteString.length x 1) (ByteString.length y 1)
nonSuffixLength m n | ByteString.index x m == ByteString.index y n = nonSuffixLength (pred m) (pred n)
nonSuffixLength m n = m + 1
instance GCDMonoid ByteString
instance LeftCancellativeMonoid Text where
mstripPrefix p t = Text.stripPrefix p t
instance RightCancellativeMonoid Text where
mstripSuffix s t = Text.stripSuffix s t
instance CancellativeMonoid Text
instance LeftGCDMonoid Text where
commonPrefix x y = maybe Text.empty (\(p, _, _)-> p) (Text.commonPrefixes x y)
instance RightGCDMonoid Text where
commonSuffix x y = Text.reverse $ commonPrefix (Text.reverse x) (Text.reverse y)
instance GCDMonoid Text