diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,4 +1,26 @@
 
+Version 1.0
+---------------
+* Fixed issue #24, unlawful LeftReductiveMonoid instance for Map
+* Tightened the laws of GCD classes, dropped instances for Sum and Product
+* Introduced the `Monus` class
+* Introduced the `OverlappingGCDMonoid` class
+* Added the instances of type `Sum Natural` and `Product Natural`
+* Using the language extensions 'FlexibleInstances' and 'OverlappingInstances'
+* Removed the linear complexity requirement
+* Added and documented less efficient instances
+* Moved various GCD classes into the new module `Data.Monoid.GCD`
+* Added module `Data.Semigroup.Cancellative` with `Semigroup` subclasses
+* Added module `Data.Semigroup.Factorial` with `Semigroup` subclasses
+* Deprecated several `Monoid` subclasses and made them constraint synonyms instead:
+  * `type CommutativeMonoid m = (Monoid m, Commutative m)`
+  * `type ReductiveMonoid m = (Monoid m, Reductive m)`
+  * `type LeftReductiveMonoid m = (Monoid m, LeftReductive m)`
+  * `type RightReductiveMonoid m = (Monoid m, RightReductive m)`
+  * `type CancellativeMonoid m = (Monoid m, Cancellative m)`
+  * `type LeftCancellativeMonoid m = (Monoid m, LeftCancellative m)`
+  * `type RightCancellativeMonoid m = (Monoid m, RightCancellative m)`
+
 Version 0.4.6.1
 ---------------
 Bumped the containers dependency upper bounds
diff --git a/Data/Monoid/Cancellative.hs b/Data/Monoid/Cancellative.hs
deleted file mode 100644
--- a/Data/Monoid/Cancellative.hs
+++ /dev/null
@@ -1,706 +0,0 @@
-{- 
-    Copyright 2013-2017 Mario Blazevic
-
-    License: BSD3 (see BSD3-LICENSE.txt file)
--}
-
--- | This module defines the 'Monoid' => 'ReductiveMonoid' => ('CancellativeMonoid', 'GCDMonoid') class hierarchy. 
---
--- The 'ReductiveMonoid' class introduces operation '</>' which is the inverse of '<>'. For the 'Sum' monoid, this
--- operation is subtraction; for 'Product' it is division and for 'Set' it's the set difference. A 'ReductiveMonoid' is
--- not a full group because '</>' may return 'Nothing'.
---
--- The 'CancellativeMonoid' subclass does not add any operation but it provides the additional guarantee that '<>' can
--- always be undone with '</>'. Thus 'Sum' is a 'CancellativeMonoid' but 'Product' is not because @(0*n)/0@ is not
--- defined.
---
--- 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.
---
--- All monoid subclasses listed above are for Abelian, /i.e./, commutative or symmetric monoids. Since most practical
--- monoids in Haskell are not Abelian, each of the these classes has two symmetric superclasses:
--- 
--- * 'LeftReductiveMonoid'
--- 
--- * 'LeftCancellativeMonoid'
--- 
--- * 'LeftGCDMonoid'
--- 
--- * 'RightReductiveMonoid'
--- 
--- * 'RightCancellativeMonoid'
--- 
--- * 'RightGCDMonoid'
-
-{-# LANGUAGE Haskell2010, Trustworthy #-}
-
-module Data.Monoid.Cancellative (
-   -- * Symmetric, commutative monoid classes
-   CommutativeMonoid, ReductiveMonoid(..), CancellativeMonoid, GCDMonoid(..),
-   -- * Asymmetric monoid classes
-   LeftReductiveMonoid(..), RightReductiveMonoid(..),
-   LeftCancellativeMonoid, RightCancellativeMonoid,
-   LeftGCDMonoid(..), RightGCDMonoid(..)
-   )
-where
-
-import qualified Prelude
-
-import Control.Applicative ((<$>), (<*>))
-import Data.Monoid -- (Monoid, Dual(..), Sum(..), Product(..))
-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 Data.Sequence (ViewL((:<)), ViewR((:>)), (<|), (|>))
-import qualified Data.Vector as Vector
-
-import Prelude hiding (gcd)
-
--- | Class of all Abelian ({i.e.}, commutative) monoids that satisfy the commutativity property:
--- 
--- > a <> b == b <> a
-class Monoid m => CommutativeMonoid m
-
--- | Class of Abelian monoids with a partial inverse for the Monoid '<>' operation. The inverse operation '</>' must
--- satisfy the following laws:
--- 
--- > maybe a (b <>) (a </> b) == a
--- > maybe a (<> b) (a </> b) == a
-class (CommutativeMonoid m, LeftReductiveMonoid m, RightReductiveMonoid m) => ReductiveMonoid m where
-   (</>) :: m -> m -> Maybe m
-
-infix 5 </>
-
--- | Subclass of 'ReductiveMonoid' where '</>' is a complete inverse of the Monoid '<>' operation. The class instances
--- must satisfy the following additional laws:
---
--- > (a <> b) </> a == Just b
--- > (a <> b) </> b == Just a
-class (LeftCancellativeMonoid m, RightCancellativeMonoid m, ReductiveMonoid m) => CancellativeMonoid m
-
--- | Class of Abelian monoids that allow the greatest common denominator 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 a 'CancellativeMonoid', 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 (ReductiveMonoid m, LeftGCDMonoid m, RightGCDMonoid m) => GCDMonoid m where
-   gcd :: m -> m -> m
-
--- | Class of monoids with a left inverse of 'Data.Monoid.mappend', 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. Its complexity should be no worse
--- than linear in the length of the prefix argument.
-class Monoid m => LeftReductiveMonoid m where
-   isPrefixOf :: m -> m -> Bool
-   stripPrefix :: m -> m -> Maybe m
-
-   isPrefixOf a b = isJust (stripPrefix a b)
-   {-# MINIMAL stripPrefix #-}
-
--- | Class of monoids with a right inverse of 'Data.Monoid.mappend', 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. Its complexity should be no worse
--- than linear in the length of the suffix argument.
-class Monoid m => RightReductiveMonoid m where
-   isSuffixOf :: m -> m -> Bool
-   stripSuffix :: m -> m -> Maybe m
-
-   isSuffixOf a b = isJust (stripSuffix a b)
-   {-# MINIMAL stripSuffix #-}
-
--- | Subclass of 'LeftReductiveMonoid' where 'stripPrefix' is a complete inverse of '<>', satisfying the following
--- additional law:
---
--- > stripPrefix a (a <> b) == Just b
-class LeftReductiveMonoid m => LeftCancellativeMonoid m
-
--- | Subclass of 'LeftReductiveMonoid' where 'stripPrefix' is a complete inverse of '<>', satisfying the following
--- additional law:
---
--- > stripSuffix b (a <> b) == Just a
-class RightReductiveMonoid m => RightCancellativeMonoid m
-
--- | Class of monoids capable of finding the equivalent of greatest common divisor on the left side of two monoidal
--- values. The methods' complexity should be no worse than linear in the length of the common prefix. 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
-class LeftReductiveMonoid m => LeftGCDMonoid m where
-   commonPrefix :: m -> m -> m
-   stripCommonPrefix :: m -> m -> (m, m, m)
-
-   commonPrefix x y = p
-      where (p, _, _) = stripCommonPrefix x y
-   stripCommonPrefix x y = (p, x', y')
-      where p = commonPrefix x y
-            Just x' = stripPrefix p x
-            Just y' = stripPrefix p 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 methods' complexity must be no worse than linear in the length of the common suffix. 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
-class RightReductiveMonoid m => RightGCDMonoid m where
-   commonSuffix :: m -> m -> m
-   stripCommonSuffix :: m -> m -> (m, m, m)
-
-   commonSuffix x y = s
-      where (_, _, s) = stripCommonSuffix x y
-   stripCommonSuffix x y = (x', y', s)
-      where s = commonSuffix x y
-            Just x' = stripSuffix s x
-            Just y' = stripSuffix s y
-   {-# MINIMAL commonSuffix | stripCommonSuffix #-}
-
--- Unit instances
-
-instance CommutativeMonoid ()
-
-instance ReductiveMonoid () where
-   () </> () = Just ()
-
-instance CancellativeMonoid ()
-
-instance GCDMonoid () where
-   gcd () () = ()
-
-instance LeftReductiveMonoid () where
-   stripPrefix () () = Just ()
-
-instance RightReductiveMonoid () where
-   stripSuffix () () = Just ()
-
-instance LeftCancellativeMonoid ()
-
-instance RightCancellativeMonoid ()
-
-instance LeftGCDMonoid () where
-   commonPrefix () () = ()
-
-instance RightGCDMonoid () where
-   commonSuffix () () = ()
-
--- Dual instances
-
-instance CommutativeMonoid a => CommutativeMonoid (Dual a)
-
-instance ReductiveMonoid a => ReductiveMonoid (Dual a) where
-   Dual a </> Dual b = fmap Dual (a </> b)
-
-instance CancellativeMonoid a => CancellativeMonoid (Dual a)
-
-instance GCDMonoid a => GCDMonoid (Dual a) where
-   gcd (Dual a) (Dual b) = Dual (gcd a b)
-
-instance LeftReductiveMonoid a => RightReductiveMonoid (Dual a) where
-   stripSuffix (Dual a) (Dual b) = fmap Dual (stripPrefix a b)
-   Dual a `isSuffixOf` Dual b = a `isPrefixOf` b
-
-instance RightReductiveMonoid a => LeftReductiveMonoid (Dual a) where
-   stripPrefix (Dual a) (Dual b) = fmap Dual (stripSuffix a b)
-   Dual a `isPrefixOf` Dual b = a `isSuffixOf` b
-
-instance LeftCancellativeMonoid a => RightCancellativeMonoid (Dual a)
-
-instance RightCancellativeMonoid a => LeftCancellativeMonoid (Dual a)
-
-instance LeftGCDMonoid a => RightGCDMonoid (Dual a) where
-   commonSuffix (Dual a) (Dual b) = Dual (commonPrefix a b)
-
-instance RightGCDMonoid a => LeftGCDMonoid (Dual a) where
-   commonPrefix (Dual a) (Dual b) = Dual (commonSuffix a b)
-
--- Sum instances
-
-instance Num a => CommutativeMonoid (Sum a)
-
-instance Integral a => ReductiveMonoid (Sum a) where
-   Sum a </> Sum b = Just $ Sum (a - b)
-
-instance Integral a => CancellativeMonoid (Sum a)
-
-instance (Integral a, Ord a) => GCDMonoid (Sum a) where
-   gcd (Sum a) (Sum b) = Sum (min a b)
-
-instance Integral a => LeftReductiveMonoid (Sum a) where
-   stripPrefix a b = b </> a
-
-instance Integral a => RightReductiveMonoid (Sum a) where
-   stripSuffix a b = b </> a
-
-instance Integral a => LeftCancellativeMonoid (Sum a)
-
-instance Integral a => RightCancellativeMonoid (Sum a)
-
-instance (Integral a, Ord a) => LeftGCDMonoid (Sum a) where
-   commonPrefix a b = gcd a b
-
-instance (Integral a, Ord a) => RightGCDMonoid (Sum a) where
-   commonSuffix a b = gcd a b
-
--- Product instances
-
-instance Num a => CommutativeMonoid (Product a)
-
-instance Integral a => ReductiveMonoid (Product a) where
-   Product 0 </> Product 0 = Just (Product 0)
-   Product _ </> Product 0 = Nothing
-   Product a </> Product b = if remainder == 0 then Just (Product quotient) else Nothing
-      where (quotient, remainder) = quotRem a b
-
-instance Integral a => GCDMonoid (Product a) where
-   gcd (Product a) (Product b) = Product (Prelude.gcd a b)
-
-instance Integral a => LeftReductiveMonoid (Product a) where
-   stripPrefix a b = b </> a
-
-instance Integral a => RightReductiveMonoid (Product a) where
-   stripSuffix a b = b </> a
-
-instance Integral a => LeftGCDMonoid (Product a) where
-   commonPrefix a b = gcd a b
-
-instance Integral a => RightGCDMonoid (Product a) where
-   commonSuffix a b = gcd a b
-
--- Pair instances
-
-instance (CommutativeMonoid a, CommutativeMonoid b) => CommutativeMonoid (a, b)
-
-instance (ReductiveMonoid a, ReductiveMonoid b) => ReductiveMonoid (a, b) where
-   (a, b) </> (c, d) = case (a </> c, b </> d)
-                       of (Just a', Just b') -> Just (a', b')
-                          _ -> Nothing
-
-instance (CancellativeMonoid a, CancellativeMonoid b) => CancellativeMonoid (a, b)
-
-instance (GCDMonoid a, GCDMonoid b) => GCDMonoid (a, b) where
-   gcd (a, b) (c, d) = (gcd a c, gcd b d)
-
-instance (LeftReductiveMonoid a, LeftReductiveMonoid b) => LeftReductiveMonoid (a, b) where
-   stripPrefix (a, b) (c, d) = case (stripPrefix a c, stripPrefix b d)
-                               of (Just a', Just b') -> Just (a', b')
-                                  _ -> Nothing
-   isPrefixOf (a, b) (c, d) = isPrefixOf a c && isPrefixOf b d
-
-instance (RightReductiveMonoid a, RightReductiveMonoid b) => RightReductiveMonoid (a, b) where
-   stripSuffix (a, b) (c, d) = case (stripSuffix a c, stripSuffix b d)
-                               of (Just a', Just b') -> Just (a', b')
-                                  _ -> Nothing
-   isSuffixOf (a, b) (c, d) = isSuffixOf a c && isSuffixOf b d
-
-instance (LeftCancellativeMonoid a, LeftCancellativeMonoid b) => LeftCancellativeMonoid (a, b)
-
-instance (RightCancellativeMonoid a, RightCancellativeMonoid b) => RightCancellativeMonoid (a, b)
-
-instance (LeftGCDMonoid a, LeftGCDMonoid b) => LeftGCDMonoid (a, b) where
-   commonPrefix (a, b) (c, d) = (commonPrefix a c, commonPrefix b d)
-
-instance (RightGCDMonoid a, RightGCDMonoid b) => RightGCDMonoid (a, b) where
-   commonSuffix (a, b) (c, d) = (commonSuffix a c, commonSuffix b d)
-
--- Triple instances
-
-instance (CommutativeMonoid a, CommutativeMonoid b, CommutativeMonoid c) => CommutativeMonoid (a, b, c)
-
-instance (ReductiveMonoid a, ReductiveMonoid b, ReductiveMonoid c) => ReductiveMonoid (a, b, c) where
-   (a1, b1, c1) </> (a2, b2, c2) = (,,) <$> (a1 </> a2) <*> (b1 </> b2) <*> (c1 </> c2)
-
-instance (CancellativeMonoid a, CancellativeMonoid b, CancellativeMonoid c) => CancellativeMonoid (a, b, c)
-
-instance (GCDMonoid a, GCDMonoid b, GCDMonoid c) => GCDMonoid (a, b, c) where
-   gcd (a1, b1, c1) (a2, b2, c2) = (gcd a1 a2, gcd b1 b2, gcd c1 c2)
-
-instance (LeftReductiveMonoid a, LeftReductiveMonoid b, LeftReductiveMonoid c) => LeftReductiveMonoid (a, b, c) where
-   stripPrefix (a1, b1, c1) (a2, b2, c2) = (,,) <$> stripPrefix a1 a2 <*> stripPrefix b1 b2 <*> stripPrefix c1 c2
-   isPrefixOf (a1, b1, c1) (a2, b2, c2) = isPrefixOf a1 a2 && isPrefixOf b1 b2 && isPrefixOf c1 c2
-
-instance (RightReductiveMonoid a, RightReductiveMonoid b, RightReductiveMonoid c) =>
-         RightReductiveMonoid (a, b, c) where
-   stripSuffix (a1, b1, c1) (a2, b2, c2) = (,,) <$> stripSuffix a1 a2 <*> stripSuffix b1 b2 <*> stripSuffix c1 c2
-   isSuffixOf (a1, b1, c1) (a2, b2, c2) = isSuffixOf a1 a2 && isSuffixOf b1 b2 && isSuffixOf c1 c2
-
-instance (LeftCancellativeMonoid a, LeftCancellativeMonoid b, LeftCancellativeMonoid c) =>
-         LeftCancellativeMonoid (a, b, c)
-
-instance (RightCancellativeMonoid a, RightCancellativeMonoid b, RightCancellativeMonoid c) =>
-         RightCancellativeMonoid (a, b, c)
-
-instance (LeftGCDMonoid a, LeftGCDMonoid b, LeftGCDMonoid c) => LeftGCDMonoid (a, b, c) where
-   commonPrefix (a1, b1, c1) (a2, b2, c2) = (commonPrefix a1 a2, commonPrefix b1 b2, commonPrefix c1 c2)
-
-instance (RightGCDMonoid a, RightGCDMonoid b, RightGCDMonoid c) => RightGCDMonoid (a, b, c) where
-   commonSuffix (a1, b1, c1) (a2, b2, c2) = (commonSuffix a1 a2, commonSuffix b1 b2, commonSuffix c1 c2)
-
--- Quadruple instances
-
-instance (CommutativeMonoid a, CommutativeMonoid b, CommutativeMonoid c, CommutativeMonoid d) =>
-         CommutativeMonoid (a, b, c, d)
-
-instance (ReductiveMonoid a, ReductiveMonoid b, ReductiveMonoid c, ReductiveMonoid d) =>
-         ReductiveMonoid (a, b, c, d) where
-   (a1, b1, c1, d1) </> (a2, b2, c2, d2) = (,,,) <$> (a1 </> a2) <*> (b1 </> b2) <*> (c1 </> c2) <*> (d1 </> d2)
-
-instance (CancellativeMonoid a, CancellativeMonoid b, CancellativeMonoid c, CancellativeMonoid d) =>
-         CancellativeMonoid (a, b, c, d)
-
-instance (GCDMonoid a, GCDMonoid b, GCDMonoid c, GCDMonoid d) => GCDMonoid (a, b, c, d) where
-   gcd (a1, b1, c1, d1) (a2, b2, c2, d2) = (gcd a1 a2, gcd b1 b2, gcd c1 c2, gcd d1 d2)
-
-instance (LeftReductiveMonoid a, LeftReductiveMonoid b, LeftReductiveMonoid c, LeftReductiveMonoid d) =>
-         LeftReductiveMonoid (a, b, c, d) where
-   stripPrefix (a1, b1, c1, d1) (a2, b2, c2, d2) =
-      (,,,) <$> stripPrefix a1 a2 <*> stripPrefix b1 b2 <*> stripPrefix c1 c2 <*> stripPrefix d1 d2
-   isPrefixOf (a1, b1, c1, d1) (a2, b2, c2, d2) =
-      isPrefixOf a1 a2 && isPrefixOf b1 b2 && isPrefixOf c1 c2 && isPrefixOf d1 d2
-
-instance (RightReductiveMonoid a, RightReductiveMonoid b, RightReductiveMonoid c, RightReductiveMonoid d) =>
-         RightReductiveMonoid (a, b, c, d) where
-   stripSuffix (a1, b1, c1, d1) (a2, b2, c2, d2) =
-      (,,,) <$> stripSuffix a1 a2 <*> stripSuffix b1 b2 <*> stripSuffix c1 c2 <*> stripSuffix d1 d2
-   isSuffixOf (a1, b1, c1, d1) (a2, b2, c2, d2) =
-      isSuffixOf a1 a2 && isSuffixOf b1 b2 && isSuffixOf c1 c2 && isSuffixOf d1 d2
-
-instance (LeftCancellativeMonoid a, LeftCancellativeMonoid b, LeftCancellativeMonoid c, LeftCancellativeMonoid d) =>
-         LeftCancellativeMonoid (a, b, c, d)
-
-instance (RightCancellativeMonoid a, RightCancellativeMonoid b, RightCancellativeMonoid c, RightCancellativeMonoid d) =>
-         RightCancellativeMonoid (a, b, c, d)
-
-instance (LeftGCDMonoid a, LeftGCDMonoid b, LeftGCDMonoid c, LeftGCDMonoid d) => LeftGCDMonoid (a, b, c, d) where
-   commonPrefix (a1, b1, c1, d1) (a2, b2, c2, d2) =
-      (commonPrefix a1 a2, commonPrefix b1 b2, commonPrefix c1 c2, commonPrefix d1 d2)
-
-instance (RightGCDMonoid a, RightGCDMonoid b, RightGCDMonoid c, RightGCDMonoid d) => RightGCDMonoid (a, b, c, d) where
-   commonSuffix (a1, b1, c1, d1) (a2, b2, c2, d2) =
-      (commonSuffix a1 a2, commonSuffix b1 b2, commonSuffix c1 c2, commonSuffix d1 d2)
-
--- Maybe instances
-
-instance LeftReductiveMonoid x => LeftReductiveMonoid (Maybe x) where
-   stripPrefix Nothing y = Just y
-   stripPrefix Just{} Nothing = Nothing
-   stripPrefix (Just x) (Just y) = fmap Just $ stripPrefix x y
-
-instance LeftGCDMonoid x => LeftGCDMonoid (Maybe x) where
-   commonPrefix (Just x) (Just y) = Just (commonPrefix x y)
-   commonPrefix _ _ = Nothing
-
-   stripCommonPrefix (Just x) (Just y) = (Just p, Just x', Just y')
-      where (p, x', y') = stripCommonPrefix x y
-   stripCommonPrefix x y = (Nothing, x, y)
-
-instance RightReductiveMonoid x => RightReductiveMonoid (Maybe x) where
-   stripSuffix Nothing y = Just y
-   stripSuffix Just{} Nothing = Nothing
-   stripSuffix (Just x) (Just y) = fmap Just $ stripSuffix x y
-
-instance RightGCDMonoid x => RightGCDMonoid (Maybe x) where
-   commonSuffix (Just x) (Just y) = Just (commonSuffix x y)
-   commonSuffix _ _ = Nothing
-
-   stripCommonSuffix (Just x) (Just y) = (Just x', Just y', Just s)
-      where (x', y', s) = stripCommonSuffix x y
-   stripCommonSuffix x y = (x, y, Nothing)
-
--- Set instances
-
-instance Ord a => CommutativeMonoid (Set.Set a)
-
-instance Ord a => LeftReductiveMonoid (Set.Set a) where
-   isPrefixOf = Set.isSubsetOf
-   stripPrefix a b = b </> a
-
-instance Ord a => RightReductiveMonoid (Set.Set a) where
-   isSuffixOf = Set.isSubsetOf
-   stripSuffix a b = b </> a
-
-instance Ord a => ReductiveMonoid (Set.Set a) where
-   a </> b | Set.isSubsetOf b a = Just (a Set.\\ b)
-           | otherwise = Nothing
-
-instance Ord a => LeftGCDMonoid (Set.Set a) where
-   commonPrefix = Set.intersection
-
-instance Ord a => RightGCDMonoid (Set.Set a) where
-   commonSuffix = Set.intersection
-
-instance Ord a => GCDMonoid (Set.Set a) where
-   gcd = Set.intersection
-
--- IntSet instances
-
-instance CommutativeMonoid IntSet.IntSet
-
-instance LeftReductiveMonoid IntSet.IntSet where
-   isPrefixOf = IntSet.isSubsetOf
-   stripPrefix a b = b </> a
-
-instance RightReductiveMonoid IntSet.IntSet where
-   isSuffixOf = IntSet.isSubsetOf
-   stripSuffix a b = b </> a
-
-instance ReductiveMonoid IntSet.IntSet where
-   a </> b | IntSet.isSubsetOf b a = Just (a IntSet.\\ b)
-           | otherwise = Nothing
-
-instance LeftGCDMonoid IntSet.IntSet where
-   commonPrefix = IntSet.intersection
-
-instance RightGCDMonoid IntSet.IntSet where
-   commonSuffix = IntSet.intersection
-
-instance GCDMonoid IntSet.IntSet where
-   gcd = IntSet.intersection
-
--- Map instances
-
-instance Ord k => LeftReductiveMonoid (Map.Map k a) where
-   isPrefixOf = Map.isSubmapOfBy (\_ _-> True)
-   stripPrefix a b | Map.isSubmapOfBy (\_ _-> True) a b = Just (b Map.\\ a)
-                   | otherwise = Nothing
-
-instance (Ord k, Eq a) => LeftGCDMonoid (Map.Map k a) where
-   commonPrefix = Map.mergeWithKey (\_ a b -> if a == b then Just a else Nothing) (const Map.empty) (const Map.empty)
-
--- IntMap instances
-
-instance LeftReductiveMonoid (IntMap.IntMap a) where
-   isPrefixOf = IntMap.isSubmapOfBy (\_ _-> True)
-   stripPrefix a b | IntMap.isSubmapOfBy (\_ _-> True) a b = Just (b IntMap.\\ a)
-                   | otherwise = Nothing
-
-instance Eq a => LeftGCDMonoid (IntMap.IntMap a) where
-   commonPrefix = IntMap.mergeWithKey (\_ a b -> if a == b then Just a else Nothing)
-                                      (const IntMap.empty) (const IntMap.empty)
-
--- List instances
-
-instance Eq x => LeftReductiveMonoid [x] where
-   stripPrefix = List.stripPrefix
-   isPrefixOf = List.isPrefixOf
-
-instance Eq x => LeftCancellativeMonoid [x]
-
-instance Eq x => LeftGCDMonoid [x] where
-   commonPrefix (x:xs) (y:ys) | x == y = x : commonPrefix xs ys
-   commonPrefix _ _ = []
-
-   stripCommonPrefix x0 y0 = strip' id x0 y0
-      where strip' f (x:xs) (y:ys) | x == y = strip' (f . (x :)) xs ys
-            strip' f x y = (f [], x, y)
-
--- Seq instances
-
-instance Eq a => LeftReductiveMonoid (Sequence.Seq a) where
-   stripPrefix p s | p == s1 = Just s2
-                   | otherwise = Nothing
-      where (s1, s2) = Sequence.splitAt (Sequence.length p) s
-
-instance Eq a => RightReductiveMonoid (Sequence.Seq a) where
-   stripSuffix p s | p == s2 = Just s1
-                   | otherwise = Nothing
-      where (s1, s2) = Sequence.splitAt (Sequence.length s - Sequence.length p) s
-
-instance Eq a => LeftCancellativeMonoid (Sequence.Seq a)
-
-instance Eq a => RightCancellativeMonoid (Sequence.Seq a)
-
-instance Eq a => LeftGCDMonoid (Sequence.Seq a) where
-   stripCommonPrefix = findCommonPrefix Sequence.empty
-      where findCommonPrefix prefix a b = case (Sequence.viewl a, Sequence.viewl b)
-                                          of (a1:<a', b1:<b') | a1 == b1 -> findCommonPrefix (prefix |> a1) a' b'
-                                             _ -> (prefix, a, b)
-
-instance Eq a => RightGCDMonoid (Sequence.Seq a) where
-   stripCommonSuffix = findCommonSuffix Sequence.empty
-      where findCommonSuffix suffix a b = case (Sequence.viewr a, Sequence.viewr b)
-                                          of (a':>a1, b':>b1) | a1 == b1 -> findCommonSuffix (a1 <| suffix) a' b'
-                                             _ -> (a, b, suffix)
-
--- Vector instances
-
-instance Eq a => LeftReductiveMonoid (Vector.Vector a) where
-   stripPrefix p l | prefixLength > Vector.length l = Nothing
-                    | otherwise = strip 0
-      where strip i | i == prefixLength = Just (Vector.drop prefixLength l)
-                    | l Vector.! i == p Vector.! i = strip (succ i)
-                    | otherwise = Nothing
-            prefixLength = Vector.length p
-   isPrefixOf p l | prefixLength > Vector.length l = False
-                  | otherwise = test 0
-      where test i | i == prefixLength = True
-                   | l Vector.! i == p Vector.! i = test (succ i)
-                   | otherwise = False
-            prefixLength = Vector.length p
-
-instance Eq a => RightReductiveMonoid (Vector.Vector a) where
-   stripSuffix s l | suffixLength > Vector.length l = Nothing
-                   | otherwise = strip (pred suffixLength)
-      where strip i | i == -1 = Just (Vector.take lengthDifference l)
-                    | l Vector.! (lengthDifference + i) == s Vector.! i = strip (pred i)
-                    | otherwise = Nothing
-            suffixLength = Vector.length s
-            lengthDifference = Vector.length l - suffixLength
-   isSuffixOf s l | suffixLength > Vector.length l = False
-                  | otherwise = test (pred suffixLength)
-      where test i | i == -1 = True
-                   | l Vector.! (lengthDifference + i) == s Vector.! i = test (pred i)
-                   | otherwise = False
-            suffixLength = Vector.length s
-            lengthDifference = Vector.length l - suffixLength
-
-instance Eq a => LeftCancellativeMonoid (Vector.Vector a)
-
-instance Eq a => RightCancellativeMonoid (Vector.Vector a)
-
-instance Eq a => LeftGCDMonoid (Vector.Vector a) where
-   stripCommonPrefix x y = (xp, xs, Vector.drop maxPrefixLength y)
-      where maxPrefixLength = prefixLength 0 (Vector.length x `min` Vector.length y)
-            prefixLength n len | n < len && x Vector.! n == y Vector.! n = prefixLength (succ n) len
-            prefixLength n _ = n
-            (xp, xs) = Vector.splitAt maxPrefixLength x
-
-instance Eq a => RightGCDMonoid (Vector.Vector a) where
-   stripCommonSuffix x y = findSuffix (Vector.length x - 1) (Vector.length y - 1)
-      where findSuffix m n | m >= 0 && n >= 0 && x Vector.! m == y Vector.! n =
-               findSuffix (pred m) (pred n)
-            findSuffix m n = (Vector.take (succ m) x, yp, ys)
-               where (yp, ys) = Vector.splitAt (succ n) y
-
--- ByteString instances
-
-instance LeftReductiveMonoid ByteString.ByteString where
-   stripPrefix p l = if ByteString.isPrefixOf p l
-                     then Just (ByteString.unsafeDrop (ByteString.length p) l)
-                     else Nothing
-   isPrefixOf = ByteString.isPrefixOf
-
-instance RightReductiveMonoid ByteString.ByteString where
-   stripSuffix s l = if ByteString.isSuffixOf s l
-                     then Just (ByteString.unsafeTake (ByteString.length l - ByteString.length s) l)
-                     else Nothing
-   isSuffixOf = ByteString.isSuffixOf
-
-instance LeftCancellativeMonoid ByteString.ByteString
-
-instance RightCancellativeMonoid ByteString.ByteString
-
-instance LeftGCDMonoid ByteString.ByteString where
-   stripCommonPrefix x y = (xp, xs, ByteString.unsafeDrop maxPrefixLength y)
-      where maxPrefixLength = prefixLength 0 (ByteString.length x `min` ByteString.length y)
-            prefixLength n len | n < len,
-                                 ByteString.unsafeIndex x n == ByteString.unsafeIndex y n =
-                                    prefixLength (succ n) len
-                               | otherwise = n
-            (xp, xs) = ByteString.splitAt maxPrefixLength x
-
-instance RightGCDMonoid ByteString.ByteString where
-   stripCommonSuffix x y = findSuffix (ByteString.length x - 1) (ByteString.length y - 1)
-      where findSuffix m n | m >= 0, n >= 0,
-                             ByteString.unsafeIndex x m == ByteString.unsafeIndex y n =
-                                findSuffix (pred m) (pred n)
-                           | otherwise = let (yp, ys) = ByteString.splitAt (succ n) y
-                                         in (ByteString.unsafeTake (succ m) x, yp, ys)
-
--- Lazy ByteString instances
-
-instance LeftReductiveMonoid LazyByteString.ByteString where
-   stripPrefix p l = if LazyByteString.isPrefixOf p l
-                     then Just (LazyByteString.drop (LazyByteString.length p) l)
-                     else Nothing
-   isPrefixOf = LazyByteString.isPrefixOf
-
-instance RightReductiveMonoid LazyByteString.ByteString where
-   stripSuffix s l = if LazyByteString.isSuffixOf s l
-                     then Just (LazyByteString.take (LazyByteString.length l - LazyByteString.length s) l)
-                     else Nothing
-   isSuffixOf = LazyByteString.isSuffixOf
-
-instance LeftCancellativeMonoid LazyByteString.ByteString
-
-instance RightCancellativeMonoid LazyByteString.ByteString
-
-instance LeftGCDMonoid LazyByteString.ByteString where
-   stripCommonPrefix x y = (xp, xs, LazyByteString.drop maxPrefixLength y)
-      where maxPrefixLength = prefixLength 0 (LazyByteString.length x `min` LazyByteString.length y)
-            prefixLength n len | n < len && LazyByteString.index x n == LazyByteString.index y n =
-               prefixLength (succ n) len
-            prefixLength n _ = n
-            (xp, xs) = LazyByteString.splitAt maxPrefixLength x
-
-instance RightGCDMonoid LazyByteString.ByteString where
-   stripCommonSuffix x y = findSuffix (LazyByteString.length x - 1) (LazyByteString.length y - 1)
-      where findSuffix m n | m >= 0 && n >= 0 && LazyByteString.index x m == LazyByteString.index y n =
-               findSuffix (pred m) (pred n)
-            findSuffix m n = (LazyByteString.take (succ m) x, yp, ys)
-               where (yp, ys) = LazyByteString.splitAt (succ n) y
-
--- Text instances
-
-instance LeftReductiveMonoid Text.Text where
-   stripPrefix = Text.stripPrefix
-   isPrefixOf = Text.isPrefixOf
-
-instance RightReductiveMonoid Text.Text where
-   stripSuffix = Text.stripSuffix
-   isSuffixOf = Text.isSuffixOf
-
-instance LeftCancellativeMonoid Text.Text
-
-instance RightCancellativeMonoid Text.Text
-
-instance LeftGCDMonoid Text.Text where
-   stripCommonPrefix x y = maybe (Text.empty, x, y) id (Text.commonPrefixes x y)
-
--- Lazy Text instances
-
-instance LeftReductiveMonoid LazyText.Text where
-   stripPrefix = LazyText.stripPrefix
-   isPrefixOf = LazyText.isPrefixOf
-
-instance RightReductiveMonoid LazyText.Text where
-   stripSuffix = LazyText.stripSuffix
-   isSuffixOf = LazyText.isSuffixOf
-
-instance LeftCancellativeMonoid LazyText.Text
-
-instance RightCancellativeMonoid LazyText.Text
-
-instance LeftGCDMonoid LazyText.Text where
-   stripCommonPrefix x y = maybe (LazyText.empty, x, y) id (LazyText.commonPrefixes x y)
diff --git a/Data/Monoid/Factorial.hs b/Data/Monoid/Factorial.hs
deleted file mode 100644
--- a/Data/Monoid/Factorial.hs
+++ /dev/null
@@ -1,827 +0,0 @@
-{- 
-    Copyright 2013-2015 Mario Blazevic
-
-    License: BSD3 (see BSD3-LICENSE.txt file)
--}
-
--- | This module defines the 'FactorialMonoid' class and some of its instances.
--- 
-
-{-# LANGUAGE Haskell2010, Trustworthy #-}
-
-module Data.Monoid.Factorial (
-   -- * Classes
-   FactorialMonoid(..), StableFactorialMonoid,
-   -- * Monad function equivalents
-   mapM, mapM_
-   )
-where
-
-import Control.Arrow (first)
-import qualified Control.Monad as Monad
-import Data.Monoid -- (Monoid (..), Dual(..), Sum(..), Product(..), Endo(Endo, appEndo))
-import qualified Data.Foldable as Foldable
-import qualified Data.List as List
-import qualified Data.ByteString 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 Data.Int (Int64)
-import Data.Numbers.Primes (primeFactors)
-
-import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)
-
-import Prelude hiding (break, drop, dropWhile, foldl, foldr, last, length, map, mapM, mapM_, max, min,
-                       null, reverse, span, splitAt, take, takeWhile)
-
-
--- | Class of monoids that can be split into irreducible (/i.e./, atomic or prime) 'factors' in a unique way. Factors of
--- a 'Product' are literally its prime factors:
---
--- prop> factors (Product 12) == [Product 2, Product 2, Product 3]
---
--- Factors of a list are /not/ its elements but all its single-item sublists:
---
--- prop> factors "abc" == ["a", "b", "c"]
--- 
--- The methods of this class satisfy the following laws:
--- 
--- > mconcat . factors == id
--- > null == List.null . factors
--- > List.all (\prime-> factors prime == [prime]) . factors
--- > factors == unfoldr splitPrimePrefix == List.reverse . unfoldr (fmap swap . splitPrimeSuffix)
--- > reverse == mconcat . List.reverse . factors
--- > primePrefix == maybe mempty fst . splitPrimePrefix
--- > primeSuffix == maybe mempty snd . splitPrimeSuffix
--- > inits == List.map mconcat . List.inits . factors
--- > tails == List.map mconcat . List.tails . factors
--- > foldl f a == List.foldl f a . factors
--- > foldl' f a == List.foldl' f a . factors
--- > foldr f a == List.foldr f a . factors
--- > span p m == (mconcat l, mconcat r) where (l, r) = List.span p (factors m)
--- > List.all (List.all (not . pred) . factors) . split pred
--- > mconcat . intersperse prime . split (== prime) == id
--- > splitAt i m == (mconcat l, mconcat r) where (l, r) = List.splitAt i (factors m)
--- > spanMaybe () (const $ bool Nothing (Maybe ()) . p) m == (takeWhile p m, dropWhile p m, ())
--- > spanMaybe s0 (\s m-> Just $ f s m) m0 == (m0, mempty, foldl f s0 m0)
--- > let (prefix, suffix, s') = spanMaybe s f m
--- >     foldMaybe = foldl g (Just s)
--- >     g s m = s >>= flip f m
--- > in all ((Nothing ==) . foldMaybe) (inits prefix)
--- >    && prefix == last (filter (isJust . foldMaybe) $ inits m)
--- >    && Just s' == foldMaybe prefix
--- >    && m == prefix <> suffix
---
--- A minimal instance definition must implement 'factors' or 'splitPrimePrefix'. Other methods are provided and should
--- be implemented only for performance reasons.
-class MonoidNull m => FactorialMonoid m where
-   -- | Returns a list of all prime factors; inverse of mconcat.
-   factors :: m -> [m]
-   -- | The prime prefix, 'mempty' if none.
-   primePrefix :: m -> m
-   -- | The prime suffix, 'mempty' if none.
-   primeSuffix :: m -> m
-   -- | Splits the argument into its prime prefix and the remaining suffix. Returns 'Nothing' for 'mempty'.
-   splitPrimePrefix :: m -> Maybe (m, m)
-   -- | Splits the argument into its prime suffix and the remaining prefix. Returns 'Nothing' for 'mempty'.
-   splitPrimeSuffix :: m -> Maybe (m, m)
-   -- | Returns the list of all prefixes of the argument, 'mempty' first.
-   inits :: m -> [m]
-   -- | Returns the list of all suffixes of the argument, 'mempty' last.
-   tails :: m -> [m]
-   -- | Like 'List.foldl' from "Data.List" on the list of 'primes'.
-   foldl :: (a -> m -> a) -> a -> m -> a
-   -- | Like 'List.foldl'' from "Data.List" on the list of 'primes'.
-   foldl' :: (a -> m -> a) -> a -> m -> a
-   -- | Like 'List.foldr' from "Data.List" on the list of 'primes'.
-   foldr :: (m -> a -> a) -> a -> m -> a
-   -- | The 'length' of the list of 'primes'.
-   length :: m -> Int
-   -- | Generalizes 'foldMap' from "Data.Foldable", except the function arguments are prime factors rather than the
-   -- structure elements.
-   foldMap :: Monoid n => (m -> n) -> m -> n
-   -- | Like 'List.span' from "Data.List" on the list of 'primes'.
-   span :: (m -> Bool) -> m -> (m, m)
-   -- | Equivalent to 'List.break' from "Data.List".
-   break :: (m -> Bool) -> m -> (m, m)
-   -- | Splits the monoid into components delimited by prime separators satisfying the given predicate. The primes
-   -- satisfying the predicate are not a part of the result.
-   split :: (m -> Bool) -> m -> [m]
-   -- | Equivalent to 'List.takeWhile' from "Data.List".
-   takeWhile :: (m -> Bool) -> m -> m
-   -- | Equivalent to 'List.dropWhile' from "Data.List".
-   dropWhile :: (m -> Bool) -> m -> m
-   -- | A stateful variant of 'span', threading the result of the test function as long as it returns 'Just'.
-   spanMaybe :: s -> (s -> m -> Maybe s) -> m -> (m, m, s)
-   -- | Strict version of 'spanMaybe'.
-   spanMaybe' :: s -> (s -> m -> Maybe s) -> m -> (m, m, s)
-   -- | Like 'List.splitAt' from "Data.List" on the list of 'primes'.
-   splitAt :: Int -> m -> (m, m)
-   -- | Equivalent to 'List.drop' from "Data.List".
-   drop :: Int -> m -> m
-   -- | Equivalent to 'List.take' from "Data.List".
-   take :: Int -> m -> m
-   -- | Equivalent to 'List.reverse' from "Data.List".
-   reverse :: m -> m
-
-   factors = List.unfoldr splitPrimePrefix
-   primePrefix = maybe mempty fst . splitPrimePrefix
-   primeSuffix = maybe mempty snd . splitPrimeSuffix
-   splitPrimePrefix x = case factors x
-                        of [] -> Nothing
-                           prefix : rest -> Just (prefix, mconcat rest)
-   splitPrimeSuffix x = case factors x
-                        of [] -> Nothing
-                           fs -> Just (mconcat (List.init fs), List.last fs)
-   inits = foldr (\m l-> mempty : List.map (mappend m) l) [mempty]
-   tails m = m : maybe [] (tails . snd) (splitPrimePrefix m)
-   foldl f f0 = List.foldl f f0 . factors
-   foldl' f f0 = List.foldl' f f0 . factors
-   foldr f f0 = List.foldr f f0 . factors
-   length = List.length . factors
-   foldMap f = foldr (mappend . f) mempty
-   span p m0 = spanAfter id m0
-      where spanAfter f m = case splitPrimePrefix m
-                            of Just (prime, rest) | p prime -> spanAfter (f . mappend prime) rest
-                               _ -> (f mempty, m)
-   break = span . (not .)
-   spanMaybe s0 f m0 = spanAfter id s0 m0
-      where spanAfter g s m = case splitPrimePrefix m
-                              of Just (prime, rest) | Just s' <- f s prime -> spanAfter (g . mappend prime) s' rest
-                                                    | otherwise -> (g mempty, m, s)
-                                 Nothing -> (m0, m, s)
-   spanMaybe' s0 f m0 = spanAfter id s0 m0
-      where spanAfter g s m = seq s $
-                              case splitPrimePrefix m
-                              of Just (prime, rest) | Just s' <- f s prime -> spanAfter (g . mappend prime) s' rest
-                                                    | otherwise -> (g mempty, m, s)
-                                 Nothing -> (m0, m, s)
-   split p m = prefix : splitRest
-      where (prefix, rest) = break p m
-            splitRest = case splitPrimePrefix rest
-                        of Nothing -> []
-                           Just (_, tl) -> split p tl
-   takeWhile p = fst . span p
-   dropWhile p = snd . span p
-   splitAt n0 m0 | n0 <= 0 = (mempty, m0)
-                 | otherwise = split' n0 id m0
-      where split' 0 f m = (f mempty, m)
-            split' n f m = case splitPrimePrefix m
-                           of Nothing -> (f mempty, m)
-                              Just (prime, rest) -> split' (pred n) (f . mappend prime) rest
-   drop n p = snd (splitAt n p)
-   take n p = fst (splitAt n p)
-   reverse = mconcat . List.reverse . factors
-   {-# MINIMAL factors | splitPrimePrefix #-}
-
--- | A subclass of 'FactorialMonoid' whose instances satisfy this additional law:
---
--- > factors (a <> b) == factors a <> factors b
-class (FactorialMonoid m, PositiveMonoid m) => StableFactorialMonoid m
-
-instance FactorialMonoid () where
-   factors () = []
-   primePrefix () = ()
-   primeSuffix () = ()
-   splitPrimePrefix () = Nothing
-   splitPrimeSuffix () = Nothing
-   length () = 0
-   reverse = id
-
-instance FactorialMonoid a => FactorialMonoid (Dual a) where
-   factors (Dual a) = fmap Dual (reverse $ factors a)
-   length (Dual a) = length a
-   primePrefix (Dual a) = Dual (primeSuffix a)
-   primeSuffix (Dual a) = Dual (primePrefix a)
-   splitPrimePrefix (Dual a) = case splitPrimeSuffix a
-                               of Nothing -> Nothing
-                                  Just (p, s) -> Just (Dual s, Dual p)
-   splitPrimeSuffix (Dual a) = case splitPrimePrefix a
-                               of Nothing -> Nothing
-                                  Just (p, s) -> Just (Dual s, Dual p)
-   inits (Dual a) = fmap Dual (reverse $ tails a)
-   tails (Dual a) = fmap Dual (reverse $ inits a)
-   reverse (Dual a) = Dual (reverse a)
-
-instance (Integral a, Eq a) => FactorialMonoid (Sum a) where
-   primePrefix (Sum a) = Sum (signum a )
-   primeSuffix = primePrefix
-   splitPrimePrefix (Sum 0) = Nothing
-   splitPrimePrefix (Sum a) = Just (Sum (signum a), Sum (a - signum a))
-   splitPrimeSuffix (Sum 0) = Nothing
-   splitPrimeSuffix (Sum a) = Just (Sum (a - signum a), Sum (signum a))
-   length (Sum a) = abs (fromIntegral a)
-   reverse = id
-
-instance Integral a => FactorialMonoid (Product a) where
-   factors (Product a) = List.map Product (primeFactors a)
-   reverse = id
-
-instance FactorialMonoid a => FactorialMonoid (Maybe a) where
-   factors Nothing = []
-   factors (Just a) | null a = [Just a]
-                    | otherwise = List.map Just (factors a)
-   length Nothing = 0
-   length (Just a) | null a = 1
-                   | otherwise = length a
-   reverse = fmap reverse
-
-instance (FactorialMonoid a, FactorialMonoid b) => FactorialMonoid (a, b) where
-   factors (a, b) = List.map (\a1-> (a1, mempty)) (factors a) ++ List.map ((,) mempty) (factors b)
-   primePrefix (a, b) | null a = (a, primePrefix b)
-                      | otherwise = (primePrefix a, mempty)
-   primeSuffix (a, b) | null b = (primeSuffix a, b)
-                      | otherwise = (mempty, primeSuffix b)
-   splitPrimePrefix (a, b) = case (splitPrimePrefix a, splitPrimePrefix b)
-                             of (Just (ap, as), _) -> Just ((ap, mempty), (as, b))
-                                (Nothing, Just (bp, bs)) -> Just ((a, bp), (a, bs))
-                                (Nothing, Nothing) -> Nothing
-   splitPrimeSuffix (a, b) = case (splitPrimeSuffix a, splitPrimeSuffix b)
-                             of (_, Just (bp, bs)) -> Just ((a, bp), (mempty, bs))
-                                (Just (ap, as), Nothing) -> Just ((ap, b), (as, b))
-                                (Nothing, Nothing) -> Nothing
-   inits (a, b) = List.map (flip (,) mempty) (inits a) ++ List.map ((,) a) (List.tail $ inits b)
-   tails (a, b) = List.map (flip (,) b) (tails a) ++ List.map ((,) mempty) (List.tail $ tails b)
-   foldl f a0 (x, y) = foldl f2 (foldl f1 a0 x) y
-      where f1 a = f a . fromFst
-            f2 a = f a . fromSnd
-   foldl' f a0 (x, y) = a' `seq` foldl' f2 a' y
-      where f1 a = f a . fromFst
-            f2 a = f a . fromSnd
-            a' = foldl' f1 a0 x
-   foldr f a (x, y) = foldr (f . fromFst) (foldr (f . fromSnd) a y) x
-   foldMap f (x, y) = Data.Monoid.Factorial.foldMap (f . fromFst) x `mappend` Data.Monoid.Factorial.foldMap (f . fromSnd) y
-   length (a, b) = length a + length b
-   span p (x, y) = ((xp, yp), (xs, ys))
-      where (xp, xs) = span (p . fromFst) x
-            (yp, ys) | null xs = span (p . fromSnd) y
-                     | otherwise = (mempty, y)
-   spanMaybe s0 f (x, y) | null xs = ((xp, yp), (xs, ys), s2)
-                         | otherwise = ((xp, mempty), (xs, y), s1)
-     where (xp, xs, s1) = spanMaybe s0 (\s-> f s . fromFst) x
-           (yp, ys, s2) = spanMaybe s1 (\s-> f s . fromSnd) y
-   spanMaybe' s0 f (x, y) | null xs = ((xp, yp), (xs, ys), s2)
-                          | otherwise = ((xp, mempty), (xs, y), s1)
-     where (xp, xs, s1) = spanMaybe' s0 (\s-> f s . fromFst) x
-           (yp, ys, s2) = spanMaybe' s1 (\s-> f s . fromSnd) y
-   split p (x0, y0) = fst $ List.foldr combine (ys, False) xs
-      where xs = List.map fromFst $ split (p . fromFst) x0
-            ys = List.map fromSnd $ split (p . fromSnd) y0
-            combine x (~(y:rest), False) = (mappend x y : rest, True)
-            combine x (rest, True) = (x:rest, True)
-   splitAt n (x, y) = ((xp, yp), (xs, ys))
-      where (xp, xs) = splitAt n x
-            (yp, ys) | null xs = splitAt (n - length x) y
-                     | otherwise = (mempty, y)
-   reverse (a, b) = (reverse a, reverse b)
-
-{-# INLINE fromFst #-}
-fromFst :: Monoid b => a -> (a, b)
-fromFst a = (a, mempty)
-
-{-# INLINE fromSnd #-}
-fromSnd :: Monoid a => b -> (a, b)
-fromSnd b = (mempty, b)
-
-instance (FactorialMonoid a, FactorialMonoid b, FactorialMonoid c) => FactorialMonoid (a, b, c) where
-   factors (a, b, c) = List.map (\a1-> (a1, mempty, mempty)) (factors a)
-                       ++ List.map (\b1-> (mempty, b1, mempty)) (factors b)
-                       ++ List.map (\c1-> (mempty, mempty, c1)) (factors c)
-   primePrefix (a, b, c) | not (null a) = (primePrefix a, mempty, mempty)
-                         | not (null b) = (mempty, primePrefix b, mempty)
-                         | otherwise = (mempty, mempty, primePrefix c)
-   primeSuffix (a, b, c) | not (null c) = (mempty, mempty, primeSuffix c)
-                         | not (null b) = (mempty, primeSuffix b, mempty)
-                         | otherwise = (primeSuffix a, mempty, mempty)
-   splitPrimePrefix (a, b, c) = case (splitPrimePrefix a, splitPrimePrefix b, splitPrimePrefix c)
-                                of (Just (ap, as), _, _) -> Just ((ap, mempty, mempty), (as, b, c))
-                                   (Nothing, Just (bp, bs), _) -> Just ((a, bp, mempty), (a, bs, c))
-                                   (Nothing, Nothing, Just (cp, cs)) -> Just ((a, b, cp), (a, b, cs))
-                                   (Nothing, Nothing, Nothing) -> Nothing
-   splitPrimeSuffix (a, b, c) = case (splitPrimeSuffix a, splitPrimeSuffix b, splitPrimeSuffix c)
-                                of (_, _, Just (cp, cs)) -> Just ((a, b, cp), (mempty, mempty, cs))
-                                   (_, Just (bp, bs), Nothing) -> Just ((a, bp, c), (mempty, bs, c))
-                                   (Just (ap, as), Nothing, Nothing) -> Just ((ap, b, c), (as, b, c))
-                                   (Nothing, Nothing, Nothing) -> Nothing
-   inits (a, b, c) = List.map (\a1-> (a1, mempty, mempty)) (inits a)
-                     ++ List.map (\b1-> (a, b1, mempty)) (List.tail $ inits b)
-                     ++ List.map (\c1-> (a, b, c1)) (List.tail $ inits c)
-   tails (a, b, c) = List.map (\a1-> (a1, b, c)) (tails a)
-                     ++ List.map (\b1-> (mempty, b1, c)) (List.tail $ tails b)
-                     ++ List.map (\c1-> (mempty, mempty, c1)) (List.tail $ tails c)
-   foldl f s0 (a, b, c) = foldl f3 (foldl f2 (foldl f1 s0 a) b) c
-      where f1 x = f x . fromFstOf3
-            f2 x = f x . fromSndOf3
-            f3 x = f x . fromThdOf3
-   foldl' f s0 (a, b, c) = a' `seq` b' `seq` foldl' f3 b' c
-      where f1 x = f x . fromFstOf3
-            f2 x = f x . fromSndOf3
-            f3 x = f x . fromThdOf3
-            a' = foldl' f1 s0 a
-            b' = foldl' f2 a' b
-   foldr f s (a, b, c) = foldr (f . fromFstOf3) (foldr (f . fromSndOf3) (foldr (f . fromThdOf3) s c) b) a
-   foldMap f (a, b, c) = Data.Monoid.Factorial.foldMap (f . fromFstOf3) a
-                         `mappend` Data.Monoid.Factorial.foldMap (f . fromSndOf3) b
-                         `mappend` Data.Monoid.Factorial.foldMap (f . fromThdOf3) c
-   length (a, b, c) = length a + length b + length c
-   span p (a, b, c) = ((ap, bp, cp), (as, bs, cs))
-      where (ap, as) = span (p . fromFstOf3) a
-            (bp, bs) | null as = span (p . fromSndOf3) b
-                     | otherwise = (mempty, b)
-            (cp, cs) | null as && null bs = span (p . fromThdOf3) c
-                     | otherwise = (mempty, c)
-   spanMaybe s0 f (a, b, c) | not (null as) = ((ap, mempty, mempty), (as, b, c), s1)
-                            | not (null bs) = ((ap, bp, mempty), (as, bs, c), s2)
-                            | otherwise = ((ap, bp, cp), (as, bs, cs), s3)
-     where (ap, as, s1) = spanMaybe s0 (\s-> f s . fromFstOf3) a
-           (bp, bs, s2) = spanMaybe s1 (\s-> f s . fromSndOf3) b
-           (cp, cs, s3) = spanMaybe s2 (\s-> f s . fromThdOf3) c
-   spanMaybe' s0 f (a, b, c) | not (null as) = ((ap, mempty, mempty), (as, b, c), s1)
-                             | not (null bs) = ((ap, bp, mempty), (as, bs, c), s2)
-                             | otherwise = ((ap, bp, cp), (as, bs, cs), s3)
-     where (ap, as, s1) = spanMaybe' s0 (\s-> f s . fromFstOf3) a
-           (bp, bs, s2) = spanMaybe' s1 (\s-> f s . fromSndOf3) b
-           (cp, cs, s3) = spanMaybe' s2 (\s-> f s . fromThdOf3) c
-   splitAt n (a, b, c) = ((ap, bp, cp), (as, bs, cs))
-      where (ap, as) = splitAt n a
-            (bp, bs) | null as = splitAt (n - length a) b
-                     | otherwise = (mempty, b)
-            (cp, cs) | null as && null bs = splitAt (n - length a - length b) c
-                     | otherwise = (mempty, c)
-   reverse (a, b, c) = (reverse a, reverse b, reverse c)
-
-{-# INLINE fromFstOf3 #-}
-fromFstOf3 :: (Monoid b, Monoid c) => a -> (a, b, c)
-fromFstOf3 a = (a, mempty, mempty)
-
-{-# INLINE fromSndOf3 #-}
-fromSndOf3 :: (Monoid a, Monoid c) => b -> (a, b, c)
-fromSndOf3 b = (mempty, b, mempty)
-
-{-# INLINE fromThdOf3 #-}
-fromThdOf3 :: (Monoid a, Monoid b) => c -> (a, b, c)
-fromThdOf3 c = (mempty, mempty, c)
-
-instance (FactorialMonoid a, FactorialMonoid b, FactorialMonoid c, FactorialMonoid d) =>
-         FactorialMonoid (a, b, c, d) where
-   factors (a, b, c, d) = List.map (\a1-> (a1, mempty, mempty, mempty)) (factors a)
-                          ++ List.map (\b1-> (mempty, b1, mempty, mempty)) (factors b)
-                          ++ List.map (\c1-> (mempty, mempty, c1, mempty)) (factors c)
-                          ++ List.map (\d1-> (mempty, mempty, mempty, d1)) (factors d)
-   primePrefix (a, b, c, d) | not (null a) = (primePrefix a, mempty, mempty, mempty)
-                            | not (null b) = (mempty, primePrefix b, mempty, mempty)
-                            | not (null c) = (mempty, mempty, primePrefix c, mempty)
-                            | otherwise    = (mempty, mempty, mempty, primePrefix d)
-   primeSuffix (a, b, c, d) | not (null d) = (mempty, mempty, mempty, primeSuffix d)
-                            | not (null c) = (mempty, mempty, primeSuffix c, mempty)
-                            | not (null b) = (mempty, primeSuffix b, mempty, mempty)
-                            | otherwise    = (primeSuffix a, mempty, mempty, mempty)
-   splitPrimePrefix (a, b, c, d) = case (splitPrimePrefix a, splitPrimePrefix b, splitPrimePrefix c, splitPrimePrefix d)
-                                   of (Just (ap, as), _, _, _) -> Just ((ap, mempty, mempty, mempty), (as, b, c, d))
-                                      (Nothing, Just (bp, bs), _, _) -> Just ((a, bp, mempty, mempty), (a, bs, c, d))
-                                      (Nothing, Nothing, Just (cp, cs), _) -> Just ((a, b, cp, mempty), (a, b, cs, d))
-                                      (Nothing, Nothing, Nothing, Just (dp, ds)) -> Just ((a, b, c, dp), (a, b, c, ds))
-                                      (Nothing, Nothing, Nothing, Nothing) -> Nothing
-   splitPrimeSuffix (a, b, c, d) = case (splitPrimeSuffix a, splitPrimeSuffix b, splitPrimeSuffix c, splitPrimeSuffix d)
-                                   of (_, _, _, Just (dp, ds)) -> Just ((a, b, c, dp), (mempty, mempty, mempty, ds))
-                                      (_, _, Just (cp, cs), Nothing) -> Just ((a, b, cp, d), (mempty, mempty, cs, d))
-                                      (_, Just (bp, bs), Nothing, Nothing) -> Just ((a, bp, c, d), (mempty, bs, c, d))
-                                      (Just (ap, as), Nothing, Nothing, Nothing) -> Just ((ap, b, c, d), (as, b, c, d))
-                                      (Nothing, Nothing, Nothing, Nothing) -> Nothing
-   inits (a, b, c, d) = List.map (\a1-> (a1, mempty, mempty, mempty)) (inits a)
-                        ++ List.map (\b1-> (a, b1, mempty, mempty)) (List.tail $ inits b)
-                        ++ List.map (\c1-> (a, b, c1, mempty)) (List.tail $ inits c)
-                        ++ List.map (\d1-> (a, b, c, d1)) (List.tail $ inits d)
-   tails (a, b, c, d) = List.map (\a1-> (a1, b, c, d)) (tails a)
-                        ++ List.map (\b1-> (mempty, b1, c, d)) (List.tail $ tails b)
-                        ++ List.map (\c1-> (mempty, mempty, c1, d)) (List.tail $ tails c)
-                        ++ List.map (\d1-> (mempty, mempty, mempty, d1)) (List.tail $ tails d)
-   foldl f s0 (a, b, c, d) = foldl f4 (foldl f3 (foldl f2 (foldl f1 s0 a) b) c) d
-      where f1 x = f x . fromFstOf4
-            f2 x = f x . fromSndOf4
-            f3 x = f x . fromThdOf4
-            f4 x = f x . fromFthOf4
-   foldl' f s0 (a, b, c, d) = a' `seq` b' `seq` c' `seq` foldl' f4 c' d
-      where f1 x = f x . fromFstOf4
-            f2 x = f x . fromSndOf4
-            f3 x = f x . fromThdOf4
-            f4 x = f x . fromFthOf4
-            a' = foldl' f1 s0 a
-            b' = foldl' f2 a' b
-            c' = foldl' f3 b' c
-   foldr f s (a, b, c, d) =
-      foldr (f . fromFstOf4) (foldr (f . fromSndOf4) (foldr (f . fromThdOf4) (foldr (f . fromFthOf4) s d) c) b) a
-   foldMap f (a, b, c, d) = Data.Monoid.Factorial.foldMap (f . fromFstOf4) a
-                            `mappend` Data.Monoid.Factorial.foldMap (f . fromSndOf4) b
-                            `mappend` Data.Monoid.Factorial.foldMap (f . fromThdOf4) c
-                            `mappend` Data.Monoid.Factorial.foldMap (f . fromFthOf4) d
-   length (a, b, c, d) = length a + length b + length c + length d
-   span p (a, b, c, d) = ((ap, bp, cp, dp), (as, bs, cs, ds))
-      where (ap, as) = span (p . fromFstOf4) a
-            (bp, bs) | null as = span (p . fromSndOf4) b
-                     | otherwise = (mempty, b)
-            (cp, cs) | null as && null bs = span (p . fromThdOf4) c
-                     | otherwise = (mempty, c)
-            (dp, ds) | null as && null bs && null cs = span (p . fromFthOf4) d
-                     | otherwise = (mempty, d)
-   spanMaybe s0 f (a, b, c, d) | not (null as) = ((ap, mempty, mempty, mempty), (as, b, c, d), s1)
-                               | not (null bs) = ((ap, bp, mempty, mempty), (as, bs, c, d), s2)
-                               | not (null cs) = ((ap, bp, cp, mempty), (as, bs, cs, d), s3)
-                               | otherwise = ((ap, bp, cp, dp), (as, bs, cs, ds), s4)
-     where (ap, as, s1) = spanMaybe s0 (\s-> f s . fromFstOf4) a
-           (bp, bs, s2) = spanMaybe s1 (\s-> f s . fromSndOf4) b
-           (cp, cs, s3) = spanMaybe s2 (\s-> f s . fromThdOf4) c
-           (dp, ds, s4) = spanMaybe s3 (\s-> f s . fromFthOf4) d
-   spanMaybe' s0 f (a, b, c, d) | not (null as) = ((ap, mempty, mempty, mempty), (as, b, c, d), s1)
-                               | not (null bs) = ((ap, bp, mempty, mempty), (as, bs, c, d), s2)
-                               | not (null cs) = ((ap, bp, cp, mempty), (as, bs, cs, d), s3)
-                               | otherwise = ((ap, bp, cp, dp), (as, bs, cs, ds), s4)
-     where (ap, as, s1) = spanMaybe' s0 (\s-> f s . fromFstOf4) a
-           (bp, bs, s2) = spanMaybe' s1 (\s-> f s . fromSndOf4) b
-           (cp, cs, s3) = spanMaybe' s2 (\s-> f s . fromThdOf4) c
-           (dp, ds, s4) = spanMaybe' s3 (\s-> f s . fromFthOf4) d
-   splitAt n (a, b, c, d) = ((ap, bp, cp, dp), (as, bs, cs, ds))
-      where (ap, as) = splitAt n a
-            (bp, bs) | null as = splitAt (n - length a) b
-                     | otherwise = (mempty, b)
-            (cp, cs) | null as && null bs = splitAt (n - length a - length b) c
-                     | otherwise = (mempty, c)
-            (dp, ds) | null as && null bs && null cs = splitAt (n - length a - length b - length c) d
-                     | otherwise = (mempty, d)
-   reverse (a, b, c, d) = (reverse a, reverse b, reverse c, reverse d)
-
-{-# INLINE fromFstOf4 #-}
-fromFstOf4 :: (Monoid b, Monoid c, Monoid d) => a -> (a, b, c, d)
-fromFstOf4 a = (a, mempty, mempty, mempty)
-
-{-# INLINE fromSndOf4 #-}
-fromSndOf4 :: (Monoid a, Monoid c, Monoid d) => b -> (a, b, c, d)
-fromSndOf4 b = (mempty, b, mempty, mempty)
-
-{-# INLINE fromThdOf4 #-}
-fromThdOf4 :: (Monoid a, Monoid b, Monoid d) => c -> (a, b, c, d)
-fromThdOf4 c = (mempty, mempty, c, mempty)
-
-{-# INLINE fromFthOf4 #-}
-fromFthOf4 :: (Monoid a, Monoid b, Monoid c) => d -> (a, b, c, d)
-fromFthOf4 d = (mempty, mempty, mempty, d)
-
-instance FactorialMonoid [x] where
-   factors xs = List.map (:[]) xs
-   primePrefix [] = []
-   primePrefix (x:_) = [x]
-   primeSuffix [] = []
-   primeSuffix xs = [List.last xs]
-   splitPrimePrefix [] = Nothing
-   splitPrimePrefix (x:xs) = Just ([x], xs)
-   splitPrimeSuffix [] = Nothing
-   splitPrimeSuffix xs = Just (splitLast id xs)
-      where splitLast f last@[_] = (f [], last)
-            splitLast f ~(x:rest) = splitLast (f . (x:)) rest
-   inits = List.inits
-   tails = List.tails
-   foldl _ a [] = a
-   foldl f a (x:xs) = foldl f (f a [x]) xs
-   foldl' _ a [] = a
-   foldl' f a (x:xs) = let a' = f a [x] in a' `seq` foldl' f a' xs
-   foldr _ f0 [] = f0
-   foldr f f0 (x:xs) = f [x] (foldr f f0 xs)
-   length = List.length
-   foldMap f = mconcat . List.map (f . (:[]))
-   break f = List.break (f . (:[]))
-   span f = List.span (f . (:[]))
-   dropWhile f = List.dropWhile (f . (:[]))
-   takeWhile f = List.takeWhile (f . (:[]))
-   spanMaybe s0 f l = (prefix' [], suffix' [], s')
-      where (prefix', suffix', s', _) = List.foldl' g (id, id, s0, True) l
-            g (prefix, suffix, s1, live) x | live, Just s2 <- f s1 [x] = (prefix . (x:), id, s2, True)
-                                           | otherwise = (prefix, suffix . (x:), s1, False)
-   spanMaybe' s0 f l = (prefix' [], suffix' [], s')
-      where (prefix', suffix', s', _) = List.foldl' g (id, id, s0, True) l
-            g (prefix, suffix, s1, live) x | live, Just s2 <- f s1 [x] = seq s2 $ (prefix . (x:), id, s2, True)
-                                           | otherwise = (prefix, suffix . (x:), s1, False)
-   splitAt = List.splitAt
-   drop = List.drop
-   take = List.take
-   reverse = List.reverse
-
-instance FactorialMonoid ByteString.ByteString where
-   factors x = factorize (ByteString.length x) x
-      where factorize 0 _ = []
-            factorize n xs = xs1 : factorize (pred n) xs'
-              where (xs1, xs') = ByteString.splitAt 1 xs
-   primePrefix = ByteString.take 1
-   primeSuffix x = ByteString.drop (ByteString.length x - 1) x
-   splitPrimePrefix x = if ByteString.null x then Nothing else Just (ByteString.splitAt 1 x)
-   splitPrimeSuffix x = if ByteString.null x then Nothing else Just (ByteString.splitAt (ByteString.length x - 1) x)
-   inits = ByteString.inits
-   tails = ByteString.tails
-   foldl f = ByteString.foldl f'
-      where f' a byte = f a (ByteString.singleton byte)
-   foldl' f = ByteString.foldl' f'
-      where f' a byte = f a (ByteString.singleton byte)
-   foldr f = ByteString.foldr (f . ByteString.singleton)
-   break f = ByteString.break (f . ByteString.singleton)
-   span f = ByteString.span (f . ByteString.singleton)
-   spanMaybe s0 f b = case ByteString.foldr g id b (0, s0)
-                      of (i, s') | (prefix, suffix) <- ByteString.splitAt i b -> (prefix, suffix, s')
-      where g w cont (i, s) | Just s' <- f s (ByteString.singleton w) = let i' = succ i :: Int in seq i' $ cont (i', s')
-                            | otherwise = (i, s)
-   spanMaybe' s0 f b = case ByteString.foldr g id b (0, s0)
-                       of (i, s') | (prefix, suffix) <- ByteString.splitAt i b -> (prefix, suffix, s')
-      where g w cont (i, s) | Just s' <- f s (ByteString.singleton w) = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')
-                            | otherwise = (i, s)
-   dropWhile f = ByteString.dropWhile (f . ByteString.singleton)
-   takeWhile f = ByteString.takeWhile (f . ByteString.singleton)
-   length = ByteString.length
-   split f = ByteString.splitWith f'
-      where f' = f . ByteString.singleton
-   splitAt = ByteString.splitAt
-   drop = ByteString.drop
-   take = ByteString.take
-   reverse = ByteString.reverse
-
-instance FactorialMonoid LazyByteString.ByteString where
-   factors x = factorize (LazyByteString.length x) x
-      where factorize 0 _ = []
-            factorize n xs = xs1 : factorize (pred n) xs'
-               where (xs1, xs') = LazyByteString.splitAt 1 xs
-   primePrefix = LazyByteString.take 1
-   primeSuffix x = LazyByteString.drop (LazyByteString.length x - 1) x
-   splitPrimePrefix x = if LazyByteString.null x then Nothing
-                        else Just (LazyByteString.splitAt 1 x)
-   splitPrimeSuffix x = if LazyByteString.null x then Nothing
-                        else Just (LazyByteString.splitAt (LazyByteString.length x - 1) x)
-   inits = LazyByteString.inits
-   tails = LazyByteString.tails
-   foldl f = LazyByteString.foldl f'
-      where f' a byte = f a (LazyByteString.singleton byte)
-   foldl' f = LazyByteString.foldl' f'
-      where f' a byte = f a (LazyByteString.singleton byte)
-   foldr f = LazyByteString.foldr f'
-      where f' byte a = f (LazyByteString.singleton byte) a
-   length = fromIntegral . LazyByteString.length
-   break f = LazyByteString.break (f . LazyByteString.singleton)
-   span f = LazyByteString.span (f . LazyByteString.singleton)
-   spanMaybe s0 f b = case LazyByteString.foldr g id b (0, s0)
-                      of (i, s') | (prefix, suffix) <- LazyByteString.splitAt i b -> (prefix, suffix, s')
-      where g w cont (i, s) | Just s' <- f s (LazyByteString.singleton w) = let i' = succ i :: Int64 in seq i' $ cont (i', s')
-                            | otherwise = (i, s)
-   spanMaybe' s0 f b = case LazyByteString.foldr g id b (0, s0)
-                       of (i, s') | (prefix, suffix) <- LazyByteString.splitAt i b -> (prefix, suffix, s')
-      where g w cont (i, s)
-              | Just s' <- f s (LazyByteString.singleton w) = let i' = succ i :: Int64 in seq i' $ seq s' $ cont (i', s')
-              | otherwise = (i, s)
-   dropWhile f = LazyByteString.dropWhile (f . LazyByteString.singleton)
-   takeWhile f = LazyByteString.takeWhile (f . LazyByteString.singleton)
-   split f = LazyByteString.splitWith f'
-      where f' = f . LazyByteString.singleton
-   splitAt = LazyByteString.splitAt . fromIntegral
-   drop n = LazyByteString.drop (fromIntegral n)
-   take n = LazyByteString.take (fromIntegral n)
-   reverse = LazyByteString.reverse
-
-instance FactorialMonoid Text.Text where
-   factors = Text.chunksOf 1
-   primePrefix = Text.take 1
-   primeSuffix x = if Text.null x then Text.empty else Text.singleton (Text.last x)
-   splitPrimePrefix = fmap (first Text.singleton) . Text.uncons
-   splitPrimeSuffix x = if Text.null x then Nothing else Just (Text.init x, Text.singleton (Text.last x))
-   inits = Text.inits
-   tails = Text.tails
-   foldl f = Text.foldl f'
-      where f' a char = f a (Text.singleton char)
-   foldl' f = Text.foldl' f'
-      where f' a char = f a (Text.singleton char)
-   foldr f = Text.foldr f'
-      where f' char a = f (Text.singleton char) a
-   length = Text.length
-   span f = Text.span (f . Text.singleton)
-   break f = Text.break (f . Text.singleton)
-   dropWhile f = Text.dropWhile (f . Text.singleton)
-   takeWhile f = Text.takeWhile (f . Text.singleton)
-   spanMaybe s0 f t = case Text.foldr g id t (0, s0)
-                      of (i, s') | (prefix, suffix) <- Text.splitAt i t -> (prefix, suffix, s')
-      where g c cont (i, s) | Just s' <- f s (Text.singleton c) = let i' = succ i :: Int in seq i' $ cont (i', s')
-                            | otherwise = (i, s)
-   spanMaybe' s0 f t = case Text.foldr g id t (0, s0)
-                       of (i, s') | (prefix, suffix) <- Text.splitAt i t -> (prefix, suffix, s')
-      where g c cont (i, s) | Just s' <- f s (Text.singleton c) = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')
-                            | otherwise = (i, s)
-   split f = Text.split f'
-      where f' = f . Text.singleton
-   splitAt = Text.splitAt
-   drop = Text.drop
-   take = Text.take
-   reverse = Text.reverse
-
-instance FactorialMonoid LazyText.Text where
-   factors = LazyText.chunksOf 1
-   primePrefix = LazyText.take 1
-   primeSuffix x = if LazyText.null x then LazyText.empty else LazyText.singleton (LazyText.last x)
-   splitPrimePrefix = fmap (first LazyText.singleton) . LazyText.uncons
-   splitPrimeSuffix x = if LazyText.null x
-                        then Nothing
-                        else Just (LazyText.init x, LazyText.singleton (LazyText.last x))
-   inits = LazyText.inits
-   tails = LazyText.tails
-   foldl f = LazyText.foldl f'
-      where f' a char = f a (LazyText.singleton char)
-   foldl' f = LazyText.foldl' f'
-      where f' a char = f a (LazyText.singleton char)
-   foldr f = LazyText.foldr f'
-      where f' char a = f (LazyText.singleton char) a
-   length = fromIntegral . LazyText.length
-   span f = LazyText.span (f . LazyText.singleton)
-   break f = LazyText.break (f . LazyText.singleton)
-   dropWhile f = LazyText.dropWhile (f . LazyText.singleton)
-   takeWhile f = LazyText.takeWhile (f . LazyText.singleton)
-   spanMaybe s0 f t = case LazyText.foldr g id t (0, s0)
-                      of (i, s') | (prefix, suffix) <- LazyText.splitAt i t -> (prefix, suffix, s')
-      where g c cont (i, s) | Just s' <- f s (LazyText.singleton c) = let i' = succ i :: Int64 in seq i' $ cont (i', s')
-                            | otherwise = (i, s)
-   spanMaybe' s0 f t = case LazyText.foldr g id t (0, s0)
-                       of (i, s') | (prefix, suffix) <- LazyText.splitAt i t -> (prefix, suffix, s')
-      where g c cont (i, s) | Just s' <- f s (LazyText.singleton c) = let i' = succ i :: Int64 in seq i' $ seq s' $ cont (i', s')
-                            | otherwise = (i, s)
-   split f = LazyText.split f'
-      where f' = f . LazyText.singleton
-   splitAt = LazyText.splitAt . fromIntegral
-   drop n = LazyText.drop (fromIntegral n)
-   take n = LazyText.take (fromIntegral n)
-   reverse = LazyText.reverse
-
-instance Ord k => FactorialMonoid (Map.Map k v) where
-   factors = List.map (uncurry Map.singleton) . Map.toAscList
-   primePrefix map | Map.null map = map
-                   | otherwise = uncurry Map.singleton $ Map.findMin map
-   primeSuffix map | Map.null map = map
-                   | otherwise = uncurry Map.singleton $ Map.findMax map
-   splitPrimePrefix = fmap singularize . Map.minViewWithKey
-      where singularize ((k, v), rest) = (Map.singleton k v, rest)
-   splitPrimeSuffix = fmap singularize . Map.maxViewWithKey
-      where singularize ((k, v), rest) = (rest, Map.singleton k v)
-   foldl f = Map.foldlWithKey f'
-      where f' a k v = f a (Map.singleton k v)
-   foldl' f = Map.foldlWithKey' f'
-      where f' a k v = f a (Map.singleton k v)
-   foldr f = Map.foldrWithKey f'
-      where f' k v a = f (Map.singleton k v) a
-   length = Map.size
-   reverse = id
-
-instance FactorialMonoid (IntMap.IntMap a) where
-   factors = List.map (uncurry IntMap.singleton) . IntMap.toAscList
-   primePrefix map | IntMap.null map = map
-                   | otherwise = uncurry IntMap.singleton $ IntMap.findMin map
-   primeSuffix map | IntMap.null map = map
-                   | otherwise = uncurry IntMap.singleton $ IntMap.findMax map
-   splitPrimePrefix = fmap singularize . IntMap.minViewWithKey
-      where singularize ((k, v), rest) = (IntMap.singleton k v, rest)
-   splitPrimeSuffix = fmap singularize . IntMap.maxViewWithKey
-      where singularize ((k, v), rest) = (rest, IntMap.singleton k v)
-   foldl f = IntMap.foldlWithKey f'
-      where f' a k v = f a (IntMap.singleton k v)
-   foldl' f = IntMap.foldlWithKey' f'
-      where f' a k v = f a (IntMap.singleton k v)
-   foldr f = IntMap.foldrWithKey f'
-      where f' k v a = f (IntMap.singleton k v) a
-   length = IntMap.size
-   reverse = id
-
-instance FactorialMonoid IntSet.IntSet where
-   factors = List.map IntSet.singleton . IntSet.toAscList
-   primePrefix set | IntSet.null set = set
-                   | otherwise = IntSet.singleton $ IntSet.findMin set
-   primeSuffix set | IntSet.null set = set
-                   | otherwise = IntSet.singleton $ IntSet.findMax set
-   splitPrimePrefix = fmap singularize . IntSet.minView
-      where singularize (min, rest) = (IntSet.singleton min, rest)
-   splitPrimeSuffix = fmap singularize . IntSet.maxView
-      where singularize (max, rest) = (rest, IntSet.singleton max)
-   foldl f = IntSet.foldl f'
-      where f' a b = f a (IntSet.singleton b)
-   foldl' f = IntSet.foldl' f'
-      where f' a b = f a (IntSet.singleton b)
-   foldr f = IntSet.foldr f'
-      where f' a b = f (IntSet.singleton a) b
-   length = IntSet.size
-   reverse = id
-
-instance FactorialMonoid (Sequence.Seq a) where
-   factors = List.map Sequence.singleton . Foldable.toList
-   primePrefix = Sequence.take 1
-   primeSuffix q = Sequence.drop (Sequence.length q - 1) q
-   splitPrimePrefix q = case Sequence.viewl q
-                        of Sequence.EmptyL -> Nothing
-                           hd Sequence.:< rest -> Just (Sequence.singleton hd, rest)
-   splitPrimeSuffix q = case Sequence.viewr q
-                        of Sequence.EmptyR -> Nothing
-                           rest Sequence.:> last -> Just (rest, Sequence.singleton last)
-   inits = Foldable.toList . Sequence.inits
-   tails = Foldable.toList . Sequence.tails
-   foldl f = Foldable.foldl f'
-      where f' a b = f a (Sequence.singleton b)
-   foldl' f = Foldable.foldl' f'
-      where f' a b = f a (Sequence.singleton b)
-   foldr f = Foldable.foldr f'
-      where f' a b = f (Sequence.singleton a) b
-   span f = Sequence.spanl (f . Sequence.singleton)
-   break f = Sequence.breakl (f . Sequence.singleton)
-   dropWhile f = Sequence.dropWhileL (f . Sequence.singleton)
-   takeWhile f = Sequence.takeWhileL (f . Sequence.singleton)
-   spanMaybe s0 f b = case Foldable.foldr g id b (0, s0)
-                      of (i, s') | (prefix, suffix) <- Sequence.splitAt i b -> (prefix, suffix, s')
-      where g x cont (i, s) | Just s' <- f s (Sequence.singleton x) = let i' = succ i :: Int in seq i' $ cont (i', s')
-                            | otherwise = (i, s)
-   spanMaybe' s0 f b = case Foldable.foldr g id b (0, s0)
-                       of (i, s') | (prefix, suffix) <- Sequence.splitAt i b -> (prefix, suffix, s')
-      where g x cont (i, s) | Just s' <- f s (Sequence.singleton x) = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')
-                            | otherwise = (i, s)
-   splitAt = Sequence.splitAt
-   drop = Sequence.drop
-   take = Sequence.take
-   length = Sequence.length
-   reverse = Sequence.reverse
-
-instance Ord a => FactorialMonoid (Set.Set a) where
-   factors = List.map Set.singleton . Set.toAscList
-   primePrefix set | Set.null set = set
-                   | otherwise = Set.singleton $ Set.findMin set
-   primeSuffix set | Set.null set = set
-                   | otherwise = Set.singleton $ Set.findMax set
-   splitPrimePrefix = fmap singularize . Set.minView
-      where singularize (min, rest) = (Set.singleton min, rest)
-   splitPrimeSuffix = fmap singularize . Set.maxView
-      where singularize (max, rest) = (rest, Set.singleton max)
-   foldl f = Foldable.foldl f'
-      where f' a b = f a (Set.singleton b)
-   foldl' f = Foldable.foldl' f'
-      where f' a b = f a (Set.singleton b)
-   foldr f = Foldable.foldr f'
-      where f' a b = f (Set.singleton a) b
-   length = Set.size
-   reverse = id
-
-instance FactorialMonoid (Vector.Vector a) where
-   factors x = factorize (Vector.length x) x
-      where factorize 0 _ = []
-            factorize n xs = xs1 : factorize (pred n) xs'
-               where (xs1, xs') = Vector.splitAt 1 xs
-   primePrefix = Vector.take 1
-   primeSuffix x = Vector.drop (Vector.length x - 1) x
-   splitPrimePrefix x = if Vector.null x then Nothing else Just (Vector.splitAt 1 x)
-   splitPrimeSuffix x = if Vector.null x then Nothing else Just (Vector.splitAt (Vector.length x - 1) x)
-   inits x0 = initsWith x0 []
-      where initsWith x rest | Vector.null x = x:rest
-                             | otherwise = initsWith (Vector.unsafeInit x) (x:rest)
-   tails x = x : if Vector.null x then [] else tails (Vector.unsafeTail x)
-   foldl f = Vector.foldl f'
-      where f' a byte = f a (Vector.singleton byte)
-   foldl' f = Vector.foldl' f'
-      where f' a byte = f a (Vector.singleton byte)
-   foldr f = Vector.foldr f'
-      where f' byte a = f (Vector.singleton byte) a
-   break f = Vector.break (f . Vector.singleton)
-   span f = Vector.span (f . Vector.singleton)
-   dropWhile f = Vector.dropWhile (f . Vector.singleton)
-   takeWhile f = Vector.takeWhile (f . Vector.singleton)
-   spanMaybe s0 f v = case Vector.ifoldr g Left v s0
-                      of Left s' -> (v, Vector.empty, s')
-                         Right (i, s') | (prefix, suffix) <- Vector.splitAt i v -> (prefix, suffix, s')
-      where g i x cont s | Just s' <- f s (Vector.singleton x) = cont s'
-                         | otherwise = Right (i, s)
-   spanMaybe' s0 f v = case Vector.ifoldr' g Left v s0
-                       of Left s' -> (v, Vector.empty, s')
-                          Right (i, s') | (prefix, suffix) <- Vector.splitAt i v -> (prefix, suffix, s')
-      where g i x cont s | Just s' <- f s (Vector.singleton x) = seq s' (cont s')
-                         | otherwise = Right (i, s)
-   splitAt = Vector.splitAt
-   drop = Vector.drop
-   take = Vector.take
-   length = Vector.length
-   reverse = Vector.reverse
-
-instance StableFactorialMonoid ()
-instance StableFactorialMonoid a => StableFactorialMonoid (Dual a)
-instance StableFactorialMonoid [x]
-instance StableFactorialMonoid ByteString.ByteString
-instance StableFactorialMonoid LazyByteString.ByteString
-instance StableFactorialMonoid Text.Text
-instance StableFactorialMonoid LazyText.Text
-instance StableFactorialMonoid (Sequence.Seq a)
-instance StableFactorialMonoid (Vector.Vector a)
-
--- | A 'Monad.mapM' equivalent.
-mapM :: (FactorialMonoid a, Monoid b, Monad m) => (a -> m b) -> a -> m b
-mapM f = ($ return mempty) . appEndo . Data.Monoid.Factorial.foldMap (Endo . Monad.liftM2 mappend . f)
-
--- | A 'Monad.mapM_' equivalent.
-mapM_ :: (FactorialMonoid a, Monad m) => (a -> m b) -> a -> m ()
-mapM_ f = foldr ((>>) . f) (return ())
diff --git a/Data/Monoid/Instances/ByteString/UTF8.hs b/Data/Monoid/Instances/ByteString/UTF8.hs
deleted file mode 100644
--- a/Data/Monoid/Instances/ByteString/UTF8.hs
+++ /dev/null
@@ -1,498 +0,0 @@
-{- 
-    Copyright 2013-2018 Mario Blazevic
-
-    License: BSD3 (see BSD3-LICENSE.txt file)
--}
-
--- | This module defines the 'ByteStringUTF8' newtype wrapper around 'ByteString', together with its 'TextualMonoid'
--- instance. The 'FactorialMonoid' instance of a wrapped 'ByteStringUTF8' value differs from the original 'ByteString':
--- the prime 'factors' of the original value are its bytes, and for the wrapped value the prime 'factors' are its valid
--- UTF8 byte sequences. The following example session demonstrates the relationship:
--- 
--- >> let utf8@(ByteStringUTF8 bs) = fromString "E=mc\xb2"
--- >> bs
--- >"E=mc\194\178"
--- >> factors bs
--- >["E","=","m","c","\194","\178"]
--- >> utf8
--- >"E=mc²"
--- >> factors utf8
--- >["E","=","m","c","²"]
---
--- The 'TextualMonoid' instance follows the same logic, but it also decodes all valid UTF8 sequences into
--- characters. Any invalid UTF8 byte sequence from the original 'ByteString' is preserved as a single prime factor:
---
--- >> let utf8'@(ByteStringUTF8 bs') = ByteStringUTF8 (Data.ByteString.map pred bs)
--- >> bs'
--- >"D<lb\193\177"
--- >> factors bs'
--- >["D","<","l","b","\193","\177"]
--- >> utf8'
--- >"D<lb\[193,177]"
--- >> factors utf8'
--- >["D","<","l","b","\[193,177]"]
-
-{-# LANGUAGE Haskell2010 #-}
-
-module Data.Monoid.Instances.ByteString.UTF8 (
-   ByteStringUTF8(..), decode
-   )
-where
-
-import Control.Exception (assert)
-import Data.Bits ((.&.), (.|.), shiftL, shiftR)
-import Data.Char (chr, ord, isDigit, isPrint)
-import qualified Data.Foldable as Foldable
-import qualified Data.List as List
-import Data.Maybe (fromMaybe, isJust, isNothing)
-import Data.String (IsString(fromString))
-import Data.Word (Word8)
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as ByteString
-import qualified Data.ByteString.Char8 as ByteString.Char8
-import Data.ByteString.Internal (w2c)
-import Data.ByteString.Unsafe (unsafeDrop, unsafeHead, unsafeTail, unsafeTake, unsafeIndex)
-
-import Data.Semigroup -- (Semigroup(..))
-import Data.Monoid (Monoid(mempty, mappend))
-import Data.Monoid.Cancellative (LeftReductiveMonoid(..), LeftCancellativeMonoid, LeftGCDMonoid(..))
-import Data.Monoid.Null (MonoidNull(..), PositiveMonoid)
-import Data.Monoid.Factorial (FactorialMonoid(..))
-import Data.Monoid.Textual (TextualMonoid(..))
-import qualified Data.Monoid.Factorial as Factorial (FactorialMonoid(..))
-import qualified Data.Monoid.Textual as Textual (TextualMonoid(..))
-
-import Prelude hiding (any, drop, dropWhile, foldl, foldl1, foldr, foldr1, scanl, scanr, scanl1, scanr1,
-                       map, concatMap, break, span)
-
-newtype ByteStringUTF8 = ByteStringUTF8 ByteString deriving (Eq, Ord)
-
--- | Takes a raw 'ByteString' chunk and returns a pair of 'ByteStringUTF8' decoding the prefix of the chunk and the
--- remaining suffix that is either null or contains the incomplete last character of the chunk.
-decode :: ByteString -> (ByteStringUTF8, ByteString)
-decode bs
-   | ByteString.null bs || l < 0x80 = (ByteStringUTF8 bs, mempty)
-   | l >= 0xC0 = (ByteStringUTF8 (ByteString.init bs), ByteString.singleton l)
-   | ByteString.null prefix = (mempty, bs)
-   | otherwise =
-      case toChar (ByteString.last prefix) suffix
-      of Nothing -> (ByteStringUTF8 (ByteString.init prefix), drop (ByteString.length prefix - 1) bs)
-         Just{} -> (ByteStringUTF8 bs, mempty)
-   where (prefix, suffix) = ByteString.breakEnd byteStartsCharacter bs
-         l = ByteString.last bs
-
-instance Semigroup ByteStringUTF8 where
-   ByteStringUTF8 a <> ByteStringUTF8 b = ByteStringUTF8 (a <> b)
-   {-# INLINE (<>) #-}
-
-instance Monoid ByteStringUTF8 where
-   mempty = ByteStringUTF8 ByteString.empty
-   {-# INLINE mempty #-}
-   ByteStringUTF8 a `mappend` ByteStringUTF8 b = ByteStringUTF8 (a `mappend` b)
-   {-# INLINE mappend #-}
-
-instance MonoidNull ByteStringUTF8 where
-   null (ByteStringUTF8 b) = ByteString.null b
-   {-# INLINE null #-}
-
-instance LeftReductiveMonoid ByteStringUTF8 where
-   stripPrefix (ByteStringUTF8 a) (ByteStringUTF8 b) = fmap ByteStringUTF8 (stripPrefix a b)
-   {-# INLINE stripPrefix #-}
-   ByteStringUTF8 a `isPrefixOf` ByteStringUTF8 b = a `isPrefixOf` b
-   {-# INLINE isPrefixOf #-}
-
-instance LeftCancellativeMonoid ByteStringUTF8
-
-instance LeftGCDMonoid ByteStringUTF8 where
-   commonPrefix (ByteStringUTF8 a) (ByteStringUTF8 b) = ByteStringUTF8 (commonPrefix a b)
-   {-# INLINE commonPrefix #-}
-   stripCommonPrefix (ByteStringUTF8 a) (ByteStringUTF8 b) = wrapTriple (stripCommonPrefix a b)
-   {-# INLINE stripCommonPrefix #-}
-
-instance Show ByteStringUTF8 where
-   showsPrec _ bs s0 = '"' : Textual.foldr showsBytes showsChar ('"' : s0) bs
-      where showsBytes (ByteStringUTF8 b) s = '\\' : shows (ByteString.unpack b) s
-            showsChar c s
-              | isPrint c = c : s
-              | h:_ <- s, isDigit h = "\\" ++ show (ord c) ++ "\\&" ++ s
-              | otherwise = "\\" ++ show (ord c) ++ s
-
-instance IsString ByteStringUTF8 where
-   fromString = ByteStringUTF8 . Foldable.foldMap fromChar
-   {-# INLINE fromString #-}
-
-instance PositiveMonoid ByteStringUTF8
-
-instance FactorialMonoid ByteStringUTF8 where
-   splitPrimePrefix utf8@(ByteStringUTF8 bs)
-      | ByteString.null bs = Nothing
-      | unsafeHead bs < 0x80 = Just (wrapPair $ ByteString.splitAt 1 bs)
-      | otherwise = case ByteString.findIndex byteStartsCharacter (unsafeTail bs)
-                    of Just i -> Just (wrapPair $ ByteString.splitAt (succ i) bs)
-                       Nothing -> Just (utf8, ByteStringUTF8 $ ByteString.empty)
-   {-# INLINABLE splitPrimePrefix #-}
-   splitPrimeSuffix (ByteStringUTF8 bs)
-      | ByteString.null bs = Nothing
-      | ByteString.null prefix = Just (wrapPair splitBS)
-      | not (ByteString.null suffix) && ByteString.last prefix < 0x80 = Just (wrapPair splitBS)
-      | otherwise = Just (wrapPair $ ByteString.splitAt (pred $ ByteString.length prefix) bs)
-      where splitBS@(prefix, suffix) = ByteString.breakEnd byteStartsCharacter bs
-   {-# INLINABLE splitPrimeSuffix #-}
-   primePrefix utf8@(ByteStringUTF8 bs)
-      | ByteString.null bs = utf8
-      | unsafeHead bs < 0x80 = ByteStringUTF8 (ByteString.take 1 bs)
-      | otherwise = case ByteString.findIndex byteStartsCharacter (unsafeTail bs)
-                    of Just i -> ByteStringUTF8 (ByteString.take (succ i) bs)
-                       Nothing -> utf8
-   {-# INLINABLE primePrefix #-}
-   factors (ByteStringUTF8 bs) = List.map ByteStringUTF8 $ ByteString.groupBy continued bs
-      where continued a b = a >= 0x80 && b >= 0x80 && b < 0xC0
-   {-# INLINABLE factors #-}
-   length (ByteStringUTF8 bs) = fst (ByteString.foldl' count (0, False) bs)
-      where count (n, high) byte | byte < 0x80 = (succ n, False)
-                                 | byte < 0xC0 = (if high then n else succ n, True)
-                                 | otherwise = (succ n, True)
-   {-# INLINABLE length #-}
-   foldl f a0 (ByteStringUTF8 bs) = List.foldl f' a0 (groupASCII bs)
-      where f' a b | unsafeHead b < 0x80 = ByteString.foldl f'' a b
-                   | otherwise = f a (ByteStringUTF8 b)
-            f'' a w = f a (ByteStringUTF8 $ ByteString.singleton w)
-   {-# INLINABLE foldl #-}
-   foldl' f a0 (ByteStringUTF8 bs) = List.foldl' f' a0 (groupASCII bs)
-      where f' a b | unsafeHead b < 0x80 = ByteString.foldl' f'' a b
-                   | otherwise = f a (ByteStringUTF8 b)
-            f'' a w = f a (ByteStringUTF8 $ ByteString.singleton w)
-   {-# INLINABLE foldl' #-}
-   foldr f a0 (ByteStringUTF8 bs) = List.foldr f' a0 (groupASCII bs)
-      where f' b a | unsafeHead b < 0x80 = ByteString.foldr f'' a b
-                   | otherwise = f (ByteStringUTF8 b) a
-            f'' w a = f (ByteStringUTF8 $ ByteString.singleton w) a
-   {-# INLINABLE foldr #-}
-   splitAt n (ByteStringUTF8 bs) = wrapPair (ByteString.splitAt (charStartIndex n bs) bs)
-   {-# INLINE splitAt #-}
-   take n (ByteStringUTF8 bs) = ByteStringUTF8 (ByteString.take (charStartIndex n bs) bs)
-   {-# INLINE take #-}
-   drop n (ByteStringUTF8 bs) = ByteStringUTF8 (ByteString.drop (charStartIndex n bs) bs)
-   {-# INLINE drop #-}
-   dropWhile p (ByteStringUTF8 bs0) = dropASCII bs0
-      where dropASCII bs =
-               let suffix = ByteString.dropWhile (\w-> w < 0x80 && p (ByteStringUTF8 $ ByteString.singleton w)) bs
-               in if ByteString.null suffix || unsafeHead suffix < 0x80
-                  then ByteStringUTF8 suffix
-                  else dropMultiByte suffix
-            dropMultiByte bs =
-               let utf8 = ByteStringUTF8 bs
-               in case ByteString.findIndex byteStartsCharacter (unsafeTail bs)
-                  of Nothing -> if p utf8 then ByteStringUTF8 ByteString.empty else utf8
-                     Just i -> let (hd, tl) = ByteString.splitAt (succ i) bs
-                               in if p (ByteStringUTF8 hd)
-                                  then dropASCII tl
-                                  else utf8
-   {-# INLINE dropWhile #-}
-   takeWhile p utf8@(ByteStringUTF8 bs) =
-      ByteStringUTF8 $ ByteString.take (ByteString.length bs - ByteString.length s) bs
-      where (ByteStringUTF8 s) = Factorial.dropWhile p utf8
-   {-# INLINE takeWhile #-}
-   span p utf8@(ByteStringUTF8 bs) =
-      (ByteStringUTF8 $ ByteString.take (ByteString.length bs - ByteString.length s) bs, suffix)
-      where suffix@(ByteStringUTF8 s) = Factorial.dropWhile p utf8
-   {-# INLINE span #-}
-   break p = Factorial.span (not . p)
-   {-# INLINE break #-}
-   spanMaybe s0 f (ByteStringUTF8 bs0) = (ByteStringUTF8 $ ByteString.take (ByteString.length bs0 - ByteString.length dropped) bs0,
-                                          ByteStringUTF8 dropped,
-                                          s')
-      where (dropped, s') = dropASCII s0 bs0
-            dropASCII s bs =
-               let suffix = ByteString.drop index bs
-                   (index, s1) = ByteString.foldr f8 id bs (0, s)
-                   f8 w cont (i, s2)
-                     | w < 0x80, Just s3 <- f s2 (ByteStringUTF8 $ ByteString.singleton w) =
-                         let i' = succ i :: Int in seq i' $ cont (i', s3)
-                     | otherwise = (i, s2)
-               in if ByteString.null suffix || unsafeHead suffix < 0x80
-                  then (suffix, s1)
-                  else dropMultiByte s1 suffix
-            dropMultiByte s bs =
-               case ByteString.findIndex byteStartsCharacter (unsafeTail bs)
-               of Nothing -> case f s (ByteStringUTF8 bs)
-                             of Just s1 -> (ByteString.empty, s1)
-                                Nothing -> (bs, s)
-                  Just i -> let (hd, tl) = ByteString.splitAt (succ i) bs
-                            in case f s (ByteStringUTF8 hd)
-                               of Just s1 -> dropASCII s1 tl
-                                  Nothing -> (bs, s)
-   {-# INLINE spanMaybe #-}
-   spanMaybe' s0 f (ByteStringUTF8 bs0) = (ByteStringUTF8 $
-                                           ByteString.take (ByteString.length bs0 - ByteString.length dropped) bs0,
-                                           ByteStringUTF8 dropped,
-                                           s')
-      where (dropped, s') = dropASCII s0 bs0
-            dropASCII s bs =
-               let suffix = ByteString.drop index bs
-                   (index, s1) = ByteString.foldr f8 id bs (0, s)
-                   f8 w cont (i, s2)
-                     | w < 0x80, Just s3 <- f s2 (ByteStringUTF8 $ ByteString.singleton w) =
-                         let i' = succ i :: Int in seq i' $ seq s3 $ cont (i', s3)
-                     | otherwise = (i, s)
-               in if ByteString.null suffix || unsafeHead suffix < 0x80
-                  then (suffix, s1)
-                  else dropMultiByte s1 suffix
-            dropMultiByte s bs =
-               case ByteString.findIndex byteStartsCharacter (unsafeTail bs)
-               of Nothing -> case f s (ByteStringUTF8 bs)
-                             of Just s1 -> seq s1 (ByteString.empty, s1)
-                                Nothing -> (bs, s)
-                  Just i -> let (hd, tl) = ByteString.splitAt (succ i) bs
-                            in case f s (ByteStringUTF8 hd)
-                               of Just s1 -> seq s1 (dropASCII s1 tl)
-                                  Nothing -> (bs, s)
-   {-# INLINE spanMaybe' #-}
-   reverse (ByteStringUTF8 bs) =
-      ByteStringUTF8 (ByteString.concat $ List.reverse $ List.map reverseASCII $ groupASCII bs)
-      where reverseASCII b | unsafeHead b < 0x80 = ByteString.reverse b
-                           | otherwise = b
-   {-# INLINABLE reverse #-}
-
-instance TextualMonoid ByteStringUTF8 where
-   singleton = ByteStringUTF8 . fromChar
-   {-# INLINE singleton #-}
-   splitCharacterPrefix (ByteStringUTF8 bs) = ByteString.uncons bs >>= uncurry toChar
-   {-# INLINE splitCharacterPrefix #-}
-   foldl ft fc a0 (ByteStringUTF8 bs) = case ByteString.Char8.foldl f (a0, []) bs
-                                        of (a, []) -> a
-                                           (a, acc) -> multiByte a acc
-      where f (a, []) c | c < '\x80' = (fc a c, [])
-                        | otherwise = (a, [fromIntegral $ ord c])
-            f (a, acc) c | c < '\x80' = (fc (multiByte a acc) c, [])
-                         | c < '\xC0' = (a, fromIntegral (ord c) : acc)
-                         | otherwise = (multiByte a acc, [fromIntegral $ ord c])
-            multiByte a acc = reverseBytesToChar (ft a . ByteStringUTF8) (fc a) acc
-   {-# INLINE foldl #-}
-   foldl' ft fc a0 (ByteStringUTF8 bs) = case ByteString.Char8.foldl' f (a0, []) bs
-                                         of (a, []) -> a
-                                            (a, acc) -> multiByte a acc
-      where f (a, []) c | c < '\x80' = (fc a c, [])
-                        | otherwise = seq a (a, [fromIntegral $ ord c])
-            f (a, acc) c | seq a c < '\x80' = let a' = multiByte a acc in seq a' (fc a' c, [])
-                         | c < '\xC0' = (a, fromIntegral (ord c) : acc)
-                         | otherwise = let a' = multiByte a acc in seq a' (a', [fromIntegral $ ord c])
-            multiByte a acc = reverseBytesToChar (ft a . ByteStringUTF8) (fc a) acc
-   {-# INLINE foldl' #-}
-   foldr ft fc a0 (ByteStringUTF8 bs) = case ByteString.Char8.foldr f (a0, []) bs
-                                        of (a, []) -> a
-                                           (a, acc) -> multiByte a acc
-      where f c (a, []) | c < '\x80' = (fc c a, [])
-                        | c < '\xC0' = (a, [fromIntegral $ ord c])
-                        | otherwise = (ft (ByteStringUTF8 $ ByteString.Char8.singleton c) a, [])
-            f c (a, acc) | c < '\x80' = (fc c (ft (ByteStringUTF8 $ ByteString.pack acc) a), [])
-                         | c < '\xC0' = (a, fromIntegral (ord c) : acc)
-                         | otherwise = (multiByte a (fromIntegral (ord c) : acc), [])
-            multiByte a acc = bytesToChar ((`ft` a) . ByteStringUTF8) (`fc` a) acc
-   {-# INLINE foldr #-}
-   dropWhile pb pc (ByteStringUTF8 bs) = ByteStringUTF8 $ dropASCII bs
-      where dropASCII rest = case ByteString.Char8.findIndex (\c-> c > '\x7f' || not (pc c)) rest
-                             of Nothing -> ByteString.empty
-                                Just j -> let rest' = unsafeDrop j rest
-                                          in if unsafeHead rest' > 0x7f
-                                             then dropMultiByte rest'
-                                             else rest'
-            dropMultiByte rest = case splitCharacterPrefix (ByteStringUTF8 rest)
-                                 of Just (c, ByteStringUTF8 rest') | pc c -> dropASCII rest'
-                                    Nothing -> let j = succ (headIndex $ drop 1 rest)
-                                               in if pb (ByteStringUTF8 $ ByteString.take j rest)
-                                                  then dropASCII (unsafeDrop j rest)
-                                                  else rest
-                                    _ -> rest
-   {-# INLINE dropWhile #-}
-   takeWhile pb pc utf8@(ByteStringUTF8 bs) =
-      ByteStringUTF8 $ unsafeTake (ByteString.length bs - ByteString.length suffix) bs
-      where ByteStringUTF8 suffix = Textual.dropWhile pb pc utf8
-   {-# INLINE takeWhile #-}
-   span pb pc utf8@(ByteStringUTF8 bs) = (ByteStringUTF8 $ unsafeTake (ByteString.length bs - ByteString.length suffix') bs, suffix)
-      where suffix@(ByteStringUTF8 suffix') = Textual.dropWhile pb pc utf8
-   {-# INLINE span #-}
-   break pb pc = Textual.span (not . pb) (not . pc)
-   {-# INLINE break #-}
-   spanMaybe s0 ft fc (ByteStringUTF8 bs)  =
-      let inner i s
-            | i < len =
-                let w = unsafeIndex bs i
-                in if w < 0x80
-                   then case fc s (w2c w)
-                        of Just s' -> inner (i + 1) s'
-                           Nothing -> done i s
-                   else case splitCharacterPrefix (ByteStringUTF8 $ unsafeDrop i bs)
-                        of Just (c, ByteStringUTF8 rest) | Just s' <- fc s c -> inner (len - ByteString.length rest) s'
-                           Nothing -> let j = succ (headIndex $ drop (i + 1) bs)
-                                      in case ft s (ByteStringUTF8 $ ByteString.take j $ unsafeDrop i bs)
-                                         of Just s' -> inner (i + j) s'
-                                            Nothing -> done i s
-                           _ -> done i s
-            | otherwise = done i s
-          done i s = i `seq` s `seq` (ByteStringUTF8 $ unsafeTake i bs, ByteStringUTF8 $ unsafeDrop i bs, s)
-          len = ByteString.length bs
-      in inner 0 s0
-   {-# INLINE spanMaybe #-}
-   spanMaybe' s0 ft fc (ByteStringUTF8 bs)  =
-      let inner i s
-            | i < len =
-                s `seq`
-                let w = unsafeIndex bs i
-                in if w < 0x80
-                   then case fc s (w2c w)
-                        of Just s' -> inner (i + 1) s'
-                           Nothing -> done i s
-                   else case splitCharacterPrefix (ByteStringUTF8 $ unsafeDrop i bs)
-                        of Just (c, ByteStringUTF8 rest) | Just s' <- fc s c -> inner (len - ByteString.length rest) s'
-                           Nothing -> let j = succ (headIndex $ drop (i + 1) bs)
-                                      in case ft s (ByteStringUTF8 $ ByteString.take j $ unsafeDrop i bs)
-                                         of Just s' -> inner (i + j) s'
-                                            Nothing -> done i s
-                           _ -> done i s
-            | otherwise = done i s
-          done i s = i `seq` s `seq` (ByteStringUTF8 $ unsafeTake i bs, ByteStringUTF8 $ unsafeDrop i bs, s)
-          len = ByteString.length bs
-      in inner 0 s0
-   {-# INLINE spanMaybe' #-}
-   find p (ByteStringUTF8 bs0) = loop bs0
-      where loop bs = case ByteString.Char8.findIndex (\c-> c >= '\x80' || p c) bs
-                      of Nothing -> Nothing
-                         Just i -> let x = unsafeIndex bs i
-                                       bs' = unsafeDrop (i + 1) bs
-                                   in if x < 0x80
-                                      then Just (w2c x)
-                                      else case toChar x bs'
-                                           of Just (c, ByteStringUTF8 rest) | p c -> Just c
-                                                                            | otherwise -> loop rest
-                                              Nothing -> loop (ByteString.dropWhile (not . byteStartsCharacter) bs')
-   {-# INLINE find #-}
-   any p utf8 = isJust (find p utf8)
-   {-# INLINE any #-}
-   all p utf8 = isNothing (find (not . p) utf8)
-   {-# INLINE all #-}
-   elem c utf8@(ByteStringUTF8 bs)
-     | c < '\x80' = ByteString.Char8.elem c bs
-     | otherwise = any (== c) utf8
-   {-# INLINE elem #-}
-
-reverseBytesToChar :: (ByteString -> a) -> (Char -> a) -> [Word8] -> a
-reverseBytesToChar ft fc [w] = if w < 0x80 then fc (w2c w) else ft (ByteString.singleton w)
-reverseBytesToChar ft fc [b0, b1] =
-  assert (0x80 <= b0 && b0 < 0xC0) $
-  if 0xC2 <= b1 && b1 < 0xE0
-  then fc (chr (shiftL (fromIntegral b1 .&. 0x1F) 6 .|. fromIntegral b0 .&. 0x3F))
-  else ft (ByteString.pack [b1, b0])
-reverseBytesToChar ft fc [b0, b1, b2] =
-  assert (0x80 <= b0 && b0 < 0xC0 && 0x80 <= b1 && b1 < 0xC0) $
-  if (0xE0 < b2 || 0xE0 == b2 && 0xA0 <= b1) && b2 < 0xF0
-  then fc (chr (shiftL (fromIntegral b2 .&. 0xF) 12
-                .|. shiftL (fromIntegral b1 .&. 0x3F) 6
-                .|. fromIntegral b0 .&. 0x3F))
-  else ft (ByteString.pack [b2, b1, b0])
-reverseBytesToChar ft fc [b0, b1, b2, b3] =
-  assert (0x80 <= b0 && b0 < 0xC0 && 0x80 <= b1 && b1 < 0xC0 && 0x80 <= b2 && b2 < 0xC0) $
-  if (0xF0 < b3 || 0xF0 == b3 && 0x90 <= b2) && b3 < 0xF5 && (b3 < 0xF4 || b2 < 0x90)
-  then fc (chr (shiftL (fromIntegral b3 .&. 0x7) 18
-                .|. shiftL (fromIntegral b2 .&. 0x3F) 12
-                .|. shiftL (fromIntegral b1 .&. 0x3F) 6
-                .|. fromIntegral b0 .&. 0x3F))
-  else ft (ByteString.pack [b3, b2, b1, b0])
-reverseBytesToChar ft _fc bytes = ft (ByteString.reverse $ ByteString.pack bytes)
-
-bytesToChar :: (ByteString -> a) -> (Char -> a) -> [Word8] -> a
-bytesToChar ft fc [w] = if w < 0x80 then fc (w2c w) else ft (ByteString.singleton w)
-bytesToChar ft fc bytes@[b1, b0] =
-  assert (0x80 <= b0 && b0 < 0xC0) $
-  if 0xC2 <= b1 && b1 < 0xE0
-  then fc (chr (shiftL (fromIntegral b1 .&. 0x1F) 6 .|. fromIntegral b0 .&. 0x3F))
-  else ft (ByteString.pack bytes)
-bytesToChar ft fc bytes@[b2, b1, b0] =
-  assert (0x80 <= b0 && b0 < 0xC0 && 0x80 <= b1 && b1 < 0xC0) $
-  if (0xE0 < b2 || 0xE0 == b2 && 0xA0 <= b1) && b2 < 0xF0
-  then fc (chr (shiftL (fromIntegral b2 .&. 0xF) 12
-                .|. shiftL (fromIntegral b1 .&. 0x3F) 6
-                .|. fromIntegral b0 .&. 0x3F))
-  else ft (ByteString.pack bytes)
-bytesToChar ft fc bytes@[b3, b2, b1, b0] =
-  assert (0x80 <= b0 && b0 < 0xC0 && 0x80 <= b1 && b1 < 0xC0 && 0x80 <= b2 && b2 < 0xC0) $
-  if (0xF0 < b3 || 0xF0 == b3 && 0x90 <= b2) && b3 < 0xF5 && (b3 < 0xF4 || b2 < 0x90)
-  then fc (chr (shiftL (fromIntegral b3 .&. 0x7) 18
-                .|. shiftL (fromIntegral b2 .&. 0x3F) 12
-                .|. shiftL (fromIntegral b1 .&. 0x3F) 6
-                .|. fromIntegral b0 .&. 0x3F))
-  else ft (ByteString.pack bytes)
-bytesToChar ft _fc bytes = ft (ByteString.pack bytes)
-
-wrapPair :: (ByteString, ByteString) -> (ByteStringUTF8, ByteStringUTF8)
-wrapPair (bs1, bs2) = (ByteStringUTF8 bs1, ByteStringUTF8 bs2)
-{-# INLINE wrapPair #-}
-
-wrapTriple :: (ByteString, ByteString, ByteString) -> (ByteStringUTF8, ByteStringUTF8, ByteStringUTF8)
-wrapTriple (bs1, bs2, bs3) = (ByteStringUTF8 bs1, ByteStringUTF8 bs2, ByteStringUTF8 bs3)
-{-# INLINE wrapTriple #-}
-
-fromChar :: Char -> ByteString
-fromChar c | c < '\x80'    = ByteString.Char8.singleton c
-           | c < '\x800'   = ByteString.pack [0xC0 + fromIntegral (shiftR n 6),
-                                              0x80 + fromIntegral (n .&. 0x3F)]
-           | c < '\x10000' = ByteString.pack [0xE0 + fromIntegral (shiftR n 12),
-                                              0x80 + fromIntegral (shiftR n 6 .&. 0x3F),
-                                              0x80 + fromIntegral (n .&. 0x3F)]
-           | n < 0x200000  = ByteString.pack [0xF0 + fromIntegral (shiftR n 18),
-                                              0x80 + fromIntegral (shiftR n 12 .&. 0x3F),
-                                              0x80 + fromIntegral (shiftR n 6 .&. 0x3F),
-                                              0x80 + fromIntegral (n .&. 0x3F)]
-           | otherwise  = error ("Data.Char.ord '" ++ (c : "' >=0x200000"))
-   where n = ord c
-
-toChar :: Word8 -> ByteString -> Maybe (Char, ByteStringUTF8)
-toChar hd tl | hd < 0x80 = Just (w2c hd, ByteStringUTF8 tl)
-             | hd < 0xC2 = Nothing
-             | hd < 0xE0 = do (b0, t0) <- ByteString.uncons tl
-                              if headIndex tl == 1
-                                 then return (chr (shiftL (fromIntegral hd .&. 0x1F) 6
-                                                   .|. fromIntegral b0 .&. 0x3F),
-                                              ByteStringUTF8 t0)
-                                 else Nothing
-             | hd < 0xF0 = do (b1, t1) <- ByteString.uncons tl
-                              (b0, t0) <- ByteString.uncons t1
-                              if (hd > 0xE0 || b1 >= 0xA0) && headIndex tl == 2
-                                 then return (chr (shiftL (fromIntegral hd .&. 0xF) 12
-                                                   .|. shiftL (fromIntegral b1 .&. 0x3F) 6
-                                                   .|. fromIntegral b0 .&. 0x3F),
-                                              ByteStringUTF8 t0)
-                                 else Nothing
-             | hd < 0xF5 = do (b2, t2) <- ByteString.uncons tl
-                              (b1, t1) <- ByteString.uncons t2
-                              (b0, t0) <- ByteString.uncons t1
-                              if (hd > 0xF0 || b2 >= 0x90) && (hd < 0xF4 || b2 < 0x90) && headIndex tl == 3
-                                 then return (chr (shiftL (fromIntegral hd .&. 0x7) 18
-                                                   .|. shiftL (fromIntegral b2 .&. 0x3F) 12
-                                                   .|. shiftL (fromIntegral b1 .&. 0x3F) 6
-                                                   .|. fromIntegral b0 .&. 0x3F),
-                                              ByteStringUTF8 t0)
-                                 else Nothing
-             | otherwise = Nothing
-
-groupASCII :: ByteString -> [ByteString]
-groupASCII = ByteString.groupBy continued
-   where continued a b = (a < 0x80) == (b < 0x80) && b < 0xC0
-{-# INLINE groupASCII #-}
-
-headIndex :: ByteString -> Int
-headIndex bs = fromMaybe (ByteString.length bs) $ ByteString.findIndex byteStartsCharacter bs
-{-# INLINE headIndex #-}
-
-byteStartsCharacter :: Word8 -> Bool
-byteStartsCharacter b = b < 0x80 || b >= 0xC0
-{-# INLINE byteStartsCharacter #-}
-
-charStartIndex :: Int -> ByteString -> Int
-charStartIndex n _ | n <= 0 = 0
-charStartIndex n0 bs = ByteString.foldr count (const $ ByteString.length bs) bs (n0, False, 0)
-      where count byte _    (0, high, i) | byte < 0x80 || byte >= 0xC0 || not high = i
-            count byte cont (n, high, i) | byte < 0x80 = cont (pred n, False, succ i)
-                                         | byte < 0xC0 = cont (if high then n else pred n, True, succ i)
-                                         | otherwise = cont (pred n, True, succ i)
-{-# INLINE charStartIndex #-}
diff --git a/Data/Monoid/Instances/Concat.hs b/Data/Monoid/Instances/Concat.hs
deleted file mode 100644
--- a/Data/Monoid/Instances/Concat.hs
+++ /dev/null
@@ -1,293 +0,0 @@
-{- 
-    Copyright 2013-2018 Mario Blazevic
-
-    License: BSD3 (see BSD3-LICENSE.txt file)
--}
-
--- | This module defines the monoid transformer data type 'Concat'.
--- 
-
-{-# LANGUAGE Haskell2010 #-}
-
-module Data.Monoid.Instances.Concat (
-   Concat, concatenate, extract, force
-   )
-where
-
-import Control.Applicative -- (Applicative(..))
-import Control.Arrow (first)
-import qualified Data.Foldable as Foldable
-import qualified Data.List as List
-import Data.String (IsString(..))
-import Data.Semigroup (Semigroup(..))
-import Data.Monoid (Monoid(..), First(..), Sum(..))
-import Data.Monoid.Cancellative (LeftReductiveMonoid(..), RightReductiveMonoid(..),
-                                 LeftGCDMonoid(..), RightGCDMonoid(..))
-import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)
-import Data.Monoid.Factorial (FactorialMonoid(..), StableFactorialMonoid)
-import Data.Monoid.Textual (TextualMonoid(..))
-import qualified Data.Monoid.Factorial as Factorial
-import qualified Data.Monoid.Textual as Textual
-import Data.Sequence (Seq)
-import qualified Data.Sequence as Seq
-
-import Prelude hiding (all, any, break, filter, foldl, foldl1, foldr, foldr1, map, concatMap,
-                       length, null, reverse, scanl, scanr, scanl1, scanr1, span, splitAt, pi)
-
--- | @'Concat'@ is a transparent monoid transformer. The behaviour of the @'Concat' a@ instances of monoid subclasses is
--- identical to the behaviour of their @a@ instances, up to the 'pure' isomorphism.
---
--- The only purpose of 'Concat' then is to change the performance characteristics of various operations. Most
--- importantly, injecting a monoid into 'Concat' has the effect of making 'mappend' a constant-time operation. The
--- `splitPrimePrefix` and `splitPrimeSuffix` operations are amortized to constant time, provided that only one or the
--- other is used. Using both operations alternately will trigger the worst-case behaviour of O(n).
---
-data Concat a = Leaf a
-              | Concat a :<> Concat a
-              deriving Show
-
-{-# DEPRECATED concatenate, extract "Concat is not wrapping Seq any more, don't use concatenate nor extract." #-}
-concatenate :: PositiveMonoid a => Seq a -> Concat a
-concatenate q
-   | Foldable.all null q = mempty
-   | otherwise = Foldable.foldr (\a c-> if null a then c else Leaf a <> c) mempty q
-
-extract :: Concat a -> Seq a
-extract = Seq.fromList . Foldable.toList
-
-force :: Monoid a => Concat a -> a
-force (Leaf x) = x
-force (x :<> y) = force x `mappend` force y
-
-instance (Eq a, Monoid a) => Eq (Concat a) where
-   x == y = force x == force y
-
-instance (Ord a, Monoid a) => Ord (Concat a) where
-   compare x y = compare (force x) (force y)
-
-instance Functor Concat where
-   fmap f (Leaf x) = Leaf (f x)
-   fmap f (l :<> r) = fmap f l :<> fmap f r
-
-instance Applicative Concat where
-   pure = Leaf
-   Leaf f <*> x = f <$> x
-   (f1 :<> f2) <*> x = (f1 <*> x) :<> (f2 <*> x)
-
-instance Foldable.Foldable Concat where
-   fold (Leaf x) = x
-   fold (x :<> y) = Foldable.fold x `mappend` Foldable.fold y
-   foldMap f (Leaf x) = f x
-   foldMap f (x :<> y) = Foldable.foldMap f x `mappend` Foldable.foldMap f y
-   foldl f a (Leaf x) = f a x
-   foldl f a (x :<> y) = Foldable.foldl f (Foldable.foldl f a x) y
-   foldl' f a (Leaf x) = f a x
-   foldl' f a (x :<> y) = let a' = Foldable.foldl' f a x in a' `seq` Foldable.foldl' f a' y
-   foldr f a (Leaf x) = f x a
-   foldr f a (x :<> y) = Foldable.foldr f (Foldable.foldr f a y) x
-   foldr' f a (Leaf x) = f x a
-   foldr' f a (x :<> y) = let a' = Foldable.foldr' f a y in Foldable.foldr' f a' x
-
-instance PositiveMonoid a => Semigroup (Concat a) where
-   x <> y
-      | null x = y
-      | null y = x
-      | otherwise = x :<> y
-
-instance PositiveMonoid a => Monoid (Concat a) where
-   mempty = Leaf mempty
-   mappend = (<>)
-
-instance PositiveMonoid a => MonoidNull (Concat a) where
-   null (Leaf x) = null x
-   null _ = False
-
-instance PositiveMonoid a => PositiveMonoid (Concat a)
-
-instance (LeftReductiveMonoid a, StableFactorialMonoid a) => LeftReductiveMonoid (Concat a) where
-   stripPrefix (Leaf x) (Leaf y) = Leaf <$> stripPrefix x y
-   stripPrefix (xp :<> xs) y = stripPrefix xp y >>= stripPrefix xs
-   stripPrefix x (yp :<> ys) = case (stripPrefix x yp, stripPrefix yp x)
-                               of (Just yps, _) -> Just (yps <> ys)
-                                  (Nothing, Nothing) -> Nothing
-                                  (Nothing, Just xs) -> stripPrefix xs ys
-
-instance (RightReductiveMonoid a, StableFactorialMonoid a) => RightReductiveMonoid (Concat a) where
-   stripSuffix (Leaf x) (Leaf y) = Leaf <$> stripSuffix x y
-   stripSuffix (xp :<> xs) y = stripSuffix xs y >>= stripSuffix xp
-   stripSuffix x (yp :<> ys) = case (stripSuffix x ys, stripSuffix ys x)
-                               of (Just ysp, _) -> Just (yp <> ysp)
-                                  (Nothing, Nothing) -> Nothing
-                                  (Nothing, Just xp) -> stripSuffix xp yp
-
-instance (LeftGCDMonoid a, StableFactorialMonoid a) => LeftGCDMonoid (Concat a) where
-   stripCommonPrefix (Leaf x) (Leaf y) = map3 Leaf (stripCommonPrefix x y)
-   stripCommonPrefix (xp :<> xs) y
-      | null xps = (xp <> xsp, xss, yss)
-      | otherwise = (xpp, xps <> xs, ys)
-      where (xpp, xps, ys) = stripCommonPrefix xp y
-            (xsp, xss, yss) = stripCommonPrefix xs ys
-   stripCommonPrefix x (yp :<> ys)
-      | null yps = (yp <> ysp, xss, yss)
-      | otherwise = (ypp, xs, yps <> ys)
-      where (ypp, xs, yps) = stripCommonPrefix x yp
-            (ysp, xss, yss) = stripCommonPrefix xs ys
-
-instance (RightGCDMonoid a, StableFactorialMonoid a) => RightGCDMonoid (Concat a) where
-   stripCommonSuffix (Leaf x) (Leaf y) = map3 Leaf (stripCommonSuffix x y)
-   stripCommonSuffix (xp :<> xs) y
-      | null xsp = (xpp, ypp, xps <> xs)
-      | otherwise = (xp <> xsp, yp, xss)
-      where (xsp, yp, xss) = stripCommonSuffix xs y
-            (xpp, ypp, xps) = stripCommonSuffix xp yp
-   stripCommonSuffix x (yp :<> ys)
-      | null ysp = (xpp, ypp, yps <> ys)
-      | otherwise = (xp, yp <> ysp, yss)
-      where (xp, ysp, yss) = stripCommonSuffix x ys
-            (xpp, ypp, yps) = stripCommonSuffix xp yp
-
-instance (FactorialMonoid a, PositiveMonoid a) => FactorialMonoid (Concat a) where
-   factors c = toList c []
-      where toList (Leaf x) rest
-               | null x = rest
-               | otherwise = (Leaf <$> factors x) ++ rest
-            toList (x :<> y) rest = toList x (toList y rest)
-   primePrefix (Leaf x) = Leaf (primePrefix x)
-   primePrefix (x :<> _) = primePrefix x
-   primeSuffix (Leaf x) = Leaf (primeSuffix x)
-   primeSuffix (_ :<> y) = primeSuffix y
-   splitPrimePrefix (Leaf x) = map2 Leaf <$> splitPrimePrefix x
-   splitPrimePrefix (x :<> y) = ((<> y) <$>) <$> splitPrimePrefix x
-   splitPrimeSuffix (Leaf x) = map2 Leaf <$> splitPrimeSuffix x
-   splitPrimeSuffix (x :<> y) = first (x <>) <$> splitPrimeSuffix y
-
-   foldl f = Foldable.foldl g
-      where g = Factorial.foldl (\a-> f a . Leaf)
-   foldl' f = Foldable.foldl' g
-      where g = Factorial.foldl' (\a-> f a . Leaf)
-   foldr f = Foldable.foldr g
-      where g a b = Factorial.foldr (f . Leaf) b a
-   length x = getSum $ Foldable.foldMap (Sum . length) x
-   foldMap f = Foldable.foldMap (Factorial.foldMap (f . Leaf))
-   span p (Leaf x) = map2 Leaf (Factorial.span (p . Leaf) x)
-   span p (x :<> y)
-      | null xs = (x <> yp, ys)
-      | otherwise = (xp, xs :<> y)
-      where (xp, xs) = Factorial.span p x
-            (yp, ys) = Factorial.span p y
-   spanMaybe s0 f (Leaf x) = first2 Leaf (Factorial.spanMaybe s0 (\s-> f s . Leaf) x)
-   spanMaybe s0 f (x :<> y)
-      | null xs = (x :<> yp, ys, s2)
-      | otherwise = (xp, xs :<> y, s1)
-      where (xp, xs, s1) = Factorial.spanMaybe s0 f x
-            (yp, ys, s2) = Factorial.spanMaybe s1 f y
-   spanMaybe' s0 f c = seq s0 $
-      case c
-      of Leaf x -> first2 Leaf (Factorial.spanMaybe' s0 (\s-> f s . Leaf) x)
-         x :<> y -> let (xp, xs, s1) = Factorial.spanMaybe' s0 f x
-                        (yp, ys, s2) = Factorial.spanMaybe' s1 f y
-                    in if null xs then (x :<> yp, ys, s2) else (xp, xs :<> y, s1)
-
-   split p = Foldable.foldr splitNext [mempty]
-      where splitNext a ~(xp:xs) =
-               let as = Leaf <$> Factorial.split (p . Leaf) a
-               in if null xp
-                  then as ++ xs
-                  else init as ++ (last as <> xp):xs
-   splitAt 0 c = (mempty, c)
-   splitAt n (Leaf x) = map2 Leaf (Factorial.splitAt n x)
-   splitAt n (x :<> y)
-      | k < n = (x :<> yp, ys)
-      | k > n = (xp, xs :<> y)
-      | otherwise = (x, y)
-      where k = length x
-            (yp, ys) = splitAt (n - k) y
-            (xp, xs) = splitAt n x
-   reverse (Leaf x) = Leaf (reverse x)
-   reverse (x :<> y) = reverse y :<> reverse x
-
-instance (FactorialMonoid a, PositiveMonoid a) => StableFactorialMonoid (Concat a)
-
-instance (IsString a) => IsString (Concat a) where
-   fromString s = Leaf (fromString s)
-
-instance (Eq a, TextualMonoid a, StableFactorialMonoid a) => TextualMonoid (Concat a) where
-   fromText t = Leaf (fromText t)
-   singleton = Leaf . singleton
-   splitCharacterPrefix (Leaf x) = (Leaf <$>) <$> splitCharacterPrefix x
-   splitCharacterPrefix (x :<> y) = ((<> y) <$>) <$> splitCharacterPrefix x
-   characterPrefix (Leaf x) = characterPrefix x
-   characterPrefix (x :<> _) = characterPrefix x
-   map f x = map f <$> x
-   toString ft x = List.concatMap (toString $ ft . Leaf) (Foldable.toList x)
-
-   foldl ft fc = Foldable.foldl g
-      where g = Textual.foldl (\a-> ft a . Leaf) fc
-   foldl' ft fc = Foldable.foldl' g
-      where g = Textual.foldl' (\a-> ft a . Leaf) fc
-   foldr ft fc = Foldable.foldr g
-      where g a b = Textual.foldr (ft . Leaf) fc b a
-   any p = Foldable.any (any p)
-   all p = Foldable.all (all p)
-
-   span pt pc (Leaf x) = map2 Leaf (Textual.span (pt . Leaf) pc x)
-   span pt pc (x :<> y)
-      | null xs = (x <> yp, ys)
-      | otherwise = (xp, xs :<> y)
-      where (xp, xs) = Textual.span pt pc x
-            (yp, ys) = Textual.span pt pc y
-   span_ bt pc (Leaf x) = map2 Leaf (Textual.span_ bt pc x)
-   span_ bt pc (x :<> y)
-      | null xs = (x <> yp, ys)
-      | otherwise = (xp, xs :<> y)
-      where (xp, xs) = Textual.span_ bt pc x
-            (yp, ys) = Textual.span_ bt pc y
-   break pt pc = Textual.span (not . pt) (not . pc)
-   takeWhile_ bt pc = fst . span_ bt pc
-   dropWhile_ bt pc = snd . span_ bt pc
-   break_ bt pc = span_ (not bt) (not . pc)
-
-   spanMaybe s0 ft fc (Leaf x) = first2 Leaf (Textual.spanMaybe s0 (\s-> ft s . Leaf) fc x)
-   spanMaybe s0 ft fc (x :<> y)
-      | null xs = (x :<> yp, ys, s2)
-      | otherwise = (xp, xs :<> y, s1)
-      where (xp, xs, s1) = Textual.spanMaybe s0 ft fc x
-            (yp, ys, s2) = Textual.spanMaybe s1 ft fc y
-   spanMaybe' s0 ft fc c = seq s0 $
-      case c
-      of Leaf x -> first2 Leaf (Textual.spanMaybe' s0 (\s-> ft s . Leaf) fc x)
-         x :<> y -> let (xp, xs, s1) = Textual.spanMaybe' s0 ft fc x
-                        (yp, ys, s2) = Textual.spanMaybe' s1 ft fc y
-                    in if null xs then (x :<> yp, ys, s2) else (xp, xs :<> y, s1)
-   spanMaybe_ s0 fc (Leaf x) = first2 Leaf (Textual.spanMaybe_ s0 fc x)
-   spanMaybe_ s0 fc (x :<> y)
-      | null xs = (x :<> yp, ys, s2)
-      | otherwise = (xp, xs :<> y, s1)
-      where (xp, xs, s1) = Textual.spanMaybe_ s0 fc x
-            (yp, ys, s2) = Textual.spanMaybe_ s1 fc y
-   spanMaybe_' s0 fc c = seq s0 $
-      case c
-      of Leaf x -> first2 Leaf (Textual.spanMaybe_' s0 fc x)
-         x :<> y -> let (xp, xs, s1) = Textual.spanMaybe_' s0 fc x
-                        (yp, ys, s2) = Textual.spanMaybe_' s1 fc y
-                    in if null xs then (x :<> yp, ys, s2) else (xp, xs :<> y, s1)
-
-   split p = Foldable.foldr splitNext [mempty]
-      where splitNext a ~(xp:xs) =
-               let as = Leaf <$> Textual.split p a
-               in if null xp
-                  then as ++ xs
-                  else init as ++ (last as <> xp):xs
-   find p x = getFirst $ Foldable.foldMap (First . find p) x
-   elem i = Foldable.any (Textual.elem i)
-
--- Utility functions
-
-map2 :: (a -> b) -> (a, a) -> (b, b)
-map2 f (x, y) = (f x, f y)
-
-map3 :: (a -> b) -> (a, a, a) -> (b, b, b)
-map3 f (x, y, z) = (f x, f y, f z)
-
-first2 :: (a -> b) -> (a, a, c) -> (b, b, c)
-first2 f (x, y, z) = (f x, f y, z)
diff --git a/Data/Monoid/Instances/Measured.hs b/Data/Monoid/Instances/Measured.hs
deleted file mode 100644
--- a/Data/Monoid/Instances/Measured.hs
+++ /dev/null
@@ -1,124 +0,0 @@
-{- 
-    Copyright 2013-2018 Mario Blazevic
-
-    License: BSD3 (see BSD3-LICENSE.txt file)
--}
-
--- | This module defines the monoid transformer data type 'Measured'.
--- 
-
-{-# LANGUAGE Haskell2010 #-}
-
-module Data.Monoid.Instances.Measured (
-   Measured, measure, extract
-   )
-where
-
-import Data.Functor -- ((<$>))
-import qualified Data.List as List
-import Data.String (IsString(..))
-import Data.Semigroup -- (Semigroup(..))
-import Data.Monoid (Monoid(..))
-import Data.Monoid.Cancellative (LeftReductiveMonoid(..), RightReductiveMonoid(..),
-                                 LeftGCDMonoid(..), RightGCDMonoid(..))
-import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)
-import Data.Monoid.Factorial (FactorialMonoid(..), StableFactorialMonoid)
-import Data.Monoid.Textual (TextualMonoid(..))
-import qualified Data.Monoid.Factorial as Factorial
-import qualified Data.Monoid.Textual as Textual
-
-import Prelude hiding (all, any, break, filter, foldl, foldl1, foldr, foldr1, map, concatMap,
-                       length, null, reverse, scanl, scanr, scanl1, scanr1, span, splitAt)
-
--- | @'Measured' a@ is a wrapper around the 'FactorialMonoid' @a@ that memoizes the monoid's 'length' so it becomes a
--- constant-time operation. The parameter is restricted to the 'StableFactorialMonoid' class, which guarantees that
--- @'length' (a <> b) == 'length' a + 'length' b@.
-
-data Measured a = Measured{_measuredLength :: Int, extract :: a} deriving (Eq, Show)
-
--- | Create a new 'Measured' value.
-measure :: FactorialMonoid a => a -> Measured a
-measure x = Measured (length x) x
-
-instance Ord a => Ord (Measured a) where
-   compare (Measured _ x) (Measured _ y) = compare x y
-
-instance StableFactorialMonoid a => Semigroup (Measured a) where
-   Measured m a <> Measured n b = Measured (m + n) (mappend a b)
-
-instance StableFactorialMonoid a => Monoid (Measured a) where
-   mempty = Measured 0 mempty
-   mappend (Measured m a) (Measured n b) = Measured (m + n) (mappend a b)
-
-instance StableFactorialMonoid a => MonoidNull (Measured a) where
-   null (Measured n _) = n == 0
-
-instance StableFactorialMonoid a => PositiveMonoid (Measured a)
-
-instance (LeftReductiveMonoid a, StableFactorialMonoid a) => LeftReductiveMonoid (Measured a) where
-   stripPrefix (Measured m x) (Measured n y) = fmap (Measured (n - m)) (stripPrefix x y)
-
-instance (RightReductiveMonoid a, StableFactorialMonoid a) => RightReductiveMonoid (Measured a) where
-   stripSuffix (Measured m x) (Measured n y) = fmap (Measured (n - m)) (stripSuffix x y)
-
-instance (LeftGCDMonoid a, StableFactorialMonoid a) => LeftGCDMonoid (Measured a) where
-   commonPrefix (Measured _ x) (Measured _ y) = measure (commonPrefix x y)
-
-instance (RightGCDMonoid a, StableFactorialMonoid a) => RightGCDMonoid (Measured a) where
-   commonSuffix (Measured _ x) (Measured _ y) = measure (commonSuffix x y)
-
-instance StableFactorialMonoid a => FactorialMonoid (Measured a) where
-   factors (Measured _ x) = List.map (Measured 1) (factors x)
-   primePrefix m@(Measured _ x) = if null x then m else Measured 1 (primePrefix x)
-   primeSuffix m@(Measured _ x) = if null x then m else Measured 1 (primeSuffix x)
-   splitPrimePrefix (Measured n x) = case splitPrimePrefix x
-                                     of Nothing -> Nothing
-                                        Just (p, s) -> Just (Measured 1 p, Measured (n - 1) s)
-   splitPrimeSuffix (Measured n x) = case splitPrimeSuffix x
-                                     of Nothing -> Nothing
-                                        Just (p, s) -> Just (Measured (n - 1) p, Measured 1 s)
-   foldl f a0 (Measured _ x) = Factorial.foldl g a0 x
-      where g a = f a . Measured 1
-   foldl' f a0 (Measured _ x) = Factorial.foldl' g a0 x
-      where g a = f a . Measured 1
-   foldr f a0 (Measured _ x) = Factorial.foldr g a0 x
-      where g = f . Measured 1
-   length (Measured n _) = n
-   foldMap f (Measured _ x) = Factorial.foldMap (f . Measured 1) x
-   span p (Measured n x) = (xp', xs')
-      where (xp, xs) = Factorial.span (p . Measured 1) x
-            xp' = measure xp
-            xs' = Measured (n - length xp') xs
-   split p (Measured _ x) = measure <$> Factorial.split (p . Measured 1) x
-   splitAt m (Measured n x) | m <= 0 = (mempty, Measured n x)
-                            | m >= n = (Measured n x, mempty)
-                            | otherwise = (Measured m xp, Measured (n - m) xs)
-      where (xp, xs) = splitAt m x
-   reverse (Measured n x) = Measured n (reverse x)
-
-instance StableFactorialMonoid a => StableFactorialMonoid (Measured a)
-
-instance (FactorialMonoid a, IsString a) => IsString (Measured a) where
-   fromString = measure . fromString
-
-instance (Eq a, TextualMonoid a, StableFactorialMonoid a) => TextualMonoid (Measured a) where
-   fromText = measure . fromText
-   singleton = Measured 1 . singleton
-   splitCharacterPrefix (Measured n x) = (Measured (n - 1) <$>) <$> splitCharacterPrefix x
-   characterPrefix (Measured _ x) = characterPrefix x
-   map f (Measured n x) = Measured n (map f x)
-   any p (Measured _ x) = any p x
-   all p (Measured _ x) = all p x
-
-   foldl ft fc a0 (Measured _ x) = Textual.foldl (\a-> ft a . Measured 1) fc a0 x
-   foldl' ft fc a0 (Measured _ x) = Textual.foldl' (\a-> ft a . Measured 1) fc a0 x
-   foldr ft fc a0 (Measured _ x) = Textual.foldr (ft . Measured 1) fc a0 x
-   toString ft (Measured _ x) = toString (ft . Measured 1) x
-
-   span pt pc (Measured n x) = (xp', xs')
-      where (xp, xs) = Textual.span (pt . Measured 1) pc x
-            xp' = measure xp
-            xs' = Measured (n - length xp') xs
-   break pt pc = Textual.span (not . pt) (not . pc)
-
-   find p (Measured _ x) = find p x
diff --git a/Data/Monoid/Instances/Positioned.hs b/Data/Monoid/Instances/Positioned.hs
deleted file mode 100644
--- a/Data/Monoid/Instances/Positioned.hs
+++ /dev/null
@@ -1,616 +0,0 @@
-{-
-    Copyright 2014-2018 Mario Blazevic
-
-    License: BSD3 (see BSD3-LICENSE.txt file)
--}
-
--- | This module defines two monoid transformer data types, 'OffsetPositioned' and 'LinePositioned'. Both data types add
--- a notion of the current position to their base monoid. In case of 'OffsetPositioned', the current position is a
--- simple integer offset from the beginning of the monoid, and it can be applied to any 'StableFactorialMonoid'. The
--- base monoid of 'LinePositioned' must be a 'TextualMonoid', but for the price it will keep track of the current line
--- and column numbers as well.
---
--- All positions are zero-based:
---
--- >> let p = pure "abcd\nefgh\nijkl\nmnop\n" :: LinePositioned String
--- >> p
--- >Line 0, column 0: "abcd\nefgh\nijkl\nmnop\n"
--- >> Data.Monoid.Factorial.drop 13 p
--- >Line 2, column 3: "l\nmnop\n"
-
-{-# LANGUAGE Haskell2010 #-}
-
-module Data.Monoid.Instances.Positioned (
-   OffsetPositioned, LinePositioned, extract, position, line, column
-   )
-where
-
-import Control.Applicative -- (Applicative(..))
-import qualified Data.List as List
-import Data.String (IsString(..))
-
-import Data.Semigroup (Semigroup(..))
-import Data.Monoid (Monoid(..), Endo(..))
-import Data.Monoid.Cancellative (LeftReductiveMonoid(..), RightReductiveMonoid(..), LeftGCDMonoid(..), RightGCDMonoid(..))
-import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)
-import Data.Monoid.Factorial (FactorialMonoid(..), StableFactorialMonoid)
-import Data.Monoid.Textual (TextualMonoid(..))
-import qualified Data.Monoid.Factorial as Factorial
-import qualified Data.Monoid.Textual as Textual
-
-import Prelude hiding (all, any, break, filter, foldl, foldl1, foldr, foldr1, lines, map, concatMap,
-                       length, null, reverse, scanl, scanr, scanl1, scanr1, span, splitAt)
-
-class Positioned p where
-   extract :: p a -> a
-   position :: p a -> Int
-
-data OffsetPositioned m = OffsetPositioned{offset :: !Int,
-                                           -- ^ the current offset
-                                           extractOffset :: m}
-
-data LinePositioned m = LinePositioned{fullOffset :: !Int,
-                                       -- | the current line
-                                       line :: !Int,
-                                       lineStart :: !Int,
-                                       extractLines :: m}
-
--- | the current column
-column :: LinePositioned m -> Int
-column lp = position lp - lineStart lp
-
-instance Functor OffsetPositioned where
-   fmap f (OffsetPositioned p c) = OffsetPositioned p (f c)
-
-instance Functor LinePositioned where
-   fmap f (LinePositioned p l lp c) = LinePositioned p l lp (f c)
-
-instance Applicative OffsetPositioned where
-   pure = OffsetPositioned 0
-   OffsetPositioned _ f <*> OffsetPositioned p c = OffsetPositioned p (f c)
-
-instance Applicative LinePositioned where
-   pure = LinePositioned 0 0 0
-   LinePositioned _ _ _ f <*> LinePositioned p l lp c = LinePositioned p l lp (f c)
-
-instance Positioned OffsetPositioned where
-   extract = extractOffset
-   position = offset
-
-instance Positioned LinePositioned where
-   extract = extractLines
-   position = fullOffset
-
-instance Eq m => Eq (OffsetPositioned m) where
-   OffsetPositioned{extractOffset= a} == OffsetPositioned{extractOffset= b} = a == b
-
-instance Eq m => Eq (LinePositioned m) where
-   LinePositioned{extractLines= a} == LinePositioned{extractLines= b} = a == b
-
-instance Ord m => Ord (OffsetPositioned m) where
-   compare OffsetPositioned{extractOffset= a} OffsetPositioned{extractOffset= b} = compare a b
-
-instance Ord m => Ord (LinePositioned m) where
-   compare LinePositioned{extractLines= a} LinePositioned{extractLines= b} = compare a b
-
-instance Show m => Show (OffsetPositioned m) where
-   showsPrec prec (OffsetPositioned pos c) = shows pos . (": " ++) . showsPrec prec c
-
-instance Show m => Show (LinePositioned m) where
-   showsPrec prec (LinePositioned pos l lpos c) =
-      ("Line " ++) . shows l . (", column " ++) . shows (pos - lpos) . (": " ++) . showsPrec prec c
-
-instance StableFactorialMonoid m => Semigroup (OffsetPositioned m) where
-   OffsetPositioned p1 c1 <> OffsetPositioned p2 c2 =
-      OffsetPositioned (if p1 /= 0 || p2 == 0 then p1 else max 0 $ p2 - length c1) (mappend c1 c2)
-   {-# INLINE (<>) #-}
-
-instance (StableFactorialMonoid m, TextualMonoid m) => Semigroup (LinePositioned m) where
-   LinePositioned p1 l1 lp1 c1 <> LinePositioned p2 l2 lp2 c2
-     | p1 /= 0 || p2 == 0 = LinePositioned p1 l1 lp1 c
-     | otherwise = LinePositioned p2' l2' lp2' c
-     where c = mappend c1 c2
-           p2' = max 0 $ p2 - length c1
-           lp2' = min p2' lp2
-           l2' = if l2 == 0 then 0 else max 0 $ l2 - Textual.foldl_' countLines 0 c1
-           countLines :: Int -> Char -> Int
-           countLines n '\n' = succ n
-           countLines n _ = n
-   {-# INLINE (<>) #-}
-
-instance StableFactorialMonoid m => Monoid (OffsetPositioned m) where
-   mempty = pure mempty
-   mappend = (<>)
-   {-# INLINE mempty #-}
-   {-# INLINE mappend #-}
-
-instance (StableFactorialMonoid m, TextualMonoid m) => Monoid (LinePositioned m) where
-   mempty = pure mempty
-   mappend = (<>)
-   {-# INLINE mempty #-}
-   {-# INLINE mappend #-}
-
-instance (StableFactorialMonoid m, MonoidNull m) => MonoidNull (OffsetPositioned m) where
-   null = null . extractOffset
-   {-# INLINE null #-}
-
-instance (StableFactorialMonoid m, TextualMonoid m, MonoidNull m) => MonoidNull (LinePositioned m) where
-   null = null . extractLines
-   {-# INLINE null #-}
-
-instance StableFactorialMonoid m => PositiveMonoid (OffsetPositioned m)
-
-instance (StableFactorialMonoid m, TextualMonoid m) => PositiveMonoid (LinePositioned m)
-
-instance (StableFactorialMonoid m, LeftReductiveMonoid m) => LeftReductiveMonoid (OffsetPositioned m) where
-   isPrefixOf (OffsetPositioned _ c1) (OffsetPositioned _ c2) = isPrefixOf c1 c2
-   stripPrefix (OffsetPositioned _ c1) (OffsetPositioned p c2) = fmap (OffsetPositioned (p + length c1)) (stripPrefix c1 c2)
-   {-# INLINE isPrefixOf #-}
-   {-# INLINE stripPrefix #-}
-
-instance (StableFactorialMonoid m, TextualMonoid m, LeftReductiveMonoid m) =>
-         LeftReductiveMonoid (LinePositioned m) where
-   isPrefixOf a b = isPrefixOf (extractLines a) (extractLines b)
-   stripPrefix LinePositioned{extractLines= c1} (LinePositioned p l lpos c2) =
-      let (lines, columns) = linesColumns' c1
-          len = length c1
-      in fmap (LinePositioned (p + len) (l + lines) (lpos + len - columns)) (stripPrefix c1 c2)
-   {-# INLINE isPrefixOf #-}
-   {-# INLINE stripPrefix #-}
-
-instance (StableFactorialMonoid m, LeftGCDMonoid m) => LeftGCDMonoid (OffsetPositioned m) where
-   commonPrefix (OffsetPositioned p1 c1) (OffsetPositioned p2 c2) = OffsetPositioned (min p1 p2) (commonPrefix c1 c2)
-   stripCommonPrefix (OffsetPositioned p1 c1) (OffsetPositioned p2 c2) =
-      (OffsetPositioned (min p1 p2) prefix, OffsetPositioned (p1 + l) c1', OffsetPositioned (p2 + l) c2')
-      where (prefix, c1', c2') = stripCommonPrefix c1 c2
-            l = length prefix
-   {-# INLINE commonPrefix #-}
-   {-# INLINE stripCommonPrefix #-}
-
-instance (StableFactorialMonoid m, TextualMonoid m, LeftGCDMonoid m) => LeftGCDMonoid (LinePositioned m) where
-   commonPrefix (LinePositioned p1 l1 lp1 c1) (LinePositioned p2 l2 lp2 c2) =
-      if p1 <= p2
-      then LinePositioned p1 l1 lp1 (commonPrefix c1 c2)
-      else LinePositioned p2 l2 lp2 (commonPrefix c1 c2)
-   stripCommonPrefix (LinePositioned p1 l1 lp1 c1) (LinePositioned p2 l2 lp2 c2) =
-      let (prefix, c1', c2') = stripCommonPrefix c1 c2
-          (lines, columns) = linesColumns' prefix
-          len = length prefix
-      in (if p1 <= p2 then LinePositioned p1 l1 lp1 prefix else LinePositioned p2 l2 lp2 prefix,
-          LinePositioned (p1 + len) (l1 + lines) (lp1 + len - columns) c1',
-          LinePositioned (p2 + len) (l2 + lines) (lp2 + len - columns) c2')
-   {-# INLINE commonPrefix #-}
-   {-# INLINE stripCommonPrefix #-}
-
-instance (StableFactorialMonoid m, RightReductiveMonoid m) => RightReductiveMonoid (OffsetPositioned m) where
-   isSuffixOf (OffsetPositioned _ c1) (OffsetPositioned _ c2) = isSuffixOf c1 c2
-   stripSuffix (OffsetPositioned _ c1) (OffsetPositioned p c2) = fmap (OffsetPositioned p) (stripSuffix c1 c2)
-   {-# INLINE isSuffixOf #-}
-   {-# INLINE stripSuffix #-}
-
-instance (StableFactorialMonoid m, TextualMonoid m, RightReductiveMonoid m) =>
-         RightReductiveMonoid (LinePositioned m) where
-   isSuffixOf LinePositioned{extractLines=c1} LinePositioned{extractLines=c2} = isSuffixOf c1 c2
-   stripSuffix (LinePositioned p l lp c1) LinePositioned{extractLines=c2} =
-      fmap (LinePositioned p l lp) (stripSuffix c1 c2)
-   {-# INLINE isSuffixOf #-}
-   {-# INLINE stripSuffix #-}
-
-instance (StableFactorialMonoid m, RightGCDMonoid m) => RightGCDMonoid (OffsetPositioned m) where
-   commonSuffix (OffsetPositioned p1 c1) (OffsetPositioned p2 c2) =
-      OffsetPositioned (min (p1 + length c1) (p2 + length c2) - length suffix) suffix
-      where suffix = commonSuffix c1 c2
-   stripCommonSuffix (OffsetPositioned p1 c1) (OffsetPositioned p2 c2) =
-      (OffsetPositioned p1 c1', OffsetPositioned p2 c2',
-       OffsetPositioned (min (p1 + length c1') (p2 + length c2')) suffix)
-      where (c1', c2', suffix) = stripCommonSuffix c1 c2
-   {-# INLINE commonSuffix #-}
-   {-# INLINE stripCommonSuffix #-}
-
-instance (StableFactorialMonoid m, TextualMonoid m, RightGCDMonoid m) => RightGCDMonoid (LinePositioned m) where
-   stripCommonSuffix (LinePositioned p1 l1 lp1 c1) (LinePositioned p2 l2 lp2 c2) =
-      (LinePositioned p1 l1 lp1 c1', LinePositioned p2 l2 lp2 c2',
-       if p1 < p2
-       then LinePositioned (p1 + len1) (l1 + lines1) (lp1 + len1 - columns1) suffix
-       else LinePositioned (p2 + len2) (l2 + lines2) (lp2 + len2 - columns2) suffix)
-      where (c1', c2', suffix) = stripCommonSuffix c1 c2
-            len1 = length c1'
-            len2 = length c2'
-            (lines1, columns1) = linesColumns' c1'
-            (lines2, columns2) = linesColumns' c2'
-
-instance StableFactorialMonoid m => FactorialMonoid (OffsetPositioned m) where
-   factors (OffsetPositioned p c) = snd $ List.mapAccumL next p (factors c)
-      where next p1 c1 = (succ p1, OffsetPositioned p1 c1)
-   primePrefix (OffsetPositioned p c) = OffsetPositioned p (primePrefix c)
-   splitPrimePrefix (OffsetPositioned p c) = fmap rewrap (splitPrimePrefix c)
-      where rewrap (cp, cs) = (OffsetPositioned p cp, OffsetPositioned (succ p) cs)
-   splitPrimeSuffix (OffsetPositioned p c) = fmap rewrap (splitPrimeSuffix c)
-      where rewrap (cp, cs) = (OffsetPositioned p cp, OffsetPositioned (p + length cp) cs)
-   foldl f a0 (OffsetPositioned p0 c0) = fst $ Factorial.foldl f' (a0, p0) c0
-      where f' (a, p) c = (f a (OffsetPositioned p c), succ p)
-   foldl' f a0 (OffsetPositioned p0 c0) = fst $ Factorial.foldl' f' (a0, p0) c0
-      where f' (a, p) c = let a' = f a (OffsetPositioned p c) in seq a' (a', succ p)
-   foldr f a0 (OffsetPositioned p0 c0) = Factorial.foldr f' (const a0) c0 p0
-      where f' c cont p = f (OffsetPositioned p c) (cont $! succ p)
-   length (OffsetPositioned _ c) = length c
-   foldMap f (OffsetPositioned p c) = appEndo (Factorial.foldMap f' c) (const mempty) p
-      where -- f' :: m -> Endo (Int -> m)
-            f' prime = Endo (\cont pos-> f (OffsetPositioned pos prime) `mappend` cont (succ pos))
-
-   spanMaybe s0 f (OffsetPositioned p0 t) = rewrap $ Factorial.spanMaybe (s0, p0) f' t
-      where f' (s, p) prime = do s' <- f s (OffsetPositioned p prime)
-                                 let p' = succ p
-                                 Just $! seq p' (s', p')
-            rewrap (prefix, suffix, (s, p)) = (OffsetPositioned p0 prefix, OffsetPositioned p suffix, s)
-   spanMaybe' s0 f (OffsetPositioned p0 t) = rewrap $! Factorial.spanMaybe' (s0, p0) f' t
-      where f' (s, p) prime = do s' <- f s (OffsetPositioned p prime)
-                                 let p' = succ p
-                                 Just $! s' `seq` p' `seq` (s', p')
-            rewrap (prefix, suffix, (s, p)) = (OffsetPositioned p0 prefix, OffsetPositioned p suffix, s)
-   span f (OffsetPositioned p0 t) = rewrap $ Factorial.spanMaybe' p0 f' t
-      where f' p prime = if f (OffsetPositioned p prime)
-                         then Just $! succ p
-                         else Nothing
-            rewrap (prefix, suffix, p) = (OffsetPositioned p0 prefix, OffsetPositioned p suffix)
-   splitAt n m@(OffsetPositioned p c) | n <= 0 = (mempty, m)
-                                      | n >= length c = (m, mempty)
-                                      | otherwise = (OffsetPositioned p prefix, OffsetPositioned (p + n) suffix)
-      where (prefix, suffix) = splitAt n c
-   drop n (OffsetPositioned p c) = OffsetPositioned (p + n) (Factorial.drop n c)
-   take n (OffsetPositioned p c) = OffsetPositioned p (Factorial.take n c)
-   reverse (OffsetPositioned p c) = OffsetPositioned p (Factorial.reverse c)
-   {-# INLINE primePrefix #-}
-   {-# INLINE splitPrimePrefix #-}
-   {-# INLINE splitPrimeSuffix #-}
-   {-# INLINE foldl #-}
-   {-# INLINE foldl' #-}
-   {-# INLINE foldr #-}
-   {-# INLINE foldMap #-}
-   {-# INLINE length #-}
-   {-# INLINE span #-}
-   {-# INLINE splitAt #-}
-   {-# INLINE take #-}
-   {-# INLINE drop #-}
-   {-# INLINE reverse #-}
-
-instance (StableFactorialMonoid m, TextualMonoid m) => FactorialMonoid (LinePositioned m) where
-   factors (LinePositioned p0 l0 lp0 c) = snd $ List.mapAccumL next (p0, l0, lp0) (factors c)
-      where next (p, l, lp) c1 | characterPrefix c1 == Just '\n' = ((succ p, succ l, p), LinePositioned p l lp c1)
-                               | otherwise = ((succ p, l, lp), LinePositioned p l lp c1)
-   primePrefix (LinePositioned p l lp c) = LinePositioned p l lp (primePrefix c)
-   splitPrimePrefix (LinePositioned p l lp c) = fmap rewrap (splitPrimePrefix c)
-      where rewrap (cp, cs) = (LinePositioned p l lp cp,
-                               if characterPrefix cp == Just '\n'
-                               then LinePositioned (succ p) (succ l) p cs
-                               else LinePositioned (succ p) l lp cs)
-   splitPrimeSuffix (LinePositioned p l lp c) = fmap rewrap (splitPrimeSuffix c)
-      where rewrap (cp, cs) = (LinePositioned p l lp cp, LinePositioned p' (l + lines) (p' - columns) cs)
-               where len = length cp
-                     (lines, columns) = linesColumns cp
-                     p' = p + len
-   foldl f a0 (LinePositioned p0 l0 lp0 c0) = fstOf4 $! Factorial.foldl f' (a0, p0, l0, lp0) c0
-      where f' (a, p, l, lp) c | characterPrefix c == Just '\n' = (f a (LinePositioned p l lp c), succ p, succ l, p)
-                               | otherwise = (f a (LinePositioned p l lp c), succ p, l, lp)
-   foldl' f a0 (LinePositioned p0 l0 lp0 c0) = fstOf4 $! Factorial.foldl' f' (a0, p0, l0, lp0) c0
-      where f' (a, p, l, lp) c = let a' = f a (LinePositioned p l lp c)
-                                 in seq a' (if characterPrefix c == Just '\n'
-                                            then (a', succ p, succ l, p)
-                                            else (a', succ p, l, lp))
-   foldr f a0 (LinePositioned p0 l0 lp0 c0) = Factorial.foldr f' (const3 a0) c0 p0 l0 lp0
-      where f' c cont p l lp
-               | characterPrefix c == Just '\n' = f (LinePositioned p l lp c) $ ((cont $! succ p) $! succ l) p
-               | otherwise = f (LinePositioned p l lp c) $ (cont $! succ p) l lp
-   length = length . extractLines
-   foldMap f (LinePositioned p0 l0 lp0 c) = appEndo (Factorial.foldMap f' c) (const mempty) p0 l0 lp0
-      where -- f' :: m -> Endo (Int -> Int -> Int -> m)
-            f' prime = Endo (\cont p l lp-> f (LinePositioned p l lp prime)
-                                            `mappend`
-                                            if characterPrefix prime == Just '\n'
-                                            then cont (succ p) (succ l) p
-                                            else cont (succ p) l lp)
-
-   spanMaybe s0 f (LinePositioned p0 l0 lp0 c) = rewrap $ Factorial.spanMaybe (s0, p0, l0, lp0) f' c
-      where f' (s, p, l, lp) prime = do s' <- f s (LinePositioned p l lp prime)
-                                        let p' = succ p
-                                            l' = succ l
-                                        Just $! p' `seq` if characterPrefix prime == Just '\n'
-                                                         then l' `seq` (s', p', l', p)
-                                                         else (s', p', l, lp)
-            rewrap (prefix, suffix, (s, p, l, lp)) = (LinePositioned p0 l0 lp0 prefix, LinePositioned p l lp suffix, s)
-   spanMaybe' s0 f (LinePositioned p0 l0 lp0 c) = rewrap $! Factorial.spanMaybe' (s0, p0, l0, lp0) f' c
-      where f' (s, p, l, lp) prime = do s' <- f s (LinePositioned p l lp prime)
-                                        let p' = succ p
-                                            l' = succ l
-                                        Just $! s' `seq` p' `seq` if characterPrefix prime == Just '\n'
-                                                                  then l' `seq` (s', p', l', p)
-                                                                  else (s', p', l, lp)
-            rewrap (prefix, suffix, (s, p, l, lp)) = (LinePositioned p0 l0 lp0 prefix, LinePositioned p l lp suffix, s)
-
-   span f (LinePositioned p0 l0 lp0 t) = rewrap $ Factorial.spanMaybe' (p0, l0, lp0) f' t
-      where f' (p, l, lp) prime = if f (LinePositioned p l lp prime)
-                                  then let p' = succ p
-                                           l' = succ l
-                                       in Just $! p' `seq` if characterPrefix prime == Just '\n'
-                                                           then l' `seq` (p', l', p)
-                                                           else (p', l, lp)
-                                  else Nothing
-            rewrap (prefix, suffix, (p, l, lp)) = (LinePositioned p0 l0 lp0 prefix, LinePositioned p l lp suffix)
-   splitAt n m@(LinePositioned p l lp c) | n <= 0 = (mempty, m)
-                                         | n >= length c = (m, mempty)
-                                         | otherwise = (LinePositioned p l lp prefix,
-                                                        LinePositioned p' (l + lines) (p' - columns) suffix)
-      where (prefix, suffix) = splitAt n c
-            (lines, columns) = linesColumns prefix
-            p' = p + n
-   take n (LinePositioned p l lp c) = LinePositioned p l lp (Factorial.take n c)
-   reverse (LinePositioned p l lp c) = LinePositioned p l lp (Factorial.reverse c)
-   {-# INLINE primePrefix #-}
-   {-# INLINE splitPrimePrefix #-}
-   {-# INLINE splitPrimeSuffix #-}
-   {-# INLINE foldl #-}
-   {-# INLINE foldl' #-}
-   {-# INLINE foldr #-}
-   {-# INLINE foldMap #-}
-   {-# INLINE length #-}
-   {-# INLINE span #-}
-   {-# INLINE splitAt #-}
-   {-# INLINE take #-}
-   {-# INLINE reverse #-}
-
-instance StableFactorialMonoid m => StableFactorialMonoid (OffsetPositioned m)
-
-instance (StableFactorialMonoid m, TextualMonoid m) => StableFactorialMonoid (LinePositioned m)
-
-instance IsString m => IsString (OffsetPositioned m) where
-   fromString = pure . fromString
-
-instance IsString m => IsString (LinePositioned m) where
-   fromString = pure . fromString
-
-instance (StableFactorialMonoid m, TextualMonoid m) => TextualMonoid (OffsetPositioned m) where
-   splitCharacterPrefix (OffsetPositioned p c) = fmap (fmap $ OffsetPositioned $ succ p) (splitCharacterPrefix c)
-
-   fromText = pure . fromText
-   singleton = pure . singleton
-
-   characterPrefix = characterPrefix . extractOffset
-
-   map f (OffsetPositioned p c) = OffsetPositioned p (map f c)
-   concatMap f (OffsetPositioned p c) = OffsetPositioned p (concatMap (extractOffset . f) c)
-   all p = all p . extractOffset
-   any p = any p . extractOffset
-
-   foldl ft fc a0 (OffsetPositioned p0 c0) = fst $ Textual.foldl ft' fc' (a0, p0) c0
-      where ft' (a, p) c = (ft a (OffsetPositioned p c), succ p)
-            fc' (a, p) c = (fc a c, succ p)
-   foldl' ft fc a0 (OffsetPositioned p0 c0) = fst $ Textual.foldl' ft' fc' (a0, p0) c0
-      where ft' (a, p) c = ((,) $! ft a (OffsetPositioned p c)) $! succ p
-            fc' (a, p) c = ((,) $! fc a c) $! succ p
-   foldr ft fc a0 (OffsetPositioned p0 c0) = snd $ Textual.foldr ft' fc' (p0, a0) c0
-      where ft' c (p, a) = (succ p, ft (OffsetPositioned p c) a)
-            fc' c (p, a) = (succ p, fc c a)
-
-   scanl f ch (OffsetPositioned p c) = OffsetPositioned p (Textual.scanl f ch c)
-   scanl1 f (OffsetPositioned p c) = OffsetPositioned p (Textual.scanl1 f c)
-   scanr f ch (OffsetPositioned p c) = OffsetPositioned p (Textual.scanr f ch c)
-   scanr1 f (OffsetPositioned p c) = OffsetPositioned p (Textual.scanr1 f c)
-   mapAccumL f a0 (OffsetPositioned p c) = fmap (OffsetPositioned p) (Textual.mapAccumL f a0 c)
-   mapAccumR f a0 (OffsetPositioned p c) = fmap (OffsetPositioned p) (Textual.mapAccumR f a0 c)
-
-   spanMaybe s0 ft fc (OffsetPositioned p0 t) = rewrap $ Textual.spanMaybe (s0, p0) ft' fc' t
-      where ft' (s, p) prime = do s' <- ft s (OffsetPositioned p prime)
-                                  let p' = succ p
-                                  Just $! seq p' (s', p')
-            fc' (s, p) c = do s' <- fc s c
-                              let p' = succ p
-                              Just $! seq p' (s', p')
-            rewrap (prefix, suffix, (s, p)) = (OffsetPositioned p0 prefix, OffsetPositioned p suffix, s)
-   spanMaybe' s0 ft fc (OffsetPositioned p0 t) = rewrap $! Textual.spanMaybe' (s0, p0) ft' fc' t
-      where ft' (s, p) prime = do s' <- ft s (OffsetPositioned p prime)
-                                  let p' = succ p
-                                  Just $! s' `seq` p' `seq` (s', p')
-            fc' (s, p) c = do s' <- fc s c
-                              let p' = succ p
-                              Just $! s' `seq` p' `seq` (s', p')
-            rewrap (prefix, suffix, (s, p)) = (OffsetPositioned p0 prefix, OffsetPositioned p suffix, s)
-   span ft fc (OffsetPositioned p0 t) = rewrap $ Textual.spanMaybe' p0 ft' fc' t
-      where ft' p prime = if ft (OffsetPositioned p prime)
-                          then Just $! succ p
-                          else Nothing
-            fc' p c = if fc c
-                      then Just $! succ p
-                      else Nothing
-            rewrap (prefix, suffix, p) = (OffsetPositioned p0 prefix, OffsetPositioned p suffix)
-
-   split f (OffsetPositioned p0 c0) = rewrap p0 (Textual.split f c0)
-      where rewrap _ [] = []
-            rewrap p (c:rest) = OffsetPositioned p c : rewrap (p + length c) rest
-   find p = find p . extractOffset
-
-   foldl_ fc a0 (OffsetPositioned _ c) = Textual.foldl_ fc a0 c
-   foldl_' fc a0 (OffsetPositioned _ c) = Textual.foldl_' fc a0 c
-   foldr_ fc a0 (OffsetPositioned _ c) = Textual.foldr_ fc a0 c
-
-   spanMaybe_ s0 fc (OffsetPositioned p0 t) = rewrap $ Textual.spanMaybe_' (s0, p0) fc' t
-      where fc' (s, p) c = do s' <- fc s c
-                              let p' = succ p
-                              Just $! seq p' (s', p')
-            rewrap (prefix, suffix, (s, p)) = (OffsetPositioned p0 prefix, OffsetPositioned p suffix, s)
-   spanMaybe_' s0 fc (OffsetPositioned p0 t) = rewrap $! Textual.spanMaybe_' (s0, p0) fc' t
-      where fc' (s, p) c = do s' <- fc s c
-                              let p' = succ p
-                              Just $! s' `seq` p' `seq` (s', p')
-            rewrap (prefix, suffix, (s, p)) = (OffsetPositioned p0 prefix, OffsetPositioned p suffix, s)
-   span_ bt fc (OffsetPositioned p0 t) = rewrap $ Textual.span_ bt fc t
-      where rewrap (prefix, suffix) = (OffsetPositioned p0 prefix, OffsetPositioned (p0 + length prefix) suffix)
-   break_ bt fc (OffsetPositioned p0 t) = rewrap $ Textual.break_ bt fc t
-      where rewrap (prefix, suffix) = (OffsetPositioned p0 prefix, OffsetPositioned (p0 + length prefix) suffix)
-   dropWhile_ bt fc t = snd (span_ bt fc t)
-   takeWhile_ bt fc (OffsetPositioned p t) = OffsetPositioned p (takeWhile_ bt fc t)
-
-   {-# INLINE characterPrefix #-}
-   {-# INLINE splitCharacterPrefix #-}
-   {-# INLINE map #-}
-   {-# INLINE concatMap #-}
-   {-# INLINE foldl' #-}
-   {-# INLINE foldr #-}
-   {-# INLINE spanMaybe' #-}
-   {-# INLINE span #-}
-   {-# INLINE foldl_' #-}
-   {-# INLINE foldr_ #-}
-   {-# INLINE any #-}
-   {-# INLINE all #-}
-   {-# INLINE spanMaybe_' #-}
-   {-# INLINE span_ #-}
-   {-# INLINE break_ #-}
-   {-# INLINE dropWhile_ #-}
-   {-# INLINE takeWhile_ #-}
-   {-# INLINE split #-}
-   {-# INLINE find #-}
-
-instance (StableFactorialMonoid m, TextualMonoid m) => TextualMonoid (LinePositioned m) where
-   splitCharacterPrefix (LinePositioned p l lp c) =
-      case splitCharacterPrefix c
-      of Nothing -> Nothing
-         Just ('\n', rest) -> Just ('\n', LinePositioned (succ p) (succ l) p rest)
-         Just (ch, rest) -> Just (ch, LinePositioned (succ p) l lp rest)
-
-   fromText = pure . fromText
-   singleton = pure . singleton
-
-   characterPrefix = characterPrefix . extractLines
-
-   map f (LinePositioned p l lp c) = LinePositioned p l lp (map f c)
-   concatMap f (LinePositioned p l lp c) = LinePositioned p l lp (concatMap (extractLines . f) c)
-   all p = all p . extractLines
-   any p = any p . extractLines
-
-   foldl ft fc a0 (LinePositioned p0 l0 lp0 c0) = fstOf4 $ Textual.foldl ft' fc' (a0, p0, l0, lp0) c0
-      where ft' (a, p, l, lp) c = (ft a (LinePositioned p l lp c), succ p, l, lp)
-            fc' (a, p, l, _lp) '\n' = (fc a '\n', succ p, succ l, p)
-            fc' (a, p, l, lp) c = (fc a c, succ p, l, lp)
-   foldl' ft fc a0 (LinePositioned p0 l0 lp0 c0) = fstOf4 $ Textual.foldl' ft' fc' (a0, p0, l0, lp0) c0
-      where ft' (a, p, l, lp) c = let a' = ft a (LinePositioned p l lp c)
-                                      p' = succ p
-                                  in a' `seq` p' `seq` (a', p', l, lp)
-            fc' (a, p, l, lp) c = let a' = fc a c
-                                      p' = succ p
-                                      l' = succ l
-                                  in a' `seq` p' `seq` if c == '\n'
-                                                       then l' `seq` (a', p', l', p)
-                                                       else (a', p', l, lp)
-   foldr ft fc a0 (LinePositioned p0 l0 lp0 c0) = Textual.foldr ft' fc' (const3 a0) c0 p0 l0 lp0
-      where ft' c cont p l lp = ft (LinePositioned p l lp c) $ (cont $! succ p) l lp
-            fc' c cont p l lp
-               | c == '\n' = fc c $ ((cont $! succ p) $! succ l) p
-               | otherwise = fc c $ (cont $! succ p) l lp
-
-   spanMaybe s0 ft fc (LinePositioned p0 l0 lp0 t) = rewrap $ Textual.spanMaybe (s0, p0, l0, lp0) ft' fc' t
-      where ft' (s, p, l, lp) prime = do s' <- ft s (LinePositioned p l lp prime)
-                                         let p' = succ p
-                                         Just $! seq p' (s', p', l, lp)
-            fc' (s, p, l, lp) c = fc s c
-                                  >>= \s'-> Just $! seq p' (if c == '\n' then seq l' (s', p', l', p) else (s', p', l, lp))
-               where p' = succ p
-                     l' = succ l
-            rewrap (prefix, suffix, (s, p, l, lp)) = (LinePositioned p0 l0 lp0 prefix, LinePositioned p l lp suffix, s)
-   spanMaybe' s0 ft fc (LinePositioned p0 l0 lp0 t) = rewrap $! Textual.spanMaybe' (s0, p0, l0, lp0) ft' fc' t
-      where ft' (s, p, l, lp) prime = do s' <- ft s (LinePositioned p l lp prime)
-                                         let p' = succ p
-                                         Just $! s' `seq` p' `seq` (s', p', l, lp)
-            fc' (s, p, l, lp) c = do s' <- fc s c
-                                     let p' = succ p
-                                         l' = succ l
-                                     Just $! s' `seq` p' `seq` (if c == '\n' then seq l' (s', p', l', p) else (s', p', l, lp))
-            rewrap (prefix, suffix, (s, p, l, lp)) = (LinePositioned p0 l0 lp0 prefix, LinePositioned p l lp suffix, s)
-   span ft fc (LinePositioned p0 l0 lp0 t) = rewrap $ Textual.spanMaybe' (p0, l0, lp0) ft' fc' t
-      where ft' (p, l, lp) prime = if ft (LinePositioned p l lp prime)
-                                   then let p' = succ p
-                                        in p' `seq` Just (p', l, lp)
-                                   else Nothing
-            fc' (p, l, lp) c | fc c = Just $! seq p' (if c == '\n' then seq l' (p', l', p) else (p', l, lp))
-                             | otherwise = Nothing
-               where p' = succ p
-                     l' = succ l
-            rewrap (prefix, suffix, (p, l, lp)) = (LinePositioned p0 l0 lp0 prefix, LinePositioned p l lp suffix)
-
-   scanl f ch (LinePositioned p l lp c) = LinePositioned p l lp (Textual.scanl f ch c)
-   scanl1 f (LinePositioned p l lp c) = LinePositioned p l lp (Textual.scanl1 f c)
-   scanr f ch (LinePositioned p l lp c) = LinePositioned p l lp (Textual.scanr f ch c)
-   scanr1 f (LinePositioned p l lp c) = LinePositioned p l lp (Textual.scanr1 f c)
-   mapAccumL f a0 (LinePositioned p l lp c) = fmap (LinePositioned p l lp) (Textual.mapAccumL f a0 c)
-   mapAccumR f a0 (LinePositioned p l lp c) = fmap (LinePositioned p l lp) (Textual.mapAccumR f a0 c)
-
-   split f (LinePositioned p0 l0 lp0 c0) = rewrap p0 l0 lp0 (Textual.split f c0)
-      where rewrap _ _ _ [] = []
-            rewrap p l lp (c:rest) = LinePositioned p l lp c
-                                     : rewrap p' (l + lines) (if lines == 0 then lp else p' - columns) rest
-               where p' = p + length c
-                     (lines, columns) = linesColumns c
-   find p = find p . extractLines
-
-   foldl_ fc a0 (LinePositioned _ _ _ t) = Textual.foldl_ fc a0 t
-   foldl_' fc a0 (LinePositioned _ _ _ t) = Textual.foldl_' fc a0 t
-   foldr_ fc a0 (LinePositioned _ _ _ t) = Textual.foldr_ fc a0 t
-
-   spanMaybe_ s0 fc (LinePositioned p0 l0 lp0 t) = rewrap $ Textual.spanMaybe_ s0 fc t
-      where rewrap (prefix, suffix, s) = (LinePositioned p0 l0 lp0 prefix,
-                                          LinePositioned p1 (l0 + l) (if l == 0 then lp0 else p1 - col) suffix,
-                                          s)
-              where (l, col) = linesColumns prefix
-                    p1 = p0 + length prefix
-   spanMaybe_' s0 fc (LinePositioned p0 l0 lp0 t) = rewrap $ Textual.spanMaybe_' s0 fc t
-      where rewrap (prefix, suffix, s) = p1 `seq` l1 `seq` lp1 `seq`
-                                         (LinePositioned p0 l0 lp0 prefix, LinePositioned p1 l1 lp1 suffix, s)
-              where (l, col) = linesColumns' prefix
-                    p1 = p0 + length prefix
-                    l1 = l0 + l
-                    lp1 = if l == 0 then lp0 else p1 - col
-   span_ bt fc (LinePositioned p0 l0 lp0 t) = rewrap $ Textual.span_ bt fc t
-      where rewrap (prefix, suffix) = (LinePositioned p0 l0 lp0 prefix,
-                                       LinePositioned p1 (l0 + l) (if l == 0 then lp0 else p1 - col) suffix)
-              where (l, col) = linesColumns' prefix
-                    p1 = p0 + length prefix
-   break_ bt fc t = span_ (not bt) (not . fc) t
-   dropWhile_ bt fc t = snd (span_ bt fc t)
-   takeWhile_ bt fc (LinePositioned p l lp t) = LinePositioned p l lp (takeWhile_ bt fc t)
-
-   {-# INLINE characterPrefix #-}
-   {-# INLINE splitCharacterPrefix #-}
-   {-# INLINE map #-}
-   {-# INLINE concatMap #-}
-   {-# INLINE foldl' #-}
-   {-# INLINE foldr #-}
-   {-# INLINE spanMaybe' #-}
-   {-# INLINE span #-}
-   {-# INLINE split #-}
-   {-# INLINE find #-}
-   {-# INLINE foldl_' #-}
-   {-# INLINE foldr_ #-}
-   {-# INLINE any #-}
-   {-# INLINE all #-}
-   {-# INLINE spanMaybe_' #-}
-   {-# INLINE span_ #-}
-   {-# INLINE break_ #-}
-   {-# INLINE dropWhile_ #-}
-   {-# INLINE takeWhile_ #-}
-
-linesColumns :: TextualMonoid m => m -> (Int, Int)
-linesColumns t = Textual.foldl (const . fmap succ) fc (0, 0) t
-   where fc (l, _) '\n' = (succ l, 0)
-         fc (l, c) _ = (l, succ c)
-linesColumns' :: TextualMonoid m => m -> (Int, Int)
-linesColumns' t = Textual.foldl' (const . fmap succ) fc (0, 0) t
-   where fc (l, _) '\n' = let l' = succ l in seq l' (l', 0)
-         fc (l, c) _ = let c' = succ c in seq c' (l, c')
-{-# INLINE linesColumns #-}
-{-# INLINE linesColumns' #-}
-
-const3 :: a -> b -> c -> d -> a
-const3 a _p _l _lp = a
-{-# INLINE const3 #-}
-
-fstOf4 :: (a, b, c, d) -> a
-fstOf4 (a, _, _, _) = a
-{-# INLINE fstOf4  #-}
diff --git a/Data/Monoid/Instances/Stateful.hs b/Data/Monoid/Instances/Stateful.hs
deleted file mode 100644
--- a/Data/Monoid/Instances/Stateful.hs
+++ /dev/null
@@ -1,236 +0,0 @@
-{-
-    Copyright 2013-2018 Mario Blazevic
-
-    License: BSD3 (see BSD3-LICENSE.txt file)
--}
-
--- | This module defines the monoid transformer data type 'Stateful'.
---
--- >> let s = setState [4] $ pure "data" :: Stateful [Int] String
--- >> s
--- >Stateful ("data",[4])
--- >> factors s
--- >[Stateful ("d",[]),Stateful ("a",[]),Stateful ("t",[]),Stateful ("a",[]),Stateful ("",[4])]
-
-{-# LANGUAGE Haskell2010 #-}
-
-module Data.Monoid.Instances.Stateful (
-   Stateful(Stateful), extract, state, setState
-   )
-where
-
-import Control.Applicative -- (Applicative(..))
-import Data.Functor -- ((<$>))
-import qualified Data.List as List
-import Data.String (IsString(..))
-import Data.Semigroup -- (Semigroup(..))
-import Data.Monoid (Monoid(..))
-import Data.Monoid.Cancellative (LeftReductiveMonoid(..), LeftGCDMonoid(..), RightReductiveMonoid(..), RightGCDMonoid(..))
-import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)
-import Data.Monoid.Factorial (FactorialMonoid(..), StableFactorialMonoid)
-import Data.Monoid.Textual (TextualMonoid(..))
-import qualified Data.Monoid.Factorial as Factorial
-import qualified Data.Monoid.Textual as Textual
-
-import Prelude hiding (all, any, break, elem, drop, filter, foldl, foldl1, foldr, foldr1, gcd, map, concatMap,
-                       length, null, reverse, scanl, scanr, scanl1, scanr1, span, splitAt, take)
-
--- | @'Stateful' a b@ is a wrapper around the 'Monoid' @b@ that carries the state @a@ along. The state type @a@ must be
--- a monoid as well if 'Stateful' is to be of any use. In the 'FactorialMonoid' and 'TextualMonoid' class instances, the
--- monoid @b@ has the priority and the state @a@ is left for the end.
-newtype Stateful a b = Stateful (b, a) deriving (Eq, Ord, Show)
-
-extract :: Stateful a b -> b
-extract (Stateful (t, _)) = t
-
-state :: Stateful a b -> a
-state (Stateful (_, x)) = x
-
-setState :: a -> Stateful a b -> Stateful a b
-setState s (Stateful (t, _)) = Stateful (t, s)
-
-instance Functor (Stateful a) where
-   fmap f (Stateful (x, s)) = Stateful (f x, s)
-
-instance Monoid a => Applicative (Stateful a) where
-   pure m = Stateful (m, mempty)
-   Stateful (f, s1) <*> Stateful (x, s2) = Stateful (f x, mappend s1 s2)
-
-instance (Semigroup a, Semigroup b) => Semigroup (Stateful a b) where
-   Stateful x <> Stateful y = Stateful (x <> y)
-   {-# INLINE (<>) #-}
-
-instance (Monoid a, Monoid b) => Monoid (Stateful a b) where
-   mempty = Stateful mempty
-   Stateful x `mappend` Stateful y = Stateful (mappend x y)
-   {-# INLINE mempty #-}
-   {-# INLINE mappend #-}
-
-instance (MonoidNull a, MonoidNull b) => MonoidNull (Stateful a b) where
-   null (Stateful x) = null x
-   {-# INLINE null #-}
-
-instance (PositiveMonoid a, PositiveMonoid b) => PositiveMonoid (Stateful a b)
-
-instance (LeftReductiveMonoid a, LeftReductiveMonoid b) => LeftReductiveMonoid (Stateful a b) where
-   isPrefixOf (Stateful x) (Stateful x') = isPrefixOf x x'
-   stripPrefix (Stateful x) (Stateful x') = Stateful <$> stripPrefix x x'
-   {-# INLINE isPrefixOf #-}
-   {-# INLINE stripPrefix #-}
-
-instance (RightReductiveMonoid a, RightReductiveMonoid b) => RightReductiveMonoid (Stateful a b) where
-   isSuffixOf (Stateful x) (Stateful x') = isSuffixOf x x'
-   stripSuffix (Stateful x) (Stateful x') = Stateful <$> stripSuffix x x'
-   {-# INLINE stripSuffix #-}
-   {-# INLINE isSuffixOf #-}
-
-instance (LeftGCDMonoid a, LeftGCDMonoid b) => LeftGCDMonoid (Stateful a b) where
-   commonPrefix (Stateful x) (Stateful x') = Stateful (commonPrefix x x')
-   stripCommonPrefix (Stateful x) (Stateful x') = (Stateful prefix, Stateful suffix1, Stateful suffix2)
-      where (prefix, suffix1, suffix2) = stripCommonPrefix x x'
-   {-# INLINE commonPrefix #-}
-   {-# INLINE stripCommonPrefix #-}
-
-instance (RightGCDMonoid a, RightGCDMonoid b) => RightGCDMonoid (Stateful a b) where
-   commonSuffix (Stateful x) (Stateful x') = Stateful (commonSuffix x x')
-   {-# INLINE commonSuffix #-}
-
-instance (FactorialMonoid a, FactorialMonoid b) => FactorialMonoid (Stateful a b) where
-   factors (Stateful x) = List.map Stateful (factors x)
-   length (Stateful x) = length x
-   reverse (Stateful x) = Stateful (reverse x)
-   primePrefix (Stateful x) = Stateful (primePrefix x)
-   primeSuffix (Stateful x) = Stateful (primeSuffix x)
-   splitPrimePrefix (Stateful x) = do (xp, xs) <- splitPrimePrefix x
-                                      return (Stateful xp, Stateful xs)
-   splitPrimeSuffix (Stateful x) = do (xp, xs) <- splitPrimeSuffix x
-                                      return (Stateful xp, Stateful xs)
-   foldl f a0 (Stateful x) = Factorial.foldl f' a0 x
-      where f' a x1 = f a (Stateful x1)
-   foldl' f a0 (Stateful x) = Factorial.foldl' f' a0 x
-      where f' a x1 = f a (Stateful x1)
-   foldr f a (Stateful x) = Factorial.foldr (f . Stateful) a x
-   foldMap f (Stateful x) = Factorial.foldMap (f . Stateful) x
-   span p (Stateful x) = (Stateful xp, Stateful xs)
-      where (xp, xs) = Factorial.span (p . Stateful) x
-   spanMaybe s0 f (Stateful x) = (Stateful xp, Stateful xs, s')
-      where (xp, xs, s') = Factorial.spanMaybe s0 f' x
-            f' s x1 = f s (Stateful x1)
-   spanMaybe' s0 f (Stateful x) = (Stateful xp, Stateful xs, s')
-      where (xp, xs, s') = Factorial.spanMaybe' s0 f' x
-            f' s x1 = f s (Stateful x1)
-   split p (Stateful x) = List.map Stateful (Factorial.split (p . Stateful) x)
-   splitAt n (Stateful x) = (Stateful xp, Stateful xs)
-      where (xp, xs) = splitAt n x
-   take n (Stateful x) = Stateful (take n x)
-   drop n (Stateful x) = Stateful (drop n x)
-   {-# INLINE primePrefix #-}
-   {-# INLINE primeSuffix #-}
-   {-# INLINE splitPrimePrefix #-}
-   {-# INLINE splitPrimeSuffix #-}
-   {-# INLINE foldl' #-}
-   {-# INLINE foldr #-}
-   {-# INLINE foldMap #-}
-   {-# INLINE length #-}
-   {-# INLINE span #-}
-   {-# INLINE spanMaybe #-}
-   {-# INLINE spanMaybe' #-}
-   {-# INLINE splitAt #-}
-   {-# INLINE take #-}
-   {-# INLINE drop #-}
-
-instance (StableFactorialMonoid a, StableFactorialMonoid b) => StableFactorialMonoid (Stateful a b)
-
-instance (Monoid a, IsString b) => IsString (Stateful a b) where
-   fromString = pure . fromString
-
-instance (LeftGCDMonoid a, FactorialMonoid a, TextualMonoid b) => TextualMonoid (Stateful a b) where
-   fromText t = Stateful (fromText t, mempty)
-   singleton c = Stateful (singleton c, mempty)
-
-   characterPrefix = characterPrefix . extract
-   splitCharacterPrefix (Stateful (t, x)) = do (c, t') <- splitCharacterPrefix t
-                                               return (c, Stateful (t', x))
-
-   map f (Stateful (t, x)) = Stateful (Textual.map f t, x)
-   all p = all p . extract
-   any p = any p . extract
-
-   foldl fx fc a0 (Stateful (t, x)) = Factorial.foldl f2 (Textual.foldl f1 fc a0 t) x
-      where f1 a = fx a . fromFst
-            f2 a = fx a . fromSnd
-   foldr fx fc a (Stateful (t, x)) = Textual.foldr (fx . fromFst) fc (Factorial.foldr (fx . fromSnd) a x) t
-   foldl' fx fc a0 (Stateful (t, x)) = a' `seq` Factorial.foldl' f2 a' x
-      where a' = Textual.foldl' f1 fc a0 t
-            f1 a = fx a . fromFst
-            f2 a = fx a . fromSnd
-   foldl_' fc a (Stateful (t, _)) = foldl_' fc a t
-   foldr_ fc a (Stateful (t, _)) = Textual.foldr_ fc a t
-   toString fx (Stateful (t, x)) = toString (fx . fromFst) t ++ Factorial.foldMap (fx . fromSnd) x
-
-   scanl f c (Stateful (t, x)) = Stateful (Textual.scanl f c t, x)
-   scanl1 f (Stateful (t, x)) = Stateful (Textual.scanl1 f t, x)
-   scanr f c (Stateful (t, x)) = Stateful (Textual.scanr f c t, x)
-   scanr1 f (Stateful (t, x)) = Stateful (Textual.scanr1 f t, x)
-   mapAccumL f a (Stateful (t, x)) = (a', Stateful (t', x))
-      where (a', t') = Textual.mapAccumL f a t
-   mapAccumR f a (Stateful (t, x)) = (a', Stateful (t', x))
-      where (a', t') = Textual.mapAccumR f a t
-
-   span pt pc (Stateful (t, x)) = (Stateful (tp, xp), Stateful (ts, xs))
-      where (tp, ts) = Textual.span (pt . fromFst) pc t
-            (xp, xs) | null ts = Factorial.span (pt . fromSnd) x
-                     | otherwise = (mempty, x)
-   span_ bt pc (Stateful (t, x)) = (Stateful (tp, xp), Stateful (ts, xs))
-      where (tp, ts) = Textual.span_ bt pc t
-            (xp, xs) | null ts && bt = (x, mempty)
-                     | otherwise = (mempty, x)
-   break pt pc (Stateful (t, x)) = (Stateful (tp, xp), Stateful (ts, xs))
-      where (tp, ts) = Textual.break (pt . fromFst) pc t
-            (xp, xs) | null ts = Factorial.break (pt . fromSnd) x
-                     | otherwise = (mempty, x)
-   spanMaybe s0 ft fc (Stateful (t, x)) = (Stateful (tp, xp), Stateful (ts, xs), s'')
-      where (tp, ts, s') = Textual.spanMaybe s0 ft' fc t
-            (xp, xs, s'') | null ts = Factorial.spanMaybe s' ft'' x
-                          | otherwise = (mempty, x, s')
-            ft' s t1 = ft s (Stateful (t1, mempty))
-            ft'' s x1 = ft s (Stateful (mempty, x1))
-   spanMaybe' s0 ft fc (Stateful (t, x)) = (Stateful (tp, xp), Stateful (ts, xs), s'')
-      where (tp, ts, s') = Textual.spanMaybe' s0 ft' fc t
-            (xp, xs, s'') | null ts = Factorial.spanMaybe' s' ft'' x
-                          | otherwise = (mempty, x, s')
-            ft' s t1 = ft s (Stateful (t1, mempty))
-            ft'' s x1 = ft s (Stateful (mempty, x1))
-   spanMaybe_' s0 fc (Stateful (t, x)) = (Stateful (tp, xp), Stateful (ts, xs), s')
-      where (tp, ts, s') = Textual.spanMaybe_' s0 fc t
-            (xp, xs) | null ts = (x, mempty)
-                     | otherwise = (mempty, x)
-   split p (Stateful (t, x)) = restore id ts
-      where ts = Textual.split p t
-            restore f [t1] = f [Stateful (t1, x)]
-            restore f ~(hd:tl) = restore (f . (Stateful (hd, mempty):)) tl
-   find p = find p . extract
-   elem c = elem c . extract
-
-   {-# INLINE characterPrefix #-}
-   {-# INLINE splitCharacterPrefix #-}
-   {-# INLINE map #-}
-   {-# INLINE foldl' #-}
-   {-# INLINE foldr #-}
-   {-# INLINE spanMaybe' #-}
-   {-# INLINE span #-}
-   {-# INLINE spanMaybe_' #-}
-   {-# INLINE span_ #-}
-   {-# INLINE any #-}
-   {-# INLINE all #-}
-   {-# INLINE split #-}
-   {-# INLINE find #-}
-   {-# INLINE elem #-}
-
-{-# INLINE fromFst #-}
-fromFst :: Monoid b => a -> Stateful b a
-fromFst a = Stateful (a, mempty)
-
-{-# INLINE fromSnd #-}
-fromSnd :: Monoid a => b -> Stateful b a
-fromSnd b = Stateful (mempty, b)
diff --git a/Data/Monoid/Null.hs b/Data/Monoid/Null.hs
deleted file mode 100644
--- a/Data/Monoid/Null.hs
+++ /dev/null
@@ -1,148 +0,0 @@
-{- 
-    Copyright 2013-2015 Mario Blazevic
-
-    License: BSD3 (see BSD3-LICENSE.txt file)
--}
-
--- | This module defines the MonoidNull class and some of its instances.
--- 
-
-{-# LANGUAGE Haskell2010, Trustworthy #-}
-
-module Data.Monoid.Null (
-   MonoidNull(..), PositiveMonoid
-   )
-where
-   
-import Data.Monoid -- (Monoid, First(..), Last(..), Dual(..), Sum(..), Product(..), All(getAll), Any(getAny))
-import qualified Data.List as List
-import qualified Data.ByteString 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 Prelude hiding (null)
-
--- | Extension of 'Monoid' that allows testing a value for equality with 'mempty'. The following law must hold:
--- 
--- prop> null x == (x == mempty)
--- 
--- Furthermore, the performance of this method should be constant, /i.e./, independent of the length of its argument.
-class Monoid m => MonoidNull m where
-   null :: m -> Bool
-
--- | Subclass of 'Monoid' for types whose values have no inverse, with the exception of 'Data.Monoid.mempty'. More
--- formally, the class instances must satisfy the following law:
--- 
--- prop> null (x <> y) == (null x && null y)
-class MonoidNull m => PositiveMonoid m
-
-instance MonoidNull () where
-   null () = True
-
-instance MonoidNull Ordering where
-   null = (== EQ)
-
-instance MonoidNull All where
-   null = getAll
-
-instance MonoidNull Any where
-   null = not . getAny
-
-instance MonoidNull (First a) where
-   null (First Nothing) = True
-   null _ = False
-
-instance MonoidNull (Last a) where
-   null (Last Nothing) = True
-   null _ = False
-
-instance MonoidNull a => MonoidNull (Dual a) where
-   null (Dual a) = null a
-
-instance (Num a, Eq a) => MonoidNull (Sum a) where
-   null (Sum a) = a == 0
-
-instance (Num a, Eq a) => MonoidNull (Product a) where
-   null (Product a) = a == 1
-
-instance Monoid a => MonoidNull (Maybe a) where
-   null Nothing = True
-   null _ = False
-
-instance (MonoidNull a, MonoidNull b) => MonoidNull (a, b) where
-   null (a, b) = null a && null b
-
-instance (MonoidNull a, MonoidNull b, MonoidNull c) => MonoidNull (a, b, c) where
-   null (a, b, c) = null a && null b && null c
-
-instance (MonoidNull a, MonoidNull b, MonoidNull c, MonoidNull d) => MonoidNull (a, b, c, d) where
-   null (a, b, c, d) = null a && null b && null c && null d
-
-instance MonoidNull [x] where
-   null = List.null
-
-instance MonoidNull ByteString.ByteString where
-   null = ByteString.null
-   {-# INLINE null #-}
-
-instance MonoidNull LazyByteString.ByteString where
-   null = LazyByteString.null
-   {-# INLINE null #-}
-
-instance MonoidNull Text.Text where
-   null = Text.null
-   {-# INLINE null #-}
-
-instance MonoidNull LazyText.Text where
-   null = LazyText.null
-   {-# INLINE null #-}
-
-instance Ord k => MonoidNull (Map.Map k v) where
-   null = Map.null
-
-instance MonoidNull (IntMap.IntMap v) where
-   null = IntMap.null
-
-instance MonoidNull IntSet.IntSet where
-   null = IntSet.null
-
-instance MonoidNull (Sequence.Seq a) where
-   null = Sequence.null
-
-instance Ord a => MonoidNull (Set.Set a) where
-   null = Set.null
-
-instance MonoidNull (Vector.Vector a) where
-   null = Vector.null
-
-instance PositiveMonoid ()
-instance PositiveMonoid Ordering
-instance PositiveMonoid All
-instance PositiveMonoid Any
-instance PositiveMonoid ByteString.ByteString
-instance PositiveMonoid LazyByteString.ByteString
-instance PositiveMonoid Text.Text
-instance PositiveMonoid LazyText.Text
-instance Monoid a => PositiveMonoid (Maybe a)
-instance PositiveMonoid (First a)
-instance PositiveMonoid (Last a)
-instance PositiveMonoid a => PositiveMonoid (Dual a)
-instance PositiveMonoid [x]
-instance Ord k => PositiveMonoid (Map.Map k v)
-instance PositiveMonoid (IntMap.IntMap v)
-instance PositiveMonoid IntSet.IntSet
-instance PositiveMonoid (Sequence.Seq a)
-instance Ord a => PositiveMonoid (Set.Set a)
-instance PositiveMonoid (Vector.Vector a)
-
--- The possible tuple instances would be overlapping, so we leave the choice to the user.
---
--- instance (PositiveMonoid a, Monoid b) => PositiveMonoid (a, b)
--- instance (Monoid a, PositiveMonoid b) => PositiveMonoid (a, b)
diff --git a/Data/Monoid/Textual.hs b/Data/Monoid/Textual.hs
deleted file mode 100644
--- a/Data/Monoid/Textual.hs
+++ /dev/null
@@ -1,615 +0,0 @@
-{- 
-    Copyright 2013-2016 Mario Blazevic
-
-    License: BSD3 (see BSD3-LICENSE.txt file)
--}
-
--- | This module defines the 'TextualMonoid' class and several of its instances.
--- 
-
-{-# LANGUAGE Haskell2010, FlexibleInstances, Trustworthy #-}
-
-module Data.Monoid.Textual (
-   TextualMonoid(..)
-   )
-where
-
-import qualified Data.Foldable as Foldable
-import qualified Data.Traversable as Traversable
-import Data.Functor -- ((<$>))
-import qualified Data.List as List
-import qualified Data.Text as Text
-import qualified Data.Text.Lazy as LazyText
-import Data.Text (Text)
-import Data.Monoid -- (Monoid(mappend, mempty))
-import qualified Data.Sequence as Sequence
-import qualified Data.Vector as Vector
-import Data.String (IsString(fromString))
-import Data.Int (Int64)
-
-import Data.Monoid.Cancellative (LeftReductiveMonoid, LeftGCDMonoid)
-import Data.Monoid.Factorial (FactorialMonoid)
-import qualified Data.Monoid.Factorial as Factorial
-
-import Prelude hiding (all, any, break, concatMap, dropWhile, foldl, foldl1, foldr, foldr1, map, scanl, scanl1, scanr, scanr1,
-                       span, takeWhile)
-
--- | The 'TextualMonoid' class is an extension of 'FactorialMonoid' specialized for monoids that can contain
--- characters. Its methods are generally equivalent to their namesake functions from "Data.List" and "Data.Text", and
--- they satisfy the following laws:
--- 
--- > unfoldr splitCharacterPrefix . fromString == id
--- > splitCharacterPrefix . primePrefix == fmap (\(c, t)-> (c, mempty)) . splitCharacterPrefix
--- >
--- > map f . fromString == fromString . List.map f
--- > concatMap (fromString . f) . fromString == fromString . List.concatMap f
--- >
--- > foldl  ft fc a . fromString == List.foldl  fc a
--- > foldr  ft fc a . fromString == List.foldr  fc a
--- > foldl' ft fc a . fromString == List.foldl' fc a
--- >
--- > scanl f c . fromString == fromString . List.scanl f c
--- > scanr f c . fromString == fromString . List.scanr f c
--- > mapAccumL f a . fromString == fmap fromString . List.mapAccumL f a
--- > mapAccumL f a . fromString == fmap fromString . List.mapAccumL f a
--- >
--- > takeWhile pt pc . fromString == fromString . takeWhile pc
--- > dropWhile pt pc . fromString == fromString . dropWhile pc
--- >
--- > mconcat . intersperse (singleton c) . split (== c) == id
--- > find p . fromString == List.find p
--- > elem c . fromString == List.elem c
---
--- A 'TextualMonoid' may contain non-character data insterspersed between its characters. Every class method that
--- returns a modified 'TextualMonoid' instance generally preserves this non-character data. Methods like 'foldr' can
--- access both the non-character and character data and expect two arguments for the two purposes. For each of these
--- methods there is also a simplified version with underscore in name (like 'foldr_') that ignores the non-character
--- data.
---
--- All of the following expressions are identities:
---
--- > map id
--- > concatMap singleton
--- > foldl  (<>) (\a c-> a <> singleton c) mempty
--- > foldr  (<>) ((<>) . singleton) mempty
--- > foldl' (<>) (\a c-> a <> singleton c) mempty
--- > scanl1 (const id)
--- > scanr1 const
--- > uncurry (mapAccumL (,))
--- > uncurry (mapAccumR (,))
--- > takeWhile (const True) (const True)
--- > dropWhile (const False) (const False)
--- > toString undefined . fromString
-
-class (IsString t, LeftReductiveMonoid t, LeftGCDMonoid t, FactorialMonoid t) => TextualMonoid t where
-   -- | Contructs a new data type instance Like 'fromString', but from a 'Text' input instead of 'String'.
-   --
-   -- > fromText == fromString . Text.unpack
-   fromText :: Text -> t
-   -- | Creates a prime monoid containing a single character.
-   --
-   -- > singleton c == fromString [c]
-   singleton :: Char -> t
-   -- | Specialized version of 'Factorial.splitPrimePrefix'. Every prime factor of a 'Textual' monoid must consist of a
-   -- single character or no character at all.
-   splitCharacterPrefix :: t -> Maybe (Char, t)
-   -- | Extracts a single character that prefixes the monoid, if the monoid begins with a character. Otherwise returns
-   -- 'Nothing'.
-   --
-   -- > characterPrefix == fmap fst . splitCharacterPrefix
-   characterPrefix :: t -> Maybe Char
-   -- | Equivalent to 'List.map' from "Data.List" with a @Char -> Char@ function. Preserves all non-character data.
-   --
-   -- > map f == concatMap (singleton . f)
-   map :: (Char -> Char) -> t -> t
-   -- | Equivalent to 'List.concatMap' from "Data.List" with a @Char -> String@ function. Preserves all non-character
-   -- data.
-   concatMap :: (Char -> t) -> t -> t
-   -- | Returns the list of characters the monoid contains, after having the argument function convert all its
-   -- non-character factors into characters.
-   toString :: (t -> String) -> t -> String
-   -- | Equivalent to 'List.any' from "Data.List". Ignores all non-character data.
-   any :: (Char -> Bool) -> t -> Bool
-   -- | Equivalent to 'List.all' from "Data.List". Ignores all non-character data.
-   all :: (Char -> Bool) -> t -> Bool
-
-   -- | The first argument folds over the non-character prime factors, the second over characters. Otherwise equivalent
-   -- to 'List.foldl' from "Data.List".
-   foldl   :: (a -> t -> a) -> (a -> Char -> a) -> a -> t -> a
-   -- | Strict version of 'foldl'.
-   foldl'  :: (a -> t -> a) -> (a -> Char -> a) -> a -> t -> a
-   -- | The first argument folds over the non-character prime factors, the second over characters. Otherwise equivalent
-   -- to 'List.foldl\'' from "Data.List".
-   foldr   :: (t -> a -> a) -> (Char -> a -> a) -> a -> t -> a
-
-   -- | Equivalent to 'List.scanl' from "Data.List" when applied to a 'String', but preserves all non-character data.
-   scanl :: (Char -> Char -> Char) -> Char -> t -> t
-   -- | Equivalent to 'List.scanl1' from "Data.List" when applied to a 'String', but preserves all non-character data.
-   --
-   -- > scanl f c == scanl1 f . (singleton c <>)
-   scanl1 :: (Char -> Char -> Char) -> t -> t
-   -- | Equivalent to 'List.scanr' from "Data.List" when applied to a 'String', but preserves all non-character data.
-   scanr :: (Char -> Char -> Char) -> Char -> t -> t
-   -- | Equivalent to 'List.scanr1' from "Data.List" when applied to a 'String', but preserves all non-character data.
-   --
-   -- > scanr f c == scanr1 f . (<> singleton c)
-   scanr1 :: (Char -> Char -> Char) -> t -> t
-   -- | Equivalent to 'List.mapAccumL' from "Data.List" when applied to a 'String', but preserves all non-character
-   -- data.
-   mapAccumL :: (a -> Char -> (a, Char)) -> a -> t -> (a, t)
-   -- | Equivalent to 'List.mapAccumR' from "Data.List" when applied to a 'String', but preserves all non-character
-   -- data.
-   mapAccumR :: (a -> Char -> (a, Char)) -> a -> t -> (a, t)
-
-   -- | The first predicate tests the non-character data, the second one the characters. Otherwise equivalent to
-   -- 'List.takeWhile' from "Data.List" when applied to a 'String'.
-   takeWhile :: (t -> Bool) -> (Char -> Bool) -> t -> t
-   -- | The first predicate tests the non-character data, the second one the characters. Otherwise equivalent to
-   -- 'List.dropWhile' from "Data.List" when applied to a 'String'.
-   dropWhile :: (t -> Bool) -> (Char -> Bool) -> t -> t
-   -- | 'break pt pc' is equivalent to |span (not . pt) (not . pc)|.
-   break :: (t -> Bool) -> (Char -> Bool) -> t -> (t, t)
-   -- | 'span pt pc t' is equivalent to |(takeWhile pt pc t, dropWhile pt pc t)|.
-   span :: (t -> Bool) -> (Char -> Bool) -> t -> (t, t)
-   -- | A stateful variant of 'span', threading the result of the test function as long as it returns 'Just'.
-   spanMaybe :: s -> (s -> t -> Maybe s) -> (s -> Char -> Maybe s) -> t -> (t, t, s)
-   -- | Strict version of 'spanMaybe'.
-   spanMaybe' :: s -> (s -> t -> Maybe s) -> (s -> Char -> Maybe s) -> t -> (t, t, s)
-   -- | Splits the monoid into components delimited by character separators satisfying the given predicate. The
-   -- characters satisfying the predicate are not a part of the result.
-   --
-   -- > split p == Factorial.split (maybe False p . characterPrefix)
-   split :: (Char -> Bool) -> t -> [t]
-   -- | Like 'List.find' from "Data.List" when applied to a 'String'. Ignores non-character data.
-   find :: (Char -> Bool) -> t -> Maybe Char
-   -- | Like 'List.elem' from "Data.List" when applied to a 'String'. Ignores non-character data.
-   elem :: Char -> t -> Bool
-
-   -- | > foldl_ = foldl const
-   foldl_   :: (a -> Char -> a) -> a -> t -> a
-   foldl_'  :: (a -> Char -> a) -> a -> t -> a
-   foldr_   :: (Char -> a -> a) -> a -> t -> a
-   -- | > takeWhile_ = takeWhile . const
-   takeWhile_ :: Bool -> (Char -> Bool) -> t -> t
-   -- | > dropWhile_ = dropWhile . const
-   dropWhile_ :: Bool -> (Char -> Bool) -> t -> t
-   -- | > break_ = break . const
-   break_ :: Bool -> (Char -> Bool) -> t -> (t, t)
-   -- | > span_ = span . const
-   span_ :: Bool -> (Char -> Bool) -> t -> (t, t)
-   -- | > spanMaybe_ s = spanMaybe s (const . Just)
-   spanMaybe_ :: s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
-   spanMaybe_' :: s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
-
-
-   fromText = fromString . Text.unpack
-   singleton = fromString . (:[])
-
-   characterPrefix = fmap fst . splitCharacterPrefix
-
-   map f = concatMap (singleton . f)
-   concatMap f = foldr mappend (mappend . f) mempty
-   toString f = foldr (mappend . f) (:) []
-   all p = foldr (const id) ((&&) . p) True
-   any p = foldr (const id) ((||) . p) False
-
-   foldl ft fc = Factorial.foldl (\a prime-> maybe (ft a prime) (fc a) (characterPrefix prime))
-   foldr ft fc = Factorial.foldr (\prime-> maybe (ft prime) fc (characterPrefix prime))
-   foldl' ft fc = Factorial.foldl' (\a prime-> maybe (ft a prime) (fc a) (characterPrefix prime))
-   foldl_ = foldl const
-   foldr_ = foldr (const id)
-   foldl_' = foldl' const
-
-   scanl f c = mappend (singleton c) . fst . foldl foldlOther (foldlChars f) (mempty, c)
-   scanl1 f t = case (Factorial.splitPrimePrefix t, splitCharacterPrefix t)
-                of (Nothing, _) -> t
-                   (Just (prefix, suffix), Nothing) -> mappend prefix (scanl1 f suffix)
-                   (Just _, Just (c, suffix)) -> scanl f c suffix
-   scanr f c = fst . foldr foldrOther (foldrChars f) (singleton c, c)
-   scanr1 f = fst . foldr foldrOther fc (mempty, Nothing)
-      where fc c (t, Nothing) = (mappend (singleton c) t, Just c)
-            fc c1 (t, Just c2) = (mappend (singleton c') t, Just c')
-               where c' = f c1 c2
-   mapAccumL f a0 = foldl ft fc (a0, mempty)
-      where ft (a, t1) t2 = (a, mappend t1 t2)
-            fc (a, t) c = (a', mappend t (singleton c'))
-               where (a', c') = f a c
-   mapAccumR f a0 = foldr ft fc (a0, mempty)
-      where ft t1 (a, t2) = (a, mappend t1 t2)
-            fc c (a, t) = (a', mappend (singleton c') t)
-               where (a', c') = f a c
-
-   takeWhile pt pc = fst . span pt pc
-   dropWhile pt pc = snd . span pt pc
-   span pt pc = Factorial.span (\prime-> maybe (pt prime) pc (characterPrefix prime))
-   break pt pc = Factorial.break (\prime-> maybe (pt prime) pc (characterPrefix prime))
-   spanMaybe s0 ft fc t0 = spanAfter id s0 t0
-      where spanAfter g s t = case Factorial.splitPrimePrefix t
-                              of Just (prime, rest) | Just s' <- maybe (ft s prime) (fc s) (characterPrefix prime) ->
-                                                        spanAfter (g . mappend prime) s' rest
-                                                    | otherwise -> (g mempty, t, s)
-                                 Nothing -> (t0, t, s)
-   spanMaybe' s0 ft fc t0 = spanAfter id s0 t0
-      where spanAfter g s t = seq s $
-                              case Factorial.splitPrimePrefix t
-                              of Just (prime, rest) | Just s' <- maybe (ft s prime) (fc s) (characterPrefix prime) ->
-                                                        spanAfter (g . mappend prime) s' rest
-                                                    | otherwise -> (g mempty, t, s)
-                                 Nothing -> (t0, t, s)
-   takeWhile_ = takeWhile . const
-   dropWhile_ = dropWhile . const
-   break_ = break . const
-   span_ = span . const
-   spanMaybe_ s = spanMaybe s (const . Just)
-   spanMaybe_' s = spanMaybe' s (const . Just)
-
-   split p m = prefix : splitRest
-      where (prefix, rest) = break (const False) p m
-            splitRest = case splitCharacterPrefix rest
-                        of Nothing -> []
-                           Just (_, tl) -> split p tl
-   find p = foldr (const id) (\c r-> if p c then Just c else r) Nothing
-   elem c = any (== c)
-
-   {-# INLINE characterPrefix #-}
-   {-# INLINE concatMap #-}
-   {-# INLINE dropWhile #-}
-   {-# INLINE fromText #-}
-   {-# INLINE map #-}
-   {-# INLINE mapAccumL #-}
-   {-# INLINE mapAccumR #-}
-   {-# INLINE scanl #-}
-   {-# INLINE scanl1 #-}
-   {-# INLINE scanr #-}
-   {-# INLINE scanr1 #-}
-   {-# INLINE singleton #-}
-   {-# INLINE spanMaybe #-}
-   {-# INLINE spanMaybe' #-}
-   {-# INLINE split #-}
-   {-# INLINE takeWhile #-}
-   {-# INLINE foldl_ #-}
-   {-# INLINE foldl_' #-}
-   {-# INLINE foldr_ #-}
-   {-# INLINE spanMaybe_ #-}
-   {-# INLINE spanMaybe_' #-}
-   {-# INLINE span_ #-}
-   {-# INLINE break_ #-}
-   {-# INLINE takeWhile_ #-}
-   {-# INLINE dropWhile_ #-}
-   {-# MINIMAL splitCharacterPrefix #-}
-
-foldlChars :: TextualMonoid t => (Char -> Char -> Char) -> (t, Char) -> Char -> (t, Char)
-foldlOther :: Monoid t => (t, Char) -> t -> (t, Char)
-foldrChars :: TextualMonoid t => (Char -> Char -> Char) -> Char -> (t, Char) -> (t, Char)
-foldrOther :: Monoid t => t -> (t, a) -> (t, a)
-foldlChars f (t, c1) c2 = (mappend t (singleton c'), c')
-   where c' = f c1 c2
-foldlOther (t1, c) t2 = (mappend t1 t2, c)
-foldrChars f c1 (t, c2) = (mappend (singleton c') t, c')
-   where c' = f c1 c2
-foldrOther t1 (t2, c) = (mappend t1 t2, c)
-
-instance TextualMonoid String where
-   fromText = Text.unpack
-   singleton c = [c]
-   splitCharacterPrefix (c:rest) = Just (c, rest)
-   splitCharacterPrefix [] = Nothing
-   characterPrefix (c:_) = Just c
-   characterPrefix [] = Nothing
-   map = List.map
-   concatMap = List.concatMap
-   toString = const id
-   any = List.any
-   all = List.all
-
-   foldl   = const List.foldl
-   foldl'  = const List.foldl'
-   foldr   = const List.foldr
-
-   scanl = List.scanl
-   scanl1 = List.scanl1
-   scanr = List.scanr
-   scanr1 = List.scanr1
-   mapAccumL = List.mapAccumL
-   mapAccumR = List.mapAccumR
-
-   takeWhile _ = List.takeWhile
-   dropWhile _ = List.dropWhile
-   break _ = List.break
-   span _ = List.span
-   spanMaybe s0 _ft fc l = (prefix' [], suffix' [], s')
-      where (prefix', suffix', s', _) = List.foldl' g (id, id, s0, True) l
-            g (prefix, suffix, s, live) c | live, Just s1 <- fc s c = (prefix . (c:), id, s1, True)
-                                          | otherwise = (prefix, suffix . (c:), s, False)
-   spanMaybe' s0 _ft fc l = (prefix' [], suffix' [], s')
-      where (prefix', suffix', s', _) = List.foldl' g (id, id, s0, True) l
-            g (prefix, suffix, s, live) c | live, Just s1 <- fc s c = seq s1 (prefix . (c:), id, s1, True)
-                                          | otherwise = (prefix, suffix . (c:), s, False)
-   find = List.find
-   elem = List.elem
-
-   {-# INLINE all #-}
-   {-# INLINE any #-}
-   {-# INLINE break #-}
-   {-# INLINE characterPrefix #-}
-   {-# INLINE concatMap #-}
-   {-# INLINE dropWhile #-}
-   {-# INLINE elem #-}
-   {-# INLINE find #-}
-   {-# INLINE foldl   #-}
-   {-# INLINE foldl'  #-}
-   {-# INLINE foldr   #-}
-   {-# INLINE fromText #-}
-   {-# INLINE map #-}
-   {-# INLINE mapAccumL #-}
-   {-# INLINE mapAccumR #-}
-   {-# INLINE scanl #-}
-   {-# INLINE scanl1 #-}
-   {-# INLINE scanr #-}
-   {-# INLINE scanr1 #-}
-   {-# INLINE singleton #-}
-   {-# INLINE span #-}
-   {-# INLINE spanMaybe #-}
-   {-# INLINE spanMaybe' #-}
-   {-# INLINE splitCharacterPrefix #-}
-   {-# INLINE takeWhile #-}
-
-instance TextualMonoid Text where
-   fromText = id
-   singleton = Text.singleton
-   splitCharacterPrefix = Text.uncons
-   characterPrefix t = if Text.null t then Nothing else Just (Text.head t)
-   map = Text.map
-   concatMap = Text.concatMap
-   toString = const Text.unpack
-   any = Text.any
-   all = Text.all
-
-   foldl   = const Text.foldl
-   foldl'  = const Text.foldl'
-   foldr   = const Text.foldr
-
-   scanl = Text.scanl
-   scanl1 = Text.scanl1
-   scanr = Text.scanr
-   scanr1 = Text.scanr1
-   mapAccumL = Text.mapAccumL
-   mapAccumR = Text.mapAccumR
-
-   takeWhile _ = Text.takeWhile
-   dropWhile _ = Text.dropWhile
-   break _ = Text.break
-   span _ = Text.span
-   spanMaybe s0 _ft fc t = case Text.foldr g id t (0, s0)
-                           of (i, s') | (prefix, suffix) <- Text.splitAt i t -> (prefix, suffix, s')
-      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int in seq i' $ cont (i', s')
-                            | otherwise = (i, s)
-   spanMaybe' s0 _ft fc t = case Text.foldr g id t (0, s0)
-                            of (i, s') | (prefix, suffix) <- Text.splitAt i t -> (prefix, suffix, s')
-      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')
-                            | otherwise = (i, s)
-   split = Text.split
-   find = Text.find
-
-   {-# INLINE all #-}
-   {-# INLINE any #-}
-   {-# INLINE break #-}
-   {-# INLINE characterPrefix #-}
-   {-# INLINE concatMap #-}
-   {-# INLINE dropWhile #-}
-   {-# INLINE find #-}
-   {-# INLINE foldl   #-}
-   {-# INLINE foldl'  #-}
-   {-# INLINE foldr   #-}
-   {-# INLINE fromText #-}
-   {-# INLINE map #-}
-   {-# INLINE mapAccumL #-}
-   {-# INLINE mapAccumR #-}
-   {-# INLINE scanl #-}
-   {-# INLINE scanl1 #-}
-   {-# INLINE scanr #-}
-   {-# INLINE scanr1 #-}
-   {-# INLINE singleton #-}
-   {-# INLINE span #-}
-   {-# INLINE spanMaybe #-}
-   {-# INLINE spanMaybe' #-}
-   {-# INLINE split #-}
-   {-# INLINE splitCharacterPrefix #-}
-   {-# INLINE takeWhile #-}
-
-instance TextualMonoid LazyText.Text where
-   fromText = LazyText.fromStrict
-   singleton = LazyText.singleton
-   splitCharacterPrefix = LazyText.uncons
-   characterPrefix t = if LazyText.null t then Nothing else Just (LazyText.head t)
-   map = LazyText.map
-   concatMap = LazyText.concatMap
-   toString = const LazyText.unpack
-   any = LazyText.any
-   all = LazyText.all
-
-   foldl   = const LazyText.foldl
-   foldl'  = const LazyText.foldl'
-   foldr   = const LazyText.foldr
-
-   scanl = LazyText.scanl
-   scanl1 = LazyText.scanl1
-   scanr = LazyText.scanr
-   scanr1 = LazyText.scanr1
-   mapAccumL = LazyText.mapAccumL
-   mapAccumR = LazyText.mapAccumR
-
-   takeWhile _ = LazyText.takeWhile
-   dropWhile _ = LazyText.dropWhile
-   break _ = LazyText.break
-   span _ = LazyText.span
-   spanMaybe s0 _ft fc t = case LazyText.foldr g id t (0, s0)
-                           of (i, s') | (prefix, suffix) <- LazyText.splitAt i t -> (prefix, suffix, s')
-      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int64 in seq i' $ cont (i', s')
-                            | otherwise = (i, s)
-   spanMaybe' s0 _ft fc t = case LazyText.foldr g id t (0, s0)
-                            of (i, s') | (prefix, suffix) <- LazyText.splitAt i t -> (prefix, suffix, s')
-      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int64 in seq i' $ seq s' $ cont (i', s')
-                            | otherwise = (i, s)
-   split = LazyText.split
-   find = LazyText.find
-   {-# INLINE all #-}
-   {-# INLINE any #-}
-   {-# INLINE break #-}
-   {-# INLINE characterPrefix #-}
-   {-# INLINE concatMap #-}
-   {-# INLINE dropWhile #-}
-   {-# INLINE find #-}
-   {-# INLINE foldl   #-}
-   {-# INLINE foldl'  #-}
-   {-# INLINE foldr   #-}
-   {-# INLINE fromText #-}
-   {-# INLINE map #-}
-   {-# INLINE mapAccumL #-}
-   {-# INLINE mapAccumR #-}
-   {-# INLINE scanl #-}
-   {-# INLINE scanl1 #-}
-   {-# INLINE scanr #-}
-   {-# INLINE scanr1 #-}
-   {-# INLINE singleton #-}
-   {-# INLINE span #-}
-   {-# INLINE spanMaybe #-}
-   {-# INLINE spanMaybe' #-}
-   {-# INLINE split #-}
-   {-# INLINE splitCharacterPrefix #-}
-   {-# INLINE takeWhile #-}
-
-instance TextualMonoid (Sequence.Seq Char) where
-   singleton = Sequence.singleton
-   splitCharacterPrefix s = case Sequence.viewl s
-                            of Sequence.EmptyL -> Nothing
-                               c Sequence.:< rest -> Just (c, rest)
-   characterPrefix s = case Sequence.viewl s
-                       of Sequence.EmptyL -> Nothing
-                          c Sequence.:< _ -> Just c
-   map = Traversable.fmapDefault
-   concatMap = Foldable.foldMap
-   toString = const Foldable.toList
-   any = Foldable.any
-   all = Foldable.all
-
-   foldl   = const Foldable.foldl
-   foldl'  = const Foldable.foldl'
-   foldr   = const Foldable.foldr
-
-   scanl = Sequence.scanl
-   scanl1 f v | Sequence.null v = Sequence.empty
-              | otherwise = Sequence.scanl1 f v
-   scanr = Sequence.scanr
-   scanr1 f v | Sequence.null v = Sequence.empty
-              | otherwise = Sequence.scanr1 f v
-
-   takeWhile _ = Sequence.takeWhileL
-   dropWhile _ = Sequence.dropWhileL
-   break _ = Sequence.breakl
-   span _ = Sequence.spanl
-   spanMaybe s0 _ft fc b = case Foldable.foldr g id b (0, s0)
-                           of (i, s') | (prefix, suffix) <- Sequence.splitAt i b -> (prefix, suffix, s')
-      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int in seq i' $ cont (i', s')
-                            | otherwise = (i, s)
-   spanMaybe' s0 _ft fc b = case Foldable.foldr g id b (0, s0)
-                            of (i, s') | (prefix, suffix) <- Sequence.splitAt i b -> (prefix, suffix, s')
-      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')
-                            | otherwise = (i, s)
-   find = Foldable.find
-   elem = Foldable.elem
-
-   {-# INLINE all #-}
-   {-# INLINE any #-}
-   {-# INLINE break #-}
-   {-# INLINE characterPrefix #-}
-   {-# INLINE concatMap #-}
-   {-# INLINE dropWhile #-}
-   {-# INLINE elem #-}
-   {-# INLINE find #-}
-   {-# INLINE foldl   #-}
-   {-# INLINE foldl'  #-}
-   {-# INLINE foldr   #-}
-   {-# INLINE map #-}
-   {-# INLINE scanl #-}
-   {-# INLINE scanl1 #-}
-   {-# INLINE scanr #-}
-   {-# INLINE scanr1 #-}
-   {-# INLINE singleton #-}
-   {-# INLINE span #-}
-   {-# INLINE spanMaybe #-}
-   {-# INLINE spanMaybe' #-}
-   {-# INLINE splitCharacterPrefix #-}
-   {-# INLINE takeWhile #-}
-
-instance IsString (Vector.Vector Char) where
-   fromString = Vector.fromList
-
-instance TextualMonoid (Vector.Vector Char) where
-   singleton = Vector.singleton
-   splitCharacterPrefix t = if Vector.null t then Nothing else Just (Vector.unsafeHead t, Vector.unsafeTail t)
-   characterPrefix = (Vector.!? 0)
-   map = Vector.map
-   concatMap = Vector.concatMap
-   toString = const Vector.toList
-   any = Vector.any
-   all = Vector.all
-
-   foldl   = const Vector.foldl
-   foldl'  = const Vector.foldl'
-   foldr   = const Vector.foldr
-
-   scanl = Vector.scanl
-   scanl1 f v | Vector.null v = Vector.empty
-              | otherwise = Vector.scanl1 f v
-   scanr = Vector.scanr
-   scanr1 f v | Vector.null v = Vector.empty
-              | otherwise = Vector.scanr1 f v
-   mapAccumL f a0 t = (a', Vector.reverse $ Vector.fromList l')
-      where (a', l') = Vector.foldl fc (a0, []) t
-            fc (a, l) c = (:l) <$> f a c
-   mapAccumR f a0 t = (a', Vector.fromList l')
-      where (a', l') = Vector.foldr fc (a0, []) t
-            fc c (a, l) = (:l) <$> f a c
-
-   takeWhile _ = Vector.takeWhile
-   dropWhile _ = Vector.dropWhile
-   break _ = Vector.break
-   span _ = Vector.span
-   spanMaybe s0 _ft fc v = case Vector.ifoldr g Left v s0
-                           of Left s' -> (v, Vector.empty, s')
-                              Right (i, s') | (prefix, suffix) <- Vector.splitAt i v -> (prefix, suffix, s')
-      where g i c cont s | Just s' <- fc s c = cont s'
-                         | otherwise = Right (i, s)
-   spanMaybe' s0 _ft fc v = case Vector.ifoldr' g Left v s0
-                            of Left s' -> (v, Vector.empty, s')
-                               Right (i, s') | (prefix, suffix) <- Vector.splitAt i v -> (prefix, suffix, s')
-      where g i c cont s | Just s' <- fc s c = seq s' (cont s')
-                         | otherwise = Right (i, s)
-   find = Vector.find
-   elem = Vector.elem
-
-   {-# INLINE all #-}
-   {-# INLINE any #-}
-   {-# INLINE break #-}
-   {-# INLINE characterPrefix #-}
-   {-# INLINE concatMap #-}
-   {-# INLINE dropWhile #-}
-   {-# INLINE elem #-}
-   {-# INLINE find #-}
-   {-# INLINE foldl   #-}
-   {-# INLINE foldl'  #-}
-   {-# INLINE foldr   #-}
-   {-# INLINE map #-}
-   {-# INLINE mapAccumL #-}
-   {-# INLINE mapAccumR #-}
-   {-# INLINE scanl #-}
-   {-# INLINE scanl1 #-}
-   {-# INLINE scanr #-}
-   {-# INLINE scanr1 #-}
-   {-# INLINE singleton #-}
-   {-# INLINE span #-}
-   {-# INLINE spanMaybe #-}
-   {-# INLINE spanMaybe' #-}
-   {-# INLINE splitCharacterPrefix #-}
-   {-# INLINE takeWhile #-}
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,19 +1,28 @@
 monoid-subclasses
 =================
 
-### Subclasses of Monoid with a solid theoretical foundation and practical purposes ###
+### Subclasses of Semigroup and Monoid with a solid theoretical foundation and practical purposes ###
 
-The monoid-subclasses package has been released [on Hackage](http://hackage.haskell.org/package/monoid-subclasses). The package defines several classes that are richer than [monoids](http://hackage.haskell.org/package/base/docs/Data-Monoid.html#t:Monoid) but less demanding than [groups](http://hackage.haskell.org/package/groups/docs/Data-Group.html):
-  * [ReductiveMonoid](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Cancellative.html#t:ReductiveMonoid) provides the operator `</>` which acts as a partial inverse of the `<>` operator, _i.e._, `Monoid.mappend`.
-  * [CancellativeMonoid](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Cancellative.html#t:CancellativeMonoid) is a subclass of `ReductiveMonoid` that provides additional guarantees about the `</>` operation result:
+The monoid-subclasses package has been released [on
+Hackage](http://hackage.haskell.org/package/monoid-subclasses). The package defines several classes that are richer
+than [semigroups](http://hackage.haskell.org/package/base/docs/Data-Semigroup.html#t:Semigroup) and
+[monoids](http://hackage.haskell.org/package/base/docs/Data-Monoid.html#t:Monoid) but less demanding than
+[groups](http://hackage.haskell.org/package/groups/docs/Data-Group.html):
 
+* [Reductive](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Semigroup-Cancellative.html#t:Reductive)
+provides the operator `</>` which acts as a partial inverse of the semigroup `<>` operator.
+* [Cancellative](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Semigroup-Cancellative.html#t:Cancellative)
+is a subclass of `Reductive` that provides additional guarantees about the `</>` operation result:
+
         (a <> b) </> a == Just b
         (a <> b) </> b == Just a
 
-    Every group (<em>i.e.</em>, every `Monoid a` with the operation `inverse :: a -> a`) is a `CancellativeMonoid` where `a </> b = Just (a <> inverse b)` but not every `CancellativeMonoid` is a group.
-  * [GCDMonoid](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Cancellative.html#t:GCDMonoid) is a subclass of `ReductiveMonoid` that provides the `gcd` operation for getting the greatest common denominator for two given monoid values.
-  * [MonoidNull](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Null.html) class provides the Boolean `null` operation that checks if the argument monoid is `mempty`.
-  * [FactorialMonoid](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Factorial.html) class represents monoids that can be split up into irreducible factors.
+    Every group (*i.e.*, every `Monoid a` with the operation `inverse :: a -> a`) is a cancellative monoid where `a </> b = Just (a <> inverse b)` but not every `Cancellative` monoid is a group.
+    
+* [GCDMonoid](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-GCD.html#t:GCDMonoid) is a subclass of `Reductive` and `Monoid` that provides the `gcd` operation for getting the greatest common denominator for two given monoid values.
+* [Monus](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monus.html#t:Monus) provides the `<\>` monus operation. The set difference is one familiar instance of this operation.
+* [MonoidNull](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Null.html) class provides the Boolean `null` operation that checks if the argument monoid is `mempty`.
+* [Factorial](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Semigroup-Factorial.html) and [FactorialMonoid](http://hackage.haskell.org/package/monoid-subclasses/docs/Data-Monoid-Factorial.html) classes represent semigroups and monoids that can be split up into irreducible factors.
 
 That's the theoretical point of view. From the practical point of view, the main purpose of the _monoid-subclasses_ package is similar to that of [ListLike](http://hackage.haskell.org/package/ListLike/docs/Data-ListLike.html) - to provide unifying abstractions for various monoidal data types in Haskell, primarily [String](http://hackage.haskell.org/package/base/docs/Data-String.html#t:String), [ByteString](http://hackage.haskell.org/package/bytestring/docs/Data-ByteString.html#t:ByteString), and [Text](http://hackage.haskell.org/package/text). All three types are already instances of the [Monoid](http://hackage.haskell.org/package/base/docs/Data-Monoid.html#t:Monoid) class. While that abstraction is useful for building sequences of data, it doesn't help with deconstructing them.
 
@@ -21,8 +30,11 @@
   * _ListLike_ strives to reproduce the standard [Data.List](http://hackage.haskell.org/package/base/docs/Data-List.html) interface, whereas _monoid-subclasses_ builds from deeper theoretical foundations; and
   * The _monoid-subclasses_ implementation uses standard Haskell 2010, with the exception of two minor extensions which can be worked around if necessary.
 
-The [incremental-parser](http://hackage.haskell.org/package/incremental-parser) package provides one example of use of _monoid-subclasses_. Another example is [picoparsec](https://bitbucket.org/blamario/picoparsec), a fork of [attoparsec](http://hackage.haskell.org/package/attoparsec).
-
-A more thorough description of the library can be found in the Haskell Symposium 2013 paper [Adding Structure to Monoids
-](https://github.com/blamario/monoid-subclasses/wiki/Files/HaskellSymposium2013.pdf)
+The [incremental-parser](http://hackage.haskell.org/package/incremental-parser) package can serve as a compact example
+of a parser library that can be applied to different input types thanks to _monoid-subclasses_. There is also
+[picoparsec](http://hackage.haskell.org/package/picoparsec), a fork of
+[attoparsec](http://hackage.haskell.org/package/attoparsec), and the heavy-duty
+[grammatical-parsers](http://hackage.haskell.org/package/grammatical-parsers) library.
 
+A more thorough description of the library design can be found in the Haskell Symposium 2013 paper [Adding Structure
+to Monoids ](https://github.com/blamario/monoid-subclasses/wiki/Files/HaskellSymposium2013.pdf)
diff --git a/Test/TestMonoidSubclasses.hs b/Test/TestMonoidSubclasses.hs
--- a/Test/TestMonoidSubclasses.hs
+++ b/Test/TestMonoidSubclasses.hs
@@ -1,5 +1,5 @@
 {- 
-    Copyright 2013-2018 Mario Blazevic
+    Copyright 2013-2019 Mario Blazevic
 
     License: BSD3 (see BSD3-LICENSE.txt file)
 -}
@@ -31,6 +31,7 @@
 import Data.Char (isLetter)
 import Data.Int (Int16)
 import Data.Word (Word, Word8)
+import Numeric.Natural (Natural)
 
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy as Lazy (ByteString)
@@ -47,6 +48,7 @@
 import Text.Show.Functions
 
 import Data.Monoid.Instances.ByteString.UTF8 (ByteStringUTF8(ByteStringUTF8))
+import Data.Monoid.Instances.CharVector ()
 import Data.Monoid.Instances.Concat (Concat)
 import qualified Data.Monoid.Instances.Concat as Concat
 import Data.Monoid.Instances.Measured (Measured)
@@ -56,19 +58,22 @@
 import Data.Monoid.Instances.Positioned (OffsetPositioned, LinePositioned)
 import qualified Data.Monoid.Instances.Positioned as Positioned
 
-import Data.Semigroup (Semigroup)
-import Data.Monoid (Monoid, mempty, (<>), mconcat, All(All), Any(Any), Dual(Dual),
+import Data.Semigroup (Semigroup, (<>))
+import Data.Monoid (Monoid, mempty, mconcat, All(All), Any(Any), Dual(Dual),
                     First(First), Last(Last), Sum(Sum), Product(Product))
+import Data.Semigroup.Factorial (Factorial, StableFactorial, 
+                                 factors, primePrefix, primeSuffix, foldl, foldl', foldr, length, reverse)
+import Data.Semigroup.Cancellative (Commutative, Reductive,
+                                    LeftReductive, RightReductive,
+                                    Cancellative, LeftCancellative, RightCancellative,
+                                    (</>), isPrefixOf, stripPrefix, isSuffixOf, stripSuffix)
 import Data.Monoid.Null (MonoidNull, PositiveMonoid, null)
-import Data.Monoid.Factorial (FactorialMonoid, StableFactorialMonoid, 
-                              factors, splitPrimePrefix, splitPrimeSuffix, primePrefix, primeSuffix, inits, tails,
-                              foldl, foldl', foldr, length, reverse, span, spanMaybe, split, splitAt)
-import Data.Monoid.Cancellative (CommutativeMonoid, ReductiveMonoid, LeftReductiveMonoid, RightReductiveMonoid,
-                                 CancellativeMonoid, LeftCancellativeMonoid, RightCancellativeMonoid,
-                                 GCDMonoid, LeftGCDMonoid, RightGCDMonoid,
-                                 (</>), gcd,
-                                 isPrefixOf, stripPrefix, commonPrefix, stripCommonPrefix,
-                                 isSuffixOf, stripSuffix, commonSuffix, stripCommonSuffix)
+import Data.Monoid.Factorial (FactorialMonoid,
+                              splitPrimePrefix, splitPrimeSuffix, inits, tails, span, spanMaybe, split, splitAt)
+import Data.Monoid.GCD (GCDMonoid, LeftGCDMonoid, RightGCDMonoid, gcd,
+                        commonPrefix, stripCommonPrefix,
+                        commonSuffix, stripCommonSuffix)
+import Data.Monoid.Monus (OverlappingGCDMonoid, Monus, (<\>), stripPrefixOverlap, stripSuffixOverlap)
 import Data.Monoid.Textual (TextualMonoid)
 import qualified Data.Monoid.Textual as Textual
 
@@ -81,6 +86,8 @@
           | LeftReductiveTest (LeftReductiveMonoidInstance -> Property)
           | RightReductiveTest (RightReductiveMonoidInstance -> Property)
           | ReductiveTest (ReductiveMonoidInstance -> Property)
+          | OverlappingGCDTest (OverlappingGCDMonoidInstance -> Property)
+          | MonusTest (MonusInstance -> Property)
           | LeftCancellativeTest (LeftCancellativeMonoidInstance -> Property)
           | RightCancellativeTest (RightCancellativeMonoidInstance -> Property)
           | CancellativeTest (CancellativeMonoidInstance -> Property)
@@ -89,40 +96,46 @@
           | GCDTest (GCDMonoidInstance -> Property)
           | CancellativeGCDTest (CancellativeGCDMonoidInstance -> Property)
 
-data CommutativeMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, CommutativeMonoid a) => 
+data CommutativeMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, Commutative a, Monoid a) =>
                                  CommutativeMonoidInstance a
-data NullMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, MonoidNull a) => 
+data NullMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, MonoidNull a) =>
                           NullMonoidInstance a
 data PositiveMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, PositiveMonoid a) =>
                               PositiveMonoidInstance a
 data FactorialMonoidInstance = forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, FactorialMonoid a) =>
                                FactorialMonoidInstance a
-data StableFactorialMonoidInstance = forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, StableFactorialMonoid a) =>
+data StableFactorialMonoidInstance = forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a,
+                                                StableFactorial a, FactorialMonoid a, PositiveMonoid a) =>
                                      StableFactorialMonoidInstance a
-data TextualMonoidInstance = forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => 
+data TextualMonoidInstance = forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) =>
                              TextualMonoidInstance a
-data StableTextualMonoidInstance = forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, StableFactorialMonoid a,
+data StableTextualMonoidInstance = forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a,
+                                              StableFactorial a, FactorialMonoid a, PositiveMonoid a,
                                               TextualMonoid a) =>
                                    StableTextualMonoidInstance a
-data LeftReductiveMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, LeftReductiveMonoid a) => 
+data LeftReductiveMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, Monoid a, LeftReductive a) =>
                                    LeftReductiveMonoidInstance a
-data RightReductiveMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, RightReductiveMonoid a) => 
+data RightReductiveMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, Monoid a, RightReductive a) =>
                                     RightReductiveMonoidInstance a
-data ReductiveMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, ReductiveMonoid a) => 
+data ReductiveMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, Monoid a, Reductive a) =>
                                ReductiveMonoidInstance a
-data LeftCancellativeMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, LeftCancellativeMonoid a) => 
+data OverlappingGCDMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, OverlappingGCDMonoid a, FactorialMonoid a) =>
+                                    OverlappingGCDMonoidInstance a
+data MonusInstance = forall a. (Arbitrary a, Show a, Eq a, Monus a, FactorialMonoid a) =>
+                               MonusInstance a
+data LeftCancellativeMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, Monoid a, LeftCancellative a) =>
                                       LeftCancellativeMonoidInstance a
-data RightCancellativeMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, RightCancellativeMonoid a) => 
+data RightCancellativeMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, Monoid a, RightCancellative a) =>
                                        RightCancellativeMonoidInstance a
-data CancellativeMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, CancellativeMonoid a) => 
+data CancellativeMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, Monoid a, Cancellative a) =>
                                   CancellativeMonoidInstance a
-data LeftGCDMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, LeftGCDMonoid a) => 
+data LeftGCDMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, LeftGCDMonoid a) =>
                              LeftGCDMonoidInstance a
-data RightGCDMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, RightGCDMonoid a) => 
+data RightGCDMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, RightGCDMonoid a) =>
                               RightGCDMonoidInstance a
-data GCDMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, GCDMonoid a) => 
+data GCDMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, GCDMonoid a) =>
                          GCDMonoidInstance a
-data CancellativeGCDMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, CancellativeMonoid a, GCDMonoid a) => 
+data CancellativeGCDMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, Monoid a, Cancellative a, GCDMonoid a) =>
                                      CancellativeGCDMonoidInstance a
 
 commutativeInstances :: [CommutativeMonoidInstance]
@@ -150,6 +163,8 @@
                          PositiveMonoidInstance (mempty :: All),
                          PositiveMonoidInstance (mempty :: Any),
                          PositiveMonoidInstance (mempty :: (Maybe (Sum Integer))),
+                         PositiveMonoidInstance (mempty :: (Product Natural)),
+                         PositiveMonoidInstance (mempty :: (Sum Natural)),
                          PositiveMonoidInstance (mempty :: (First Char)),
                          PositiveMonoidInstance (mempty :: (Last Int)),
                          PositiveMonoidInstance (mempty :: String),
@@ -219,31 +234,63 @@
                          ++ [LeftReductiveMonoidInstance (mempty :: Sum Integer),
                              LeftReductiveMonoidInstance (mempty :: IntSet),
                              LeftReductiveMonoidInstance (mempty :: Set Integer),
+                             LeftReductiveMonoidInstance (mempty :: IntMap Char),
+                             LeftReductiveMonoidInstance (mempty :: Map Char Int),
                              LeftReductiveMonoidInstance (mempty :: Concat String),
                              LeftReductiveMonoidInstance (mempty :: Concat ByteString),
                              LeftReductiveMonoidInstance (mempty :: Concat Lazy.ByteString),
                              LeftReductiveMonoidInstance (mempty :: Concat Text),
                              LeftReductiveMonoidInstance (mempty :: Concat Lazy.Text),
-                             LeftReductiveMonoidInstance (mempty :: Concat (Dual Text))]
+                             LeftReductiveMonoidInstance (mempty :: Concat (Dual Text)),
+                             LeftReductiveMonoidInstance (mempty :: LinePositioned Text),
+                             LeftReductiveMonoidInstance (mempty :: OffsetPositioned Text),
+                             LeftReductiveMonoidInstance (mempty :: Measured Text),
+                             LeftReductiveMonoidInstance (mempty :: Stateful (Sum Integer) Text)]
    where upcast (LeftCancellativeMonoidInstance i) = LeftReductiveMonoidInstance i
 
 rightReductiveInstances = map upcast rightCancellativeInstances
                           ++ [RightReductiveMonoidInstance (mempty :: Product Integer),
                               RightReductiveMonoidInstance (mempty :: IntSet),
+                              RightReductiveMonoidInstance (mempty :: Map Char Int),
+                              RightReductiveMonoidInstance (mempty :: IntMap Char),
                               RightReductiveMonoidInstance (mempty :: Set String),
                               RightReductiveMonoidInstance (mempty :: Concat ByteString),
                               RightReductiveMonoidInstance (mempty :: Concat Lazy.ByteString),
                               RightReductiveMonoidInstance (mempty :: Concat Text),
                               RightReductiveMonoidInstance (mempty :: Concat Lazy.Text),
-                              RightReductiveMonoidInstance (mempty :: Concat (Dual Text))]
+                              RightReductiveMonoidInstance (mempty :: Concat (Dual Text)),
+                              RightReductiveMonoidInstance (mempty :: LinePositioned Text),
+                              RightReductiveMonoidInstance (mempty :: OffsetPositioned Text),
+                              RightReductiveMonoidInstance (mempty :: Measured Text),
+                              RightReductiveMonoidInstance (mempty :: Stateful (Sum Integer) Text)]
    where upcast (RightCancellativeMonoidInstance i) = RightReductiveMonoidInstance i
 
 reductiveInstances = map upcast cancellativeInstances
                      ++ [ReductiveMonoidInstance (mempty :: Product Integer),
                          ReductiveMonoidInstance (mempty :: IntSet),
+                         ReductiveMonoidInstance (mempty :: Maybe IntSet),
                          ReductiveMonoidInstance (mempty :: Set Integer)]
    where upcast (CancellativeMonoidInstance i) = ReductiveMonoidInstance i
 
+overlappingGCDMonoidInstances = map upcast monusInstances
+                               ++ [OverlappingGCDMonoidInstance (mempty :: String),
+                                   OverlappingGCDMonoidInstance (mempty :: Seq Int),
+                                   OverlappingGCDMonoidInstance (mempty :: ByteString),
+                                   OverlappingGCDMonoidInstance (mempty :: Lazy.ByteString),
+                                   OverlappingGCDMonoidInstance (mempty :: Text),
+                                   OverlappingGCDMonoidInstance (mempty :: Lazy.Text),
+                                   OverlappingGCDMonoidInstance (mempty :: Vector Char),
+                                   OverlappingGCDMonoidInstance (mempty :: IntMap Char),
+                                   OverlappingGCDMonoidInstance (mempty :: Map Char Int)]
+   where upcast (MonusInstance i) = OverlappingGCDMonoidInstance i
+
+monusInstances = [MonusInstance (mempty :: Product Natural),
+                  MonusInstance (mempty :: Sum Natural),
+                  MonusInstance (mempty :: Dual (Product Natural)),
+                  MonusInstance (mempty :: Maybe (Product Natural)),
+                  MonusInstance (mempty :: IntSet),
+                  MonusInstance (mempty :: Set String)]
+
 leftCancellativeInstances = map upcast cancellativeInstances
                             ++ [LeftCancellativeMonoidInstance (mempty :: String),
                                 LeftCancellativeMonoidInstance (mempty :: ByteString),
@@ -296,6 +343,9 @@
 rightGCDInstances = map upcast gcdInstances
                    ++ [RightGCDMonoidInstance (mempty :: ByteString),
                        RightGCDMonoidInstance (mempty :: Lazy.ByteString),
+                       RightGCDMonoidInstance (mempty :: Text),
+                       RightGCDMonoidInstance (mempty :: Lazy.Text),
+                       RightGCDMonoidInstance (mempty :: String),
                        RightGCDMonoidInstance (mempty :: Dual String),
                        RightGCDMonoidInstance (mempty :: (Seq Int, ByteString)),
                        RightGCDMonoidInstance (mempty :: Seq Int),
@@ -306,19 +356,13 @@
    where upcast (GCDMonoidInstance i) = RightGCDMonoidInstance i
 
 gcdInstances = map upcast cancellativeGCDInstances
-               ++ [GCDMonoidInstance (mempty :: Product Integer),
-                   GCDMonoidInstance (mempty :: Dual (Product Integer)),
+               ++ [GCDMonoidInstance (mempty :: Product Natural),
+                   GCDMonoidInstance (mempty :: Dual (Product Natural)),
                    GCDMonoidInstance (mempty :: IntSet),
                    GCDMonoidInstance (mempty :: Set String)]
    where upcast (CancellativeGCDMonoidInstance i) = GCDMonoidInstance i
 
-cancellativeGCDInstances = [CancellativeGCDMonoidInstance (),
-                            CancellativeGCDMonoidInstance (mempty :: Sum Integer),
-                            CancellativeGCDMonoidInstance (mempty :: Dual (Sum Integer)),
-                            CancellativeGCDMonoidInstance (mempty :: (Sum Integer, Dual (Sum Integer))),
-                            CancellativeGCDMonoidInstance (mempty :: (Sum Integer, (), Dual (Sum Integer))),
-                            CancellativeGCDMonoidInstance (mempty :: ((Sum Integer, ()), Sum Integer, (),
-                                                                      Dual (Sum Integer)))]
+cancellativeGCDInstances = [CancellativeGCDMonoidInstance ()]
 
 main = defaultMain (testGroup "MonoidSubclasses" $ map expand tests)
   where expand (name, test) = testProperty name (foldr1 (.&&.) $ checkInstances test)
@@ -336,6 +380,8 @@
 checkInstances (LeftCancellativeTest checkType) = (map checkType leftCancellativeInstances) 
 checkInstances (RightCancellativeTest checkType) = (map checkType rightCancellativeInstances) 
 checkInstances (CancellativeTest checkType) = (map checkType cancellativeInstances) 
+checkInstances (OverlappingGCDTest checkType) = (map checkType overlappingGCDMonoidInstances)
+checkInstances (MonusTest checkType) = (map checkType monusInstances)
 checkInstances (LeftGCDTest checkType) = (map checkType leftGCDInstances) 
 checkInstances (RightGCDTest checkType) = (map checkType rightGCDInstances) 
 checkInstances (GCDTest checkType) = (map checkType gcdInstances)  
@@ -401,6 +447,12 @@
          ("Textual.takeWhile_", TextualTest checkTextualTakeWhile_),
          ("Textual.dropWhile_", TextualTest checkTextualDropWhile_),
          ("stripPrefix", LeftReductiveTest checkStripPrefix),
+         ("stripPrefixOverlap 1", OverlappingGCDTest checkStripPrefixOverlap1),
+         ("stripPrefixOverlap 2", OverlappingGCDTest checkStripPrefixOverlap2),
+         ("stripPrefixOverlap 3", OverlappingGCDTest checkStripPrefixOverlap3),
+         ("stripSuffixOverlap 1", OverlappingGCDTest checkStripSuffixOverlap1),
+         ("stripSuffixOverlap 2", OverlappingGCDTest checkStripSuffixOverlap2),
+         ("stripSuffixOverlap 3", OverlappingGCDTest checkStripSuffixOverlap3),
          ("isPrefixOf", LeftReductiveTest checkIsPrefixOf),
          ("stripSuffix", RightReductiveTest checkStripSuffix),
          ("isSuffixOf", RightReductiveTest checkIsSuffixOf),
@@ -410,8 +462,12 @@
          ("cancellative </>", CancellativeTest checkUnAppend'),
          ("stripCommonPrefix 1", LeftGCDTest checkStripCommonPrefix1),
          ("stripCommonPrefix 2", LeftGCDTest checkStripCommonPrefix2),
+         ("stripCommonPrefix 3", LeftGCDTest checkStripCommonPrefix3),
+         ("stripCommonPrefix 4", LeftGCDTest checkStripCommonPrefix4),
          ("stripCommonSuffix 1", RightGCDTest checkStripCommonSuffix1),
          ("stripCommonSuffix 2", RightGCDTest checkStripCommonSuffix2),
+         ("stripCommonSuffix 3", RightGCDTest checkStripCommonSuffix3),
+         ("stripCommonSuffix 4", RightGCDTest checkStripCommonSuffix4),
          ("gcd", GCDTest checkGCD),
          ("cancellative gcd", CancellativeGCDTest checkCancellativeGCD)
         ]
@@ -421,7 +477,7 @@
 checkNull (NullMonoidInstance (e :: a)) = null e .&&. forAll (arbitrary :: Gen a) (\a-> null a == (a == mempty))
 
 checkPositive (PositiveMonoidInstance (_ :: a)) =
-   forAll (arbitrary :: Gen (a, a)) (\(a, b)-> null a && null b || not (null (a <> b)))
+   forAll (arbitrary :: Gen (a, a)) (\(a, b)-> null a && null b || not (null (mappend a b)))
 
 checkConcatFactors (FactorialMonoidInstance (e :: a)) = null (factors e) .&&. forAll (arbitrary :: Gen a) check
    where check a = mconcat (factors a) == a
@@ -511,9 +567,12 @@
 
 checkTextualMap (TextualMonoidInstance (_ :: a)) = 
    forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2
-   where check1 a = Textual.map succ a == Textual.concatMap (Textual.singleton . succ) a
+   where check1 a = Textual.map wrapSucc a == Textual.concatMap (Textual.singleton . wrapSucc) a
                     && Textual.map id a == a
-         check2 s = Textual.map succ (fromString s :: a) == fromString (List.map succ s)
+         check2 s = Textual.map wrapSucc (fromString s :: a) == fromString (List.map wrapSucc s)
+         wrapSucc c
+            | c == maxBound = minBound
+            | otherwise = succ c
 
 checkConcatMap (TextualMonoidInstance (_ :: a)) = 
    forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2
@@ -711,6 +770,34 @@
    where check (a, b) = maybe a (b <>) (a </> b) == a
                         && maybe a (<> b) (a </> b) == a
 
+checkStripPrefixOverlap1 (OverlappingGCDMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen (a, a)) check
+   where check (a, b) = o `isSuffixOf` b && b `isSuffixOf` (a <> o)
+            where o = stripPrefixOverlap a b
+
+checkStripPrefixOverlap2 (OverlappingGCDMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen (a, a, a)) check
+   where check (ap, o, bs) = b `isSuffixOf` (a <> b') && b' `isSuffixOf` bs
+            where a = ap <> o
+                  b = o <> bs
+                  b' = stripPrefixOverlap a b
+
+checkStripPrefixOverlap3 (OverlappingGCDMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen (a, a)) check
+   where check (a, b) = all (\(_, s)-> null s || not (b `isSuffixOf` (a <> s))) (splitPrimePrefix b')
+            where b' = stripPrefixOverlap a b
+
+checkStripSuffixOverlap1 (OverlappingGCDMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen (a, a)) check
+   where check (a, b) = o `isPrefixOf` a && a `isPrefixOf` (o <> b)
+            where o = stripSuffixOverlap b a
+
+checkStripSuffixOverlap2 (OverlappingGCDMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen (a, a, a)) check
+   where check (ap, o, bs) = a `isPrefixOf` (a' <> b) && a' `isPrefixOf` ap
+            where a = ap <> o
+                  b = o <> bs
+                  a' = stripSuffixOverlap b a
+
+checkStripSuffixOverlap3 (OverlappingGCDMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen (a, a)) check
+   where check (a, b) = all (\(p, _)-> null p || not (a `isPrefixOf` (p <> b))) (splitPrimeSuffix a')
+            where a' = stripSuffixOverlap b a
+
 checkStripPrefix' (LeftCancellativeMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen (a, a)) check
    where check (a, b) = stripPrefix a (a <> b) == Just b
 
@@ -731,6 +818,16 @@
    where check (a, b) = p == commonPrefix a b && p <> a' == a && p <> b' == b
             where (p, a', b') = stripCommonPrefix a b
 
+checkStripCommonPrefix3 (LeftGCDMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen (a, a, a)) check
+   where check (p, as, bs) = p `isPrefixOf` commonPrefix a b
+            where a = p <> as
+                  b = p <> bs
+
+checkStripCommonPrefix4 (LeftGCDMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen (a, a, a)) check
+   where check (p, a, b) = not (c /= c' && c' `isPrefixOf` a && c' `isPrefixOf` b)
+            where c = commonPrefix a b
+                  c' = p <> c
+
 checkStripCommonSuffix1 (RightGCDMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen (a, a)) check
    where check (a, b) = stripCommonSuffix a b == (a', b', s)
             where s = commonSuffix a b
@@ -741,6 +838,16 @@
    where check (a, b) = s == commonSuffix a b && a' <> s == a && b' <> s == b
             where (a', b', s) = stripCommonSuffix a b
 
+checkStripCommonSuffix3 (RightGCDMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen (a, a, a)) check
+   where check (ap, bp, s) = s `isSuffixOf` commonSuffix a b
+            where a = ap <> s
+                  b = bp <> s
+
+checkStripCommonSuffix4 (RightGCDMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen (a, a, a)) check
+   where check (a, b, s) = not (c /= c' && c' `isSuffixOf` a && c' `isSuffixOf` b)
+            where c = commonSuffix a b
+                  c' = c <> s
+
 checkGCD (GCDMonoidInstance (_ :: a)) = forAll (arbitrary :: Gen (a, a)) check
    where check (a, b) = d == commonPrefix a b
                         && d == commonSuffix a b
@@ -758,9 +865,13 @@
 textualFactors = map characterize . factors
    where characterize prime = maybe (Left prime) Right (Textual.characterPrefix prime)
 
-newtype TestString = TestString String deriving (Eq, Show, Arbitrary, CoArbitrary, Semigroup,
-                                                 Monoid, LeftReductiveMonoid, LeftCancellativeMonoid, LeftGCDMonoid,
-                                                 MonoidNull, PositiveMonoid, StableFactorialMonoid, IsString)
+newtype TestString = TestString String deriving (Eq, Show, Arbitrary, CoArbitrary, 
+                                                 Semigroup, LeftReductive, LeftCancellative, StableFactorial,
+                                                 Monoid, LeftGCDMonoid,
+                                                 MonoidNull, PositiveMonoid, IsString)
+
+instance Factorial TestString where
+   factors (TestString s) = TestString <$> factors s
 
 instance FactorialMonoid TestString where
    splitPrimePrefix (TestString []) = Nothing
diff --git a/monoid-subclasses.cabal b/monoid-subclasses.cabal
--- a/monoid-subclasses.cabal
+++ b/monoid-subclasses.cabal
@@ -1,5 +1,5 @@
 Name:                monoid-subclasses
-Version:             0.4.6.1
+Version:             1.0
 Cabal-Version:       >= 1.10
 Build-Type:          Simple
 Synopsis:            Subclasses of Monoid
@@ -22,12 +22,16 @@
   location:          https://github.com/blamario/monoid-subclasses
 
 Library
-  Exposed-Modules:   Data.Monoid.Cancellative, Data.Monoid.Factorial, Data.Monoid.Null, Data.Monoid.Textual,
-                     Data.Monoid.Instances.ByteString.UTF8, Data.Monoid.Instances.Concat,
-                     Data.Monoid.Instances.Measured, Data.Monoid.Instances.Positioned, Data.Monoid.Instances.Stateful
+  hs-source-dirs:    src
+  Exposed-Modules:   Data.Semigroup.Cancellative, Data.Semigroup.Factorial,
+                     Data.Monoid.Cancellative, Data.Monoid.GCD, Data.Monoid.Monus,
+                     Data.Monoid.Factorial, Data.Monoid.Null, Data.Monoid.Textual,
+                     Data.Monoid.Instances.ByteString.UTF8, Data.Monoid.Instances.CharVector,
+                     Data.Monoid.Instances.Concat, Data.Monoid.Instances.Measured, Data.Monoid.Instances.Positioned,
+                     Data.Monoid.Instances.Stateful
   Build-Depends:     base >= 4.9 && < 5,
                      bytestring >= 0.9 && < 1.0, containers >= 0.5.7.0 && < 0.7, text >= 0.11 && < 1.3,
-                     primes == 0.2.*, vector >= 0.9 && < 0.13
+                     primes == 0.2.*, vector >= 0.12 && < 0.13
   GHC-options:       -Wall
   default-language:  Haskell2010
 
@@ -35,7 +39,7 @@
   Type:              exitcode-stdio-1.0
   Build-Depends:     base >= 4.9 && < 5,
                      bytestring >= 0.9 && < 1.0, containers >= 0.5.7.0 && < 0.7, text >= 0.11 && < 1.3,
-                     vector >= 0.9 && < 0.13, primes == 0.2.*,
+                     vector >= 0.12 && < 0.13, primes == 0.2.*,
                      QuickCheck >= 2.9 && < 3, quickcheck-instances >= 0.3.12 && <0.4,
                      tasty >= 0.7, tasty-quickcheck >= 0.7 && < 1.0,
                      monoid-subclasses
diff --git a/src/Data/Monoid/Cancellative.hs b/src/Data/Monoid/Cancellative.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Cancellative.hs
@@ -0,0 +1,57 @@
+{- 
+    Copyright 2013-2019 Mario Blazevic
+
+    License: BSD3 (see BSD3-LICENSE.txt file)
+-}
+
+-- | This module defines the 'Monoid' => 'CommutativeMonoid' => 'ReductiveMonoid' => 'CancellativeMonoid' constraint
+-- synonym hierarchy.
+--
+-- Since most practical monoids in Haskell are not commutative, the last two of these synonyms have two symmetric
+-- superclasses each:
+-- 
+-- * 'LeftReductiveMonoid'
+-- 
+-- * 'LeftCancellativeMonoid'
+-- 
+-- * 'RightReductiveMonoid'
+-- 
+-- * 'RightCancellativeMonoid'
+--
+-- This module and its constraint synonyms are provided for compatibility with the older versions of the
+-- @monoid-sublasses@ library. Starting with version 1.0, the classes from the "Data.Semigroup.Cancellative" module
+-- are recommended instead.
+
+{-# LANGUAGE Haskell2010, ConstraintKinds, FlexibleInstances #-}
+
+module Data.Monoid.Cancellative {- from 1.1 # DEPRECATED "Use \"Data.Semigroup.Cancellative\" and \"Data.Monoid.GCD\" instead" #-} (
+   module Data.Semigroup.Cancellative,
+   module Data.Monoid.GCD,
+   -- * Symmetric, commutative monoid classes
+   CommutativeMonoid, ReductiveMonoid, CancellativeMonoid,
+   -- * Asymmetric monoid classes
+   LeftReductiveMonoid, RightReductiveMonoid,
+   LeftCancellativeMonoid, RightCancellativeMonoid
+   )
+where
+
+import Data.Monoid (Monoid)
+
+import Data.Semigroup.Cancellative
+import Data.Monoid.GCD
+
+{- from 1.1 #-}
+{- # DEPRECATED CommutativeMonoid "Use Data.Semigroup.Cancellative.Commutative instead." #-}
+{- # DEPRECATED ReductiveMonoid "Use Data.Semigroup.Cancellative.Reductive instead." #-}
+{- # DEPRECATED LeftReductiveMonoid "Use Data.Semigroup.Cancellative.LeftReductive instead." #-}
+{- # DEPRECATED RightReductiveMonoid "Use Data.Semigroup.Cancellative.RightReductive instead." #-}
+{- # DEPRECATED CancellativeMonoid "Use Data.Semigroup.Cancellative.Cancellative instead." #-}
+{- # DEPRECATED LeftCancellativeMonoid "Use Data.Semigroup.Cancellative.LeftCancellative instead." #-}
+{- # DEPRECATED RightCancellativeMonoid "Use Data.Semigroup.Cancellative.RightCancellative instead." #-}
+type CommutativeMonoid m = (Monoid m, Commutative m)
+type ReductiveMonoid m = (Monoid m, Reductive m)
+type LeftReductiveMonoid m = (Monoid m, LeftReductive m)
+type RightReductiveMonoid m = (Monoid m, RightReductive m)
+type CancellativeMonoid m = (Monoid m, Cancellative m)
+type LeftCancellativeMonoid m = (Monoid m, LeftCancellative m)
+type RightCancellativeMonoid m = (Monoid m, RightCancellative m)
diff --git a/src/Data/Monoid/Factorial.hs b/src/Data/Monoid/Factorial.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Factorial.hs
@@ -0,0 +1,539 @@
+{- 
+    Copyright 2013-2017 Mario Blazevic
+
+    License: BSD3 (see BSD3-LICENSE.txt file)
+-}
+
+-- | This module defines the 'FactorialMonoid' class and some of its instances.
+-- 
+
+{-# LANGUAGE Haskell2010, ConstraintKinds, FlexibleInstances, Trustworthy #-}
+
+module Data.Monoid.Factorial (
+   module Data.Semigroup.Factorial,
+   FactorialMonoid(..), StableFactorialMonoid,
+   )
+where
+
+import Control.Arrow (first)
+import Data.Monoid -- (Monoid (..), Dual(..), Sum(..), Product(..), Endo(Endo, appEndo))
+import qualified Data.Foldable as Foldable
+import qualified Data.List as List
+import qualified Data.ByteString 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 Data.Int (Int64)
+
+import Data.Semigroup.Factorial
+import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)
+
+import Prelude hiding (break, drop, dropWhile, foldl, foldr, last, length, map, max, min,
+                       null, reverse, span, splitAt, take, takeWhile)
+
+
+-- | Class of monoids that can be split into irreducible (/i.e./, atomic or prime) 'factors' in a unique way. Factors of
+-- a 'Product' are literally its prime factors:
+--
+-- prop> factors (Product 12) == [Product 2, Product 2, Product 3]
+--
+-- Factors of a list are /not/ its elements but all its single-item sublists:
+--
+-- prop> factors "abc" == ["a", "b", "c"]
+-- 
+-- The methods of this class satisfy the following laws in addition to those of 'Factorial':
+-- 
+-- > null == List.null . factors
+-- > factors == unfoldr splitPrimePrefix == List.reverse . unfoldr (fmap swap . splitPrimeSuffix)
+-- > reverse == mconcat . List.reverse . factors
+-- > primePrefix == maybe mempty fst . splitPrimePrefix
+-- > primeSuffix == maybe mempty snd . splitPrimeSuffix
+-- > inits == List.map mconcat . List.inits . factors
+-- > tails == List.map mconcat . List.tails . factors
+-- > span p m == (mconcat l, mconcat r) where (l, r) = List.span p (factors m)
+-- > List.all (List.all (not . pred) . factors) . split pred
+-- > mconcat . intersperse prime . split (== prime) == id
+-- > splitAt i m == (mconcat l, mconcat r) where (l, r) = List.splitAt i (factors m)
+-- > spanMaybe () (const $ bool Nothing (Maybe ()) . p) m == (takeWhile p m, dropWhile p m, ())
+-- > spanMaybe s0 (\s m-> Just $ f s m) m0 == (m0, mempty, foldl f s0 m0)
+-- > let (prefix, suffix, s') = spanMaybe s f m
+-- >     foldMaybe = foldl g (Just s)
+-- >     g s m = s >>= flip f m
+-- > in all ((Nothing ==) . foldMaybe) (inits prefix)
+-- >    && prefix == last (filter (isJust . foldMaybe) $ inits m)
+-- >    && Just s' == foldMaybe prefix
+-- >    && m == prefix <> suffix
+--
+-- A minimal instance definition should implement 'splitPrimePrefix' for performance reasons, and other methods where
+-- beneficial.
+class (Factorial m, MonoidNull m) => FactorialMonoid m where
+   -- | Splits the argument into its prime prefix and the remaining suffix. Returns 'Nothing' for 'mempty'.
+   splitPrimePrefix :: m -> Maybe (m, m)
+   -- | Splits the argument into its prime suffix and the remaining prefix. Returns 'Nothing' for 'mempty'.
+   splitPrimeSuffix :: m -> Maybe (m, m)
+   -- | Returns the list of all prefixes of the argument, 'mempty' first.
+   inits :: m -> [m]
+   -- | Returns the list of all suffixes of the argument, 'mempty' last.
+   tails :: m -> [m]
+   -- | Like 'List.span' from "Data.List" on the list of 'primes'.
+   span :: (m -> Bool) -> m -> (m, m)
+   -- | Equivalent to 'List.break' from "Data.List".
+   break :: (m -> Bool) -> m -> (m, m)
+   -- | Splits the monoid into components delimited by prime separators satisfying the given predicate. The primes
+   -- satisfying the predicate are not a part of the result.
+   split :: (m -> Bool) -> m -> [m]
+   -- | Equivalent to 'List.takeWhile' from "Data.List".
+   takeWhile :: (m -> Bool) -> m -> m
+   -- | Equivalent to 'List.dropWhile' from "Data.List".
+   dropWhile :: (m -> Bool) -> m -> m
+   -- | A stateful variant of 'span', threading the result of the test function as long as it returns 'Just'.
+   spanMaybe :: s -> (s -> m -> Maybe s) -> m -> (m, m, s)
+   -- | Strict version of 'spanMaybe'.
+   spanMaybe' :: s -> (s -> m -> Maybe s) -> m -> (m, m, s)
+   -- | Like 'List.splitAt' from "Data.List" on the list of 'primes'.
+   splitAt :: Int -> m -> (m, m)
+   -- | Equivalent to 'List.drop' from "Data.List".
+   drop :: Int -> m -> m
+   -- | Equivalent to 'List.take' from "Data.List".
+   take :: Int -> m -> m
+
+   splitPrimePrefix x = case factors x
+                        of [] -> Nothing
+                           prefix : rest -> Just (prefix, mconcat rest)
+   splitPrimeSuffix x = case factors x
+                        of [] -> Nothing
+                           fs -> Just (mconcat (List.init fs), List.last fs)
+   inits = foldr (\m l-> mempty : List.map (mappend m) l) [mempty]
+   tails m = m : maybe [] (tails . snd) (splitPrimePrefix m)
+   span p m0 = spanAfter id m0
+      where spanAfter f m = case splitPrimePrefix m
+                            of Just (prime, rest) | p prime -> spanAfter (f . mappend prime) rest
+                               _ -> (f mempty, m)
+   break = span . (not .)
+   spanMaybe s0 f m0 = spanAfter id s0 m0
+      where spanAfter g s m = case splitPrimePrefix m
+                              of Just (prime, rest) | Just s' <- f s prime -> spanAfter (g . mappend prime) s' rest
+                                                    | otherwise -> (g mempty, m, s)
+                                 Nothing -> (m0, m, s)
+   spanMaybe' s0 f m0 = spanAfter id s0 m0
+      where spanAfter g s m = seq s $
+                              case splitPrimePrefix m
+                              of Just (prime, rest) | Just s' <- f s prime -> spanAfter (g . mappend prime) s' rest
+                                                    | otherwise -> (g mempty, m, s)
+                                 Nothing -> (m0, m, s)
+   split p m = prefix : splitRest
+      where (prefix, rest) = break p m
+            splitRest = case splitPrimePrefix rest
+                        of Nothing -> []
+                           Just (_, tl) -> split p tl
+   takeWhile p = fst . span p
+   dropWhile p = snd . span p
+   splitAt n0 m0 | n0 <= 0 = (mempty, m0)
+                 | otherwise = split' n0 id m0
+      where split' 0 f m = (f mempty, m)
+            split' n f m = case splitPrimePrefix m
+                           of Nothing -> (f mempty, m)
+                              Just (prime, rest) -> split' (pred n) (f . mappend prime) rest
+   drop n p = snd (splitAt n p)
+   take n p = fst (splitAt n p)
+   {-# MINIMAL #-}
+
+{-# DEPRECATED StableFactorialMonoid "Use Data.Semigroup.Factorial.StableFactorial instead." #-}
+type StableFactorialMonoid m = (StableFactorial m, FactorialMonoid m, PositiveMonoid m)
+
+instance FactorialMonoid () where
+   splitPrimePrefix () = Nothing
+   splitPrimeSuffix () = Nothing
+
+instance FactorialMonoid a => FactorialMonoid (Dual a) where
+   splitPrimePrefix (Dual a) = case splitPrimeSuffix a
+                               of Nothing -> Nothing
+                                  Just (p, s) -> Just (Dual s, Dual p)
+   splitPrimeSuffix (Dual a) = case splitPrimePrefix a
+                               of Nothing -> Nothing
+                                  Just (p, s) -> Just (Dual s, Dual p)
+   inits (Dual a) = fmap Dual (reverse $ tails a)
+   tails (Dual a) = fmap Dual (reverse $ inits a)
+
+instance (Integral a, Eq a) => FactorialMonoid (Sum a) where
+   splitPrimePrefix (Sum 0) = Nothing
+   splitPrimePrefix (Sum a) = Just (Sum (signum a), Sum (a - signum a))
+   splitPrimeSuffix (Sum 0) = Nothing
+   splitPrimeSuffix (Sum a) = Just (Sum (a - signum a), Sum (signum a))
+
+instance Integral a => FactorialMonoid (Product a)
+
+instance FactorialMonoid a => FactorialMonoid (Maybe a) where
+   splitPrimePrefix Nothing = Nothing
+   splitPrimePrefix (Just a) = case splitPrimePrefix a
+                               of Nothing -> Just (Just a, Nothing)
+                                  Just (p, s) -> Just (Just p, if null s then Nothing else Just s)
+
+
+instance (FactorialMonoid a, FactorialMonoid b) => FactorialMonoid (a, b) where
+   splitPrimePrefix (a, b) = case (splitPrimePrefix a, splitPrimePrefix b)
+                             of (Just (ap, as), _) -> Just ((ap, mempty), (as, b))
+                                (Nothing, Just (bp, bs)) -> Just ((a, bp), (a, bs))
+                                (Nothing, Nothing) -> Nothing
+   splitPrimeSuffix (a, b) = case (splitPrimeSuffix a, splitPrimeSuffix b)
+                             of (_, Just (bp, bs)) -> Just ((a, bp), (mempty, bs))
+                                (Just (ap, as), Nothing) -> Just ((ap, b), (as, b))
+                                (Nothing, Nothing) -> Nothing
+   inits (a, b) = List.map (flip (,) mempty) (inits a) ++ List.map ((,) a) (List.tail $ inits b)
+   tails (a, b) = List.map (flip (,) b) (tails a) ++ List.map ((,) mempty) (List.tail $ tails b)
+   span p (x, y) = ((xp, yp), (xs, ys))
+      where (xp, xs) = span (p . fromFst) x
+            (yp, ys) | null xs = span (p . fromSnd) y
+                     | otherwise = (mempty, y)
+   spanMaybe s0 f (x, y) | null xs = ((xp, yp), (xs, ys), s2)
+                         | otherwise = ((xp, mempty), (xs, y), s1)
+     where (xp, xs, s1) = spanMaybe s0 (\s-> f s . fromFst) x
+           (yp, ys, s2) = spanMaybe s1 (\s-> f s . fromSnd) y
+   spanMaybe' s0 f (x, y) | null xs = ((xp, yp), (xs, ys), s2)
+                          | otherwise = ((xp, mempty), (xs, y), s1)
+     where (xp, xs, s1) = spanMaybe' s0 (\s-> f s . fromFst) x
+           (yp, ys, s2) = spanMaybe' s1 (\s-> f s . fromSnd) y
+   split p (x0, y0) = fst $ List.foldr combine (ys, False) xs
+      where xs = List.map fromFst $ split (p . fromFst) x0
+            ys = List.map fromSnd $ split (p . fromSnd) y0
+            combine x (~(y:rest), False) = (mappend x y : rest, True)
+            combine x (rest, True) = (x:rest, True)
+   splitAt n (x, y) = ((xp, yp), (xs, ys))
+      where (xp, xs) = splitAt n x
+            (yp, ys) | null xs = splitAt (n - length x) y
+                     | otherwise = (mempty, y)
+
+{-# INLINE fromFst #-}
+fromFst :: Monoid b => a -> (a, b)
+fromFst a = (a, mempty)
+
+{-# INLINE fromSnd #-}
+fromSnd :: Monoid a => b -> (a, b)
+fromSnd b = (mempty, b)
+
+instance (FactorialMonoid a, FactorialMonoid b, FactorialMonoid c) => FactorialMonoid (a, b, c) where
+   splitPrimePrefix (a, b, c) = case (splitPrimePrefix a, splitPrimePrefix b, splitPrimePrefix c)
+                                of (Just (ap, as), _, _) -> Just ((ap, mempty, mempty), (as, b, c))
+                                   (Nothing, Just (bp, bs), _) -> Just ((a, bp, mempty), (a, bs, c))
+                                   (Nothing, Nothing, Just (cp, cs)) -> Just ((a, b, cp), (a, b, cs))
+                                   (Nothing, Nothing, Nothing) -> Nothing
+   splitPrimeSuffix (a, b, c) = case (splitPrimeSuffix a, splitPrimeSuffix b, splitPrimeSuffix c)
+                                of (_, _, Just (cp, cs)) -> Just ((a, b, cp), (mempty, mempty, cs))
+                                   (_, Just (bp, bs), Nothing) -> Just ((a, bp, c), (mempty, bs, c))
+                                   (Just (ap, as), Nothing, Nothing) -> Just ((ap, b, c), (as, b, c))
+                                   (Nothing, Nothing, Nothing) -> Nothing
+   inits (a, b, c) = List.map (\a1-> (a1, mempty, mempty)) (inits a)
+                     ++ List.map (\b1-> (a, b1, mempty)) (List.tail $ inits b)
+                     ++ List.map (\c1-> (a, b, c1)) (List.tail $ inits c)
+   tails (a, b, c) = List.map (\a1-> (a1, b, c)) (tails a)
+                     ++ List.map (\b1-> (mempty, b1, c)) (List.tail $ tails b)
+                     ++ List.map (\c1-> (mempty, mempty, c1)) (List.tail $ tails c)
+   span p (a, b, c) = ((ap, bp, cp), (as, bs, cs))
+      where (ap, as) = span (p . fromFstOf3) a
+            (bp, bs) | null as = span (p . fromSndOf3) b
+                     | otherwise = (mempty, b)
+            (cp, cs) | null as && null bs = span (p . fromThdOf3) c
+                     | otherwise = (mempty, c)
+   spanMaybe s0 f (a, b, c) | not (null as) = ((ap, mempty, mempty), (as, b, c), s1)
+                            | not (null bs) = ((ap, bp, mempty), (as, bs, c), s2)
+                            | otherwise = ((ap, bp, cp), (as, bs, cs), s3)
+     where (ap, as, s1) = spanMaybe s0 (\s-> f s . fromFstOf3) a
+           (bp, bs, s2) = spanMaybe s1 (\s-> f s . fromSndOf3) b
+           (cp, cs, s3) = spanMaybe s2 (\s-> f s . fromThdOf3) c
+   spanMaybe' s0 f (a, b, c) | not (null as) = ((ap, mempty, mempty), (as, b, c), s1)
+                             | not (null bs) = ((ap, bp, mempty), (as, bs, c), s2)
+                             | otherwise = ((ap, bp, cp), (as, bs, cs), s3)
+     where (ap, as, s1) = spanMaybe' s0 (\s-> f s . fromFstOf3) a
+           (bp, bs, s2) = spanMaybe' s1 (\s-> f s . fromSndOf3) b
+           (cp, cs, s3) = spanMaybe' s2 (\s-> f s . fromThdOf3) c
+   splitAt n (a, b, c) = ((ap, bp, cp), (as, bs, cs))
+      where (ap, as) = splitAt n a
+            (bp, bs) | null as = splitAt (n - length a) b
+                     | otherwise = (mempty, b)
+            (cp, cs) | null as && null bs = splitAt (n - length a - length b) c
+                     | otherwise = (mempty, c)
+
+{-# INLINE fromFstOf3 #-}
+fromFstOf3 :: (Monoid b, Monoid c) => a -> (a, b, c)
+fromFstOf3 a = (a, mempty, mempty)
+
+{-# INLINE fromSndOf3 #-}
+fromSndOf3 :: (Monoid a, Monoid c) => b -> (a, b, c)
+fromSndOf3 b = (mempty, b, mempty)
+
+{-# INLINE fromThdOf3 #-}
+fromThdOf3 :: (Monoid a, Monoid b) => c -> (a, b, c)
+fromThdOf3 c = (mempty, mempty, c)
+
+instance (FactorialMonoid a, FactorialMonoid b, FactorialMonoid c, FactorialMonoid d) =>
+         FactorialMonoid (a, b, c, d) where
+   splitPrimePrefix (a, b, c, d) = case (splitPrimePrefix a, splitPrimePrefix b, splitPrimePrefix c, splitPrimePrefix d)
+                                   of (Just (ap, as), _, _, _) -> Just ((ap, mempty, mempty, mempty), (as, b, c, d))
+                                      (Nothing, Just (bp, bs), _, _) -> Just ((a, bp, mempty, mempty), (a, bs, c, d))
+                                      (Nothing, Nothing, Just (cp, cs), _) -> Just ((a, b, cp, mempty), (a, b, cs, d))
+                                      (Nothing, Nothing, Nothing, Just (dp, ds)) -> Just ((a, b, c, dp), (a, b, c, ds))
+                                      (Nothing, Nothing, Nothing, Nothing) -> Nothing
+   splitPrimeSuffix (a, b, c, d) = case (splitPrimeSuffix a, splitPrimeSuffix b, splitPrimeSuffix c, splitPrimeSuffix d)
+                                   of (_, _, _, Just (dp, ds)) -> Just ((a, b, c, dp), (mempty, mempty, mempty, ds))
+                                      (_, _, Just (cp, cs), Nothing) -> Just ((a, b, cp, d), (mempty, mempty, cs, d))
+                                      (_, Just (bp, bs), Nothing, Nothing) -> Just ((a, bp, c, d), (mempty, bs, c, d))
+                                      (Just (ap, as), Nothing, Nothing, Nothing) -> Just ((ap, b, c, d), (as, b, c, d))
+                                      (Nothing, Nothing, Nothing, Nothing) -> Nothing
+   inits (a, b, c, d) = List.map (\a1-> (a1, mempty, mempty, mempty)) (inits a)
+                        ++ List.map (\b1-> (a, b1, mempty, mempty)) (List.tail $ inits b)
+                        ++ List.map (\c1-> (a, b, c1, mempty)) (List.tail $ inits c)
+                        ++ List.map (\d1-> (a, b, c, d1)) (List.tail $ inits d)
+   tails (a, b, c, d) = List.map (\a1-> (a1, b, c, d)) (tails a)
+                        ++ List.map (\b1-> (mempty, b1, c, d)) (List.tail $ tails b)
+                        ++ List.map (\c1-> (mempty, mempty, c1, d)) (List.tail $ tails c)
+                        ++ List.map (\d1-> (mempty, mempty, mempty, d1)) (List.tail $ tails d)
+   span p (a, b, c, d) = ((ap, bp, cp, dp), (as, bs, cs, ds))
+      where (ap, as) = span (p . fromFstOf4) a
+            (bp, bs) | null as = span (p . fromSndOf4) b
+                     | otherwise = (mempty, b)
+            (cp, cs) | null as && null bs = span (p . fromThdOf4) c
+                     | otherwise = (mempty, c)
+            (dp, ds) | null as && null bs && null cs = span (p . fromFthOf4) d
+                     | otherwise = (mempty, d)
+   spanMaybe s0 f (a, b, c, d) | not (null as) = ((ap, mempty, mempty, mempty), (as, b, c, d), s1)
+                               | not (null bs) = ((ap, bp, mempty, mempty), (as, bs, c, d), s2)
+                               | not (null cs) = ((ap, bp, cp, mempty), (as, bs, cs, d), s3)
+                               | otherwise = ((ap, bp, cp, dp), (as, bs, cs, ds), s4)
+     where (ap, as, s1) = spanMaybe s0 (\s-> f s . fromFstOf4) a
+           (bp, bs, s2) = spanMaybe s1 (\s-> f s . fromSndOf4) b
+           (cp, cs, s3) = spanMaybe s2 (\s-> f s . fromThdOf4) c
+           (dp, ds, s4) = spanMaybe s3 (\s-> f s . fromFthOf4) d
+   spanMaybe' s0 f (a, b, c, d) | not (null as) = ((ap, mempty, mempty, mempty), (as, b, c, d), s1)
+                               | not (null bs) = ((ap, bp, mempty, mempty), (as, bs, c, d), s2)
+                               | not (null cs) = ((ap, bp, cp, mempty), (as, bs, cs, d), s3)
+                               | otherwise = ((ap, bp, cp, dp), (as, bs, cs, ds), s4)
+     where (ap, as, s1) = spanMaybe' s0 (\s-> f s . fromFstOf4) a
+           (bp, bs, s2) = spanMaybe' s1 (\s-> f s . fromSndOf4) b
+           (cp, cs, s3) = spanMaybe' s2 (\s-> f s . fromThdOf4) c
+           (dp, ds, s4) = spanMaybe' s3 (\s-> f s . fromFthOf4) d
+   splitAt n (a, b, c, d) = ((ap, bp, cp, dp), (as, bs, cs, ds))
+      where (ap, as) = splitAt n a
+            (bp, bs) | null as = splitAt (n - length a) b
+                     | otherwise = (mempty, b)
+            (cp, cs) | null as && null bs = splitAt (n - length a - length b) c
+                     | otherwise = (mempty, c)
+            (dp, ds) | null as && null bs && null cs = splitAt (n - length a - length b - length c) d
+                     | otherwise = (mempty, d)
+
+{-# INLINE fromFstOf4 #-}
+fromFstOf4 :: (Monoid b, Monoid c, Monoid d) => a -> (a, b, c, d)
+fromFstOf4 a = (a, mempty, mempty, mempty)
+
+{-# INLINE fromSndOf4 #-}
+fromSndOf4 :: (Monoid a, Monoid c, Monoid d) => b -> (a, b, c, d)
+fromSndOf4 b = (mempty, b, mempty, mempty)
+
+{-# INLINE fromThdOf4 #-}
+fromThdOf4 :: (Monoid a, Monoid b, Monoid d) => c -> (a, b, c, d)
+fromThdOf4 c = (mempty, mempty, c, mempty)
+
+{-# INLINE fromFthOf4 #-}
+fromFthOf4 :: (Monoid a, Monoid b, Monoid c) => d -> (a, b, c, d)
+fromFthOf4 d = (mempty, mempty, mempty, d)
+
+instance FactorialMonoid [x] where
+   splitPrimePrefix [] = Nothing
+   splitPrimePrefix (x:xs) = Just ([x], xs)
+   splitPrimeSuffix [] = Nothing
+   splitPrimeSuffix xs = Just (splitLast id xs)
+      where splitLast f last@[_] = (f [], last)
+            splitLast f ~(x:rest) = splitLast (f . (x:)) rest
+   inits = List.inits
+   tails = List.tails
+   break f = List.break (f . (:[]))
+   span f = List.span (f . (:[]))
+   dropWhile f = List.dropWhile (f . (:[]))
+   takeWhile f = List.takeWhile (f . (:[]))
+   spanMaybe s0 f l = (prefix' [], suffix' [], s')
+      where (prefix', suffix', s', _) = List.foldl' g (id, id, s0, True) l
+            g (prefix, suffix, s1, live) x | live, Just s2 <- f s1 [x] = (prefix . (x:), id, s2, True)
+                                           | otherwise = (prefix, suffix . (x:), s1, False)
+   spanMaybe' s0 f l = (prefix' [], suffix' [], s')
+      where (prefix', suffix', s', _) = List.foldl' g (id, id, s0, True) l
+            g (prefix, suffix, s1, live) x | live, Just s2 <- f s1 [x] = seq s2 $ (prefix . (x:), id, s2, True)
+                                           | otherwise = (prefix, suffix . (x:), s1, False)
+   splitAt = List.splitAt
+   drop = List.drop
+   take = List.take
+
+instance FactorialMonoid ByteString.ByteString where
+   splitPrimePrefix x = if ByteString.null x then Nothing else Just (ByteString.splitAt 1 x)
+   splitPrimeSuffix x = if ByteString.null x then Nothing else Just (ByteString.splitAt (ByteString.length x - 1) x)
+   inits = ByteString.inits
+   tails = ByteString.tails
+   break f = ByteString.break (f . ByteString.singleton)
+   span f = ByteString.span (f . ByteString.singleton)
+   spanMaybe s0 f b = case ByteString.foldr g id b (0, s0)
+                      of (i, s') | (prefix, suffix) <- ByteString.splitAt i b -> (prefix, suffix, s')
+      where g w cont (i, s) | Just s' <- f s (ByteString.singleton w) = let i' = succ i :: Int in seq i' $ cont (i', s')
+                            | otherwise = (i, s)
+   spanMaybe' s0 f b = case ByteString.foldr g id b (0, s0)
+                       of (i, s') | (prefix, suffix) <- ByteString.splitAt i b -> (prefix, suffix, s')
+      where g w cont (i, s) | Just s' <- f s (ByteString.singleton w) = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')
+                            | otherwise = (i, s)
+   dropWhile f = ByteString.dropWhile (f . ByteString.singleton)
+   takeWhile f = ByteString.takeWhile (f . ByteString.singleton)
+   split f = ByteString.splitWith f'
+      where f' = f . ByteString.singleton
+   splitAt = ByteString.splitAt
+   drop = ByteString.drop
+   take = ByteString.take
+
+instance FactorialMonoid LazyByteString.ByteString where
+   splitPrimePrefix x = if LazyByteString.null x then Nothing
+                        else Just (LazyByteString.splitAt 1 x)
+   splitPrimeSuffix x = if LazyByteString.null x then Nothing
+                        else Just (LazyByteString.splitAt (LazyByteString.length x - 1) x)
+   inits = LazyByteString.inits
+   tails = LazyByteString.tails
+   break f = LazyByteString.break (f . LazyByteString.singleton)
+   span f = LazyByteString.span (f . LazyByteString.singleton)
+   spanMaybe s0 f b = case LazyByteString.foldr g id b (0, s0)
+                      of (i, s') | (prefix, suffix) <- LazyByteString.splitAt i b -> (prefix, suffix, s')
+      where g w cont (i, s) | Just s' <- f s (LazyByteString.singleton w) = let i' = succ i :: Int64 in seq i' $ cont (i', s')
+                            | otherwise = (i, s)
+   spanMaybe' s0 f b = case LazyByteString.foldr g id b (0, s0)
+                       of (i, s') | (prefix, suffix) <- LazyByteString.splitAt i b -> (prefix, suffix, s')
+      where g w cont (i, s)
+              | Just s' <- f s (LazyByteString.singleton w) = let i' = succ i :: Int64 in seq i' $ seq s' $ cont (i', s')
+              | otherwise = (i, s)
+   dropWhile f = LazyByteString.dropWhile (f . LazyByteString.singleton)
+   takeWhile f = LazyByteString.takeWhile (f . LazyByteString.singleton)
+   split f = LazyByteString.splitWith f'
+      where f' = f . LazyByteString.singleton
+   splitAt = LazyByteString.splitAt . fromIntegral
+   drop n = LazyByteString.drop (fromIntegral n)
+   take n = LazyByteString.take (fromIntegral n)
+
+instance FactorialMonoid Text.Text where
+   splitPrimePrefix = fmap (first Text.singleton) . Text.uncons
+   splitPrimeSuffix x = if Text.null x then Nothing else Just (Text.init x, Text.singleton (Text.last x))
+   inits = Text.inits
+   tails = Text.tails
+   span f = Text.span (f . Text.singleton)
+   break f = Text.break (f . Text.singleton)
+   dropWhile f = Text.dropWhile (f . Text.singleton)
+   takeWhile f = Text.takeWhile (f . Text.singleton)
+   spanMaybe s0 f t = case Text.foldr g id t (0, s0)
+                      of (i, s') | (prefix, suffix) <- Text.splitAt i t -> (prefix, suffix, s')
+      where g c cont (i, s) | Just s' <- f s (Text.singleton c) = let i' = succ i :: Int in seq i' $ cont (i', s')
+                            | otherwise = (i, s)
+   spanMaybe' s0 f t = case Text.foldr g id t (0, s0)
+                       of (i, s') | (prefix, suffix) <- Text.splitAt i t -> (prefix, suffix, s')
+      where g c cont (i, s) | Just s' <- f s (Text.singleton c) = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')
+                            | otherwise = (i, s)
+   split f = Text.split f'
+      where f' = f . Text.singleton
+   splitAt = Text.splitAt
+   drop = Text.drop
+   take = Text.take
+
+instance FactorialMonoid LazyText.Text where
+   splitPrimePrefix = fmap (first LazyText.singleton) . LazyText.uncons
+   splitPrimeSuffix x = if LazyText.null x
+                        then Nothing
+                        else Just (LazyText.init x, LazyText.singleton (LazyText.last x))
+   inits = LazyText.inits
+   tails = LazyText.tails
+   span f = LazyText.span (f . LazyText.singleton)
+   break f = LazyText.break (f . LazyText.singleton)
+   dropWhile f = LazyText.dropWhile (f . LazyText.singleton)
+   takeWhile f = LazyText.takeWhile (f . LazyText.singleton)
+   spanMaybe s0 f t = case LazyText.foldr g id t (0, s0)
+                      of (i, s') | (prefix, suffix) <- LazyText.splitAt i t -> (prefix, suffix, s')
+      where g c cont (i, s) | Just s' <- f s (LazyText.singleton c) = let i' = succ i :: Int64 in seq i' $ cont (i', s')
+                            | otherwise = (i, s)
+   spanMaybe' s0 f t = case LazyText.foldr g id t (0, s0)
+                       of (i, s') | (prefix, suffix) <- LazyText.splitAt i t -> (prefix, suffix, s')
+      where g c cont (i, s) | Just s' <- f s (LazyText.singleton c) = let i' = succ i :: Int64 in seq i' $ seq s' $ cont (i', s')
+                            | otherwise = (i, s)
+   split f = LazyText.split f'
+      where f' = f . LazyText.singleton
+   splitAt = LazyText.splitAt . fromIntegral
+   drop n = LazyText.drop (fromIntegral n)
+   take n = LazyText.take (fromIntegral n)
+
+instance Ord k => FactorialMonoid (Map.Map k v) where
+   splitPrimePrefix = fmap singularize . Map.minViewWithKey
+      where singularize ((k, v), rest) = (Map.singleton k v, rest)
+   splitPrimeSuffix = fmap singularize . Map.maxViewWithKey
+      where singularize ((k, v), rest) = (rest, Map.singleton k v)
+
+instance FactorialMonoid (IntMap.IntMap a) where
+   splitPrimePrefix = fmap singularize . IntMap.minViewWithKey
+      where singularize ((k, v), rest) = (IntMap.singleton k v, rest)
+   splitPrimeSuffix = fmap singularize . IntMap.maxViewWithKey
+      where singularize ((k, v), rest) = (rest, IntMap.singleton k v)
+
+instance FactorialMonoid IntSet.IntSet where
+   splitPrimePrefix = fmap singularize . IntSet.minView
+      where singularize (min, rest) = (IntSet.singleton min, rest)
+   splitPrimeSuffix = fmap singularize . IntSet.maxView
+      where singularize (max, rest) = (rest, IntSet.singleton max)
+
+instance FactorialMonoid (Sequence.Seq a) where
+   splitPrimePrefix q = case Sequence.viewl q
+                        of Sequence.EmptyL -> Nothing
+                           hd Sequence.:< rest -> Just (Sequence.singleton hd, rest)
+   splitPrimeSuffix q = case Sequence.viewr q
+                        of Sequence.EmptyR -> Nothing
+                           rest Sequence.:> last -> Just (rest, Sequence.singleton last)
+   inits = Foldable.toList . Sequence.inits
+   tails = Foldable.toList . Sequence.tails
+   span f = Sequence.spanl (f . Sequence.singleton)
+   break f = Sequence.breakl (f . Sequence.singleton)
+   dropWhile f = Sequence.dropWhileL (f . Sequence.singleton)
+   takeWhile f = Sequence.takeWhileL (f . Sequence.singleton)
+   spanMaybe s0 f b = case Foldable.foldr g id b (0, s0)
+                      of (i, s') | (prefix, suffix) <- Sequence.splitAt i b -> (prefix, suffix, s')
+      where g x cont (i, s) | Just s' <- f s (Sequence.singleton x) = let i' = succ i :: Int in seq i' $ cont (i', s')
+                            | otherwise = (i, s)
+   spanMaybe' s0 f b = case Foldable.foldr g id b (0, s0)
+                       of (i, s') | (prefix, suffix) <- Sequence.splitAt i b -> (prefix, suffix, s')
+      where g x cont (i, s) | Just s' <- f s (Sequence.singleton x) = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')
+                            | otherwise = (i, s)
+   splitAt = Sequence.splitAt
+   drop = Sequence.drop
+   take = Sequence.take
+
+instance Ord a => FactorialMonoid (Set.Set a) where
+   splitPrimePrefix = fmap singularize . Set.minView
+      where singularize (min, rest) = (Set.singleton min, rest)
+   splitPrimeSuffix = fmap singularize . Set.maxView
+      where singularize (max, rest) = (rest, Set.singleton max)
+
+instance FactorialMonoid (Vector.Vector a) where
+   splitPrimePrefix x = if Vector.null x then Nothing else Just (Vector.splitAt 1 x)
+   splitPrimeSuffix x = if Vector.null x then Nothing else Just (Vector.splitAt (Vector.length x - 1) x)
+   inits x0 = initsWith x0 []
+      where initsWith x rest | Vector.null x = x:rest
+                             | otherwise = initsWith (Vector.unsafeInit x) (x:rest)
+   tails x = x : if Vector.null x then [] else tails (Vector.unsafeTail x)
+   break f = Vector.break (f . Vector.singleton)
+   span f = Vector.span (f . Vector.singleton)
+   dropWhile f = Vector.dropWhile (f . Vector.singleton)
+   takeWhile f = Vector.takeWhile (f . Vector.singleton)
+   spanMaybe s0 f v = case Vector.ifoldr g Left v s0
+                      of Left s' -> (v, Vector.empty, s')
+                         Right (i, s') | (prefix, suffix) <- Vector.splitAt i v -> (prefix, suffix, s')
+      where g i x cont s | Just s' <- f s (Vector.singleton x) = cont s'
+                         | otherwise = Right (i, s)
+   spanMaybe' s0 f v = case Vector.ifoldr' g Left v s0
+                       of Left s' -> (v, Vector.empty, s')
+                          Right (i, s') | (prefix, suffix) <- Vector.splitAt i v -> (prefix, suffix, s')
+      where g i x cont s | Just s' <- f s (Vector.singleton x) = seq s' (cont s')
+                         | otherwise = Right (i, s)
+   splitAt = Vector.splitAt
+   drop = Vector.drop
+   take = Vector.take
diff --git a/src/Data/Monoid/GCD.hs b/src/Data/Monoid/GCD.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/GCD.hs
@@ -0,0 +1,433 @@
+{- 
+    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 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.Internal as Internal
+import qualified Data.Text.Internal.Lazy as LazyInternal
+import           Data.Text.Unsafe (lengthWord16, reverseIter)
+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 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 x y = p
+      where (p, _, _) = stripCommonPrefix x y
+   stripCommonPrefix x y = (p, x', y')
+      where p = commonPrefix x y
+            Just x' = stripPrefix p x
+            Just y' = stripPrefix p 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 x y = s
+      where (_, _, s) = stripCommonSuffix x y
+   stripCommonSuffix x y = (x', y', s)
+      where s = commonSuffix x y
+            Just x' = stripSuffix s x
+            Just y' = stripSuffix s y
+   {-# MINIMAL commonSuffix | stripCommonSuffix #-}
+
+-- Unit instances
+
+-- | /O(1)/
+instance GCDMonoid () where
+   gcd () () = ()
+
+-- | /O(1)/
+instance LeftGCDMonoid () where
+   commonPrefix () () = ()
+
+-- | /O(1)/
+instance RightGCDMonoid () where
+   commonSuffix () () = ()
+
+-- Dual instances
+
+instance GCDMonoid a => GCDMonoid (Dual a) where
+   gcd (Dual a) (Dual b) = Dual (gcd a b)
+
+instance LeftGCDMonoid a => RightGCDMonoid (Dual a) where
+   commonSuffix (Dual a) (Dual b) = Dual (commonPrefix a b)
+
+instance RightGCDMonoid a => LeftGCDMonoid (Dual a) where
+   commonPrefix (Dual a) (Dual b) = Dual (commonSuffix a b)
+
+-- Sum instances
+
+-- | /O(1)/
+instance GCDMonoid (Sum Natural) where
+   gcd (Sum a) (Sum b) = Sum (min a b)
+
+-- | /O(1)/
+instance LeftGCDMonoid (Sum Natural) where
+   commonPrefix a b = gcd a b
+
+-- | /O(1)/
+instance RightGCDMonoid (Sum Natural) where
+   commonSuffix a b = gcd a b
+
+-- Product instances
+
+-- | /O(1)/
+instance GCDMonoid (Product Natural) where
+   gcd (Product a) (Product b) = Product (Prelude.gcd a b)
+
+-- | /O(1)/
+instance LeftGCDMonoid (Product Natural) where
+   commonPrefix a b = gcd a b
+
+-- | /O(1)/
+instance RightGCDMonoid (Product Natural) where
+   commonSuffix a b = gcd a b
+
+-- Pair instances
+
+instance (GCDMonoid a, GCDMonoid b) => GCDMonoid (a, b) where
+   gcd (a, b) (c, d) = (gcd a c, gcd b d)
+
+instance (LeftGCDMonoid a, LeftGCDMonoid b) => LeftGCDMonoid (a, b) where
+   commonPrefix (a, b) (c, d) = (commonPrefix a c, commonPrefix b d)
+
+instance (RightGCDMonoid a, RightGCDMonoid b) => RightGCDMonoid (a, b) where
+   commonSuffix (a, b) (c, d) = (commonSuffix a c, commonSuffix b d)
+
+-- Triple instances
+
+instance (GCDMonoid a, GCDMonoid b, GCDMonoid c) => GCDMonoid (a, b, c) where
+   gcd (a1, b1, c1) (a2, b2, c2) = (gcd a1 a2, gcd b1 b2, gcd c1 c2)
+
+instance (LeftGCDMonoid a, LeftGCDMonoid b, LeftGCDMonoid c) => LeftGCDMonoid (a, b, c) where
+   commonPrefix (a1, b1, c1) (a2, b2, c2) = (commonPrefix a1 a2, commonPrefix b1 b2, commonPrefix c1 c2)
+
+instance (RightGCDMonoid a, RightGCDMonoid b, RightGCDMonoid c) => RightGCDMonoid (a, b, c) where
+   commonSuffix (a1, b1, c1) (a2, b2, c2) = (commonSuffix a1 a2, commonSuffix b1 b2, commonSuffix c1 c2)
+
+-- Quadruple instances
+
+instance (GCDMonoid a, GCDMonoid b, GCDMonoid c, GCDMonoid d) => GCDMonoid (a, b, c, d) where
+   gcd (a1, b1, c1, d1) (a2, b2, c2, d2) = (gcd a1 a2, gcd b1 b2, gcd c1 c2, gcd d1 d2)
+
+instance (LeftGCDMonoid a, LeftGCDMonoid b, LeftGCDMonoid c, LeftGCDMonoid d) => LeftGCDMonoid (a, b, c, d) where
+   commonPrefix (a1, b1, c1, d1) (a2, b2, c2, d2) =
+      (commonPrefix a1 a2, commonPrefix b1 b2, commonPrefix c1 c2, commonPrefix d1 d2)
+
+instance (RightGCDMonoid a, RightGCDMonoid b, RightGCDMonoid c, RightGCDMonoid d) => RightGCDMonoid (a, b, c, d) where
+   commonSuffix (a1, b1, c1, d1) (a2, b2, c2, d2) =
+      (commonSuffix a1 a2, commonSuffix b1 b2, commonSuffix c1 c2, commonSuffix d1 d2)
+
+-- Maybe instances
+
+instance LeftGCDMonoid x => LeftGCDMonoid (Maybe x) where
+   commonPrefix (Just x) (Just y) = Just (commonPrefix x y)
+   commonPrefix _ _ = Nothing
+
+   stripCommonPrefix (Just x) (Just y) = (Just p, Just x', Just y')
+      where (p, x', y') = stripCommonPrefix x y
+   stripCommonPrefix x y = (Nothing, x, y)
+
+instance RightGCDMonoid x => RightGCDMonoid (Maybe x) where
+   commonSuffix (Just x) (Just y) = Just (commonSuffix x y)
+   commonSuffix _ _ = Nothing
+
+   stripCommonSuffix (Just x) (Just y) = (Just x', Just y', Just s)
+      where (x', y', s) = stripCommonSuffix x y
+   stripCommonSuffix x y = (x, y, Nothing)
+
+-- Set instances
+
+-- | /O(m*log(n\/m + 1)), m <= n/
+instance Ord a => LeftGCDMonoid (Set.Set a) where
+   commonPrefix = Set.intersection
+
+-- | /O(m*log(n\/m + 1)), m <= n/
+instance Ord a => RightGCDMonoid (Set.Set a) where
+   commonSuffix = Set.intersection
+
+-- | /O(m*log(n\/m + 1)), m <= n/
+instance Ord a => GCDMonoid (Set.Set a) where
+   gcd = Set.intersection
+
+-- IntSet instances
+
+-- | /O(m+n)/
+instance LeftGCDMonoid IntSet.IntSet where
+   commonPrefix = IntSet.intersection
+
+-- | /O(m+n)/
+instance RightGCDMonoid IntSet.IntSet where
+   commonSuffix = IntSet.intersection
+
+-- | /O(m+n)/
+instance GCDMonoid IntSet.IntSet where
+   gcd = IntSet.intersection
+
+-- Map instances
+
+-- | /O(m+n)/
+instance (Ord k, Eq a) => LeftGCDMonoid (Map.Map k a) where
+   commonPrefix = Map.mergeWithKey (\_ a b -> if a == b then Just a else Nothing) (const Map.empty) (const Map.empty)
+
+-- IntMap instances
+
+-- | /O(m+n)/
+instance Eq a => LeftGCDMonoid (IntMap.IntMap a) where
+   commonPrefix = IntMap.mergeWithKey (\_ a b -> if a == b then Just a else Nothing)
+                                       (const IntMap.empty) (const IntMap.empty)
+
+-- List instances
+
+-- | /O(prefixLength)/
+instance Eq x => LeftGCDMonoid [x] where
+   commonPrefix (x:xs) (y:ys) | x == y = x : commonPrefix xs ys
+   commonPrefix _ _ = []
+
+   stripCommonPrefix x0 y0 = strip' id x0 y0
+      where strip' f (x:xs) (y:ys) | x == y = strip' (f . (x :)) xs ys
+            strip' f x y = (f [], x, y)
+
+-- | @since 1.0
+-- /O(m+n)/
+instance Eq x => RightGCDMonoid [x] where
+   stripCommonSuffix x0 y0 = go1 x0 y0
+      where go1 (_:xs) (_:ys) = go1 xs ys
+            go1 [] [] = go2 id id id x0 y0
+            go1 [] ys = go2 id yp id x0 yr
+               where (yp, yr) = splitAtLengthOf id ys y0
+            go1 xs [] = go2 xp id id xr y0
+               where (xp, xr) = splitAtLengthOf id xs x0
+            go2 xp yp cs [] [] = (xp [], yp [], cs [])
+            go2 xp yp cs (x:xs) (y:ys)
+               | x == y = go2 xp yp (cs . (x:)) xs ys
+               | otherwise = go2 (xp . cs . (x:)) (yp . cs . (y:)) id xs ys
+            go2 _ _ _ _ _ = error "impossible"
+            splitAtLengthOf yp (_:xs) (y:ys) = splitAtLengthOf (yp . (y:)) xs ys
+            splitAtLengthOf yp [] ys = (yp, ys)
+            splitAtLengthOf _ _ _ = error "impossible"
+
+-- Seq instances
+
+-- | /O(prefixLength)/
+instance Eq a => LeftGCDMonoid (Sequence.Seq a) where
+   stripCommonPrefix = findCommonPrefix Sequence.empty
+      where findCommonPrefix prefix a b = case (Sequence.viewl a, Sequence.viewl b)
+                                          of (a1:<a', b1:<b') | a1 == b1 -> findCommonPrefix (prefix |> a1) a' b'
+                                             _ -> (prefix, a, b)
+
+-- | /O(suffixLength)/
+instance Eq a => RightGCDMonoid (Sequence.Seq a) where
+   stripCommonSuffix = findCommonSuffix Sequence.empty
+      where findCommonSuffix suffix a b = case (Sequence.viewr a, Sequence.viewr b)
+                                          of (a':>a1, b':>b1) | a1 == b1 -> findCommonSuffix (a1 <| suffix) a' b'
+                                             _ -> (a, b, suffix)
+
+-- Vector instances
+
+-- | /O(prefixLength)/
+instance Eq a => LeftGCDMonoid (Vector.Vector a) where
+   stripCommonPrefix x y = (xp, xs, Vector.drop maxPrefixLength y)
+      where maxPrefixLength = prefixLength 0 (Vector.length x `min` Vector.length y)
+            prefixLength n len | n < len && x Vector.! n == y Vector.! n = prefixLength (succ n) len
+            prefixLength n _ = n
+            (xp, xs) = Vector.splitAt maxPrefixLength x
+
+-- | /O(suffixLength)/
+instance Eq a => RightGCDMonoid (Vector.Vector a) where
+   stripCommonSuffix x y = findSuffix (Vector.length x - 1) (Vector.length y - 1)
+      where findSuffix m n | m >= 0 && n >= 0 && x Vector.! m == y Vector.! n =
+               findSuffix (pred m) (pred n)
+            findSuffix m n = (Vector.take (succ m) x, yp, ys)
+               where (yp, ys) = Vector.splitAt (succ n) y
+
+-- ByteString instances
+
+-- | /O(prefixLength)/
+instance LeftGCDMonoid ByteString.ByteString where
+   stripCommonPrefix x y = (xp, xs, ByteString.unsafeDrop maxPrefixLength y)
+      where maxPrefixLength = prefixLength 0 (ByteString.length x `min` ByteString.length y)
+            prefixLength n len | n < len,
+                                 ByteString.unsafeIndex x n == ByteString.unsafeIndex y n =
+                                    prefixLength (succ n) len
+                               | otherwise = n
+            (xp, xs) = ByteString.splitAt maxPrefixLength x
+
+-- | /O(suffixLength)/
+instance RightGCDMonoid ByteString.ByteString where
+   stripCommonSuffix x y = findSuffix (ByteString.length x - 1) (ByteString.length y - 1)
+      where findSuffix m n | m >= 0, n >= 0,
+                             ByteString.unsafeIndex x m == ByteString.unsafeIndex y n =
+                                findSuffix (pred m) (pred n)
+                           | otherwise = let (yp, ys) = ByteString.splitAt (succ n) y
+                                         in (ByteString.unsafeTake (succ m) x, yp, ys)
+
+-- Lazy ByteString instances
+
+-- | /O(prefixLength)/
+instance LeftGCDMonoid LazyByteString.ByteString where
+   stripCommonPrefix x y = (xp, xs, LazyByteString.drop maxPrefixLength y)
+      where maxPrefixLength = prefixLength 0 (LazyByteString.length x `min` LazyByteString.length y)
+            prefixLength n len | n < len && LazyByteString.index x n == LazyByteString.index y n =
+               prefixLength (succ n) len
+            prefixLength n _ = n
+            (xp, xs) = LazyByteString.splitAt maxPrefixLength x
+
+-- | /O(suffixLength)/
+instance RightGCDMonoid LazyByteString.ByteString where
+   stripCommonSuffix x y = findSuffix (LazyByteString.length x - 1) (LazyByteString.length y - 1)
+      where findSuffix m n | m >= 0 && n >= 0 && LazyByteString.index x m == LazyByteString.index y n =
+               findSuffix (pred m) (pred n)
+            findSuffix m n = (LazyByteString.take (succ m) x, yp, ys)
+               where (yp, ys) = LazyByteString.splitAt (succ n) y
+
+-- Text instances
+
+-- | /O(prefixLength)/
+instance LeftGCDMonoid Text.Text where
+   stripCommonPrefix x y = maybe (Text.empty, x, y) id (Text.commonPrefixes x y)
+
+-- | @since 1.0
+-- /O(suffixLength)/
+instance RightGCDMonoid Text.Text where
+   stripCommonSuffix x@(Internal.Text xarr xoff xlen) y@(Internal.Text yarr yoff ylen) = go (pred xlen) (pred ylen)
+      where go i j | i >= 0 && j >= 0 && xc == yc = go (i+xd) (j+yd)
+                   | otherwise = (Internal.text xarr xoff (succ i),
+                                  Internal.text yarr yoff (succ j),
+                                  Internal.text xarr (xoff+i+1) (xlen-i-1))
+               where (xc, xd) = reverseIter x i
+                     (yc, yd) = reverseIter y j
+
+-- Lazy Text instances
+
+-- | /O(prefixLength)/
+instance LeftGCDMonoid LazyText.Text where
+   stripCommonPrefix x y = maybe (LazyText.empty, x, y) id (LazyText.commonPrefixes x y)
+
+-- | @since 1.0
+-- /O(m+n)/
+instance RightGCDMonoid LazyText.Text where
+   stripCommonSuffix x0 y0
+      | x0len < y0len = go id y0p id x0 y0s
+      | x0len > y0len = go x0p id id x0s y0
+      | otherwise = go id id id x0 y0
+      where (y0p, y0s) = splitWord16 id (y0len - x0len) y0
+            (x0p, x0s) = splitWord16 id (x0len - y0len) x0
+            x0len = lazyLengthWord16 x0
+            y0len = lazyLengthWord16 y0
+            lazyLengthWord16 = LazyText.foldlChunks addLength 0
+            addLength n x = n + lengthWord16 x
+            splitWord16 xp 0 x = (xp, x)
+            splitWord16 xp n (LazyInternal.Chunk x@(Internal.Text arr off len) xs)
+               | n < len = (xp . LazyInternal.chunk (Internal.Text arr off n),
+                            LazyInternal.chunk (Internal.Text arr (off+n) (len-n)) xs)
+               | otherwise = splitWord16 (xp . LazyInternal.chunk x) (n - len) xs
+            splitWord16 _ _ LazyInternal.Empty = error "impossible"
+            go xp yp cs LazyInternal.Empty LazyInternal.Empty = (xp mempty, yp mempty, cs mempty)
+            go xp yp cs (LazyInternal.Chunk x@(Internal.Text xarr xoff xlen) xs)
+                        (LazyInternal.Chunk y@(Internal.Text yarr yoff ylen) ys)
+               | xlen < ylen = go xp yp cs (LazyInternal.Chunk x xs)
+                                           (LazyInternal.Chunk (Internal.Text yarr yoff xlen) $
+                                            LazyInternal.Chunk (Internal.Text yarr (yoff+xlen) (ylen-xlen)) ys)
+               | xlen > ylen = go xp yp cs (LazyInternal.Chunk (Internal.Text xarr xoff ylen) $
+                                            LazyInternal.Chunk (Internal.Text xarr (xoff+ylen) (xlen-ylen)) xs)
+                                           (LazyInternal.Chunk y ys)
+               | x == y = go xp yp (cs . LazyInternal.chunk x) xs ys
+               | (x1p, y1p, c1s) <- stripCommonSuffix x y =
+                    go (xp . cs . LazyInternal.chunk x1p) (yp . cs . LazyInternal.chunk y1p) (LazyInternal.chunk c1s) xs ys
+            go _ _ _ _ _ = error "impossible"
diff --git a/src/Data/Monoid/Instances/ByteString/UTF8.hs b/src/Data/Monoid/Instances/ByteString/UTF8.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Instances/ByteString/UTF8.hs
@@ -0,0 +1,507 @@
+{- 
+    Copyright 2013-2019 Mario Blazevic
+
+    License: BSD3 (see BSD3-LICENSE.txt file)
+-}
+
+-- | This module defines the 'ByteStringUTF8' newtype wrapper around 'ByteString', together with its 'TextualMonoid'
+-- instance. The 'FactorialMonoid' instance of a wrapped 'ByteStringUTF8' value differs from the original 'ByteString':
+-- the prime 'factors' of the original value are its bytes, and for the wrapped value the prime 'factors' are its valid
+-- UTF8 byte sequences. The following example session demonstrates the relationship:
+-- 
+-- >> let utf8@(ByteStringUTF8 bs) = fromString "E=mc\xb2"
+-- >> bs
+-- >"E=mc\194\178"
+-- >> factors bs
+-- >["E","=","m","c","\194","\178"]
+-- >> utf8
+-- >"E=mc²"
+-- >> factors utf8
+-- >["E","=","m","c","²"]
+--
+-- The 'TextualMonoid' instance follows the same logic, but it also decodes all valid UTF8 sequences into
+-- characters. Any invalid UTF8 byte sequence from the original 'ByteString' is preserved as a single prime factor:
+--
+-- >> let utf8'@(ByteStringUTF8 bs') = ByteStringUTF8 (Data.ByteString.map pred bs)
+-- >> bs'
+-- >"D<lb\193\177"
+-- >> factors bs'
+-- >["D","<","l","b","\193","\177"]
+-- >> utf8'
+-- >"D<lb\[193,177]"
+-- >> factors utf8'
+-- >["D","<","l","b","\[193,177]"]
+
+{-# LANGUAGE Haskell2010 #-}
+
+module Data.Monoid.Instances.ByteString.UTF8 (
+   ByteStringUTF8(..), decode
+   )
+where
+
+import Control.Exception (assert)
+import Data.Bits ((.&.), (.|.), shiftL, shiftR)
+import Data.Char (chr, ord, isDigit, isPrint)
+import qualified Data.Foldable as Foldable
+import qualified Data.List as List
+import Data.Maybe (fromMaybe, isJust, isNothing)
+import Data.String (IsString(fromString))
+import Data.Word (Word8)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as ByteString
+import qualified Data.ByteString.Char8 as ByteString.Char8
+import Data.ByteString.Internal (w2c)
+import Data.ByteString.Unsafe (unsafeDrop, unsafeHead, unsafeTail, unsafeTake, unsafeIndex)
+
+import Data.Semigroup (Semigroup(..))
+import Data.Monoid (Monoid(..))
+import Data.Semigroup.Cancellative (LeftReductive(..), LeftCancellative)
+import Data.Semigroup.Factorial (Factorial(..))
+import Data.Monoid.GCD (LeftGCDMonoid(..))
+import Data.Monoid.Null (MonoidNull(..), PositiveMonoid)
+import Data.Monoid.Factorial (FactorialMonoid(..))
+import Data.Monoid.Textual (TextualMonoid(..))
+import qualified Data.Monoid.Factorial as Factorial (FactorialMonoid(..))
+import qualified Data.Monoid.Textual as Textual (TextualMonoid(..))
+
+import Prelude hiding (any, drop, dropWhile, foldl, foldl1, foldr, foldr1, scanl, scanr, scanl1, scanr1,
+                       map, concatMap, break, span)
+
+newtype ByteStringUTF8 = ByteStringUTF8 ByteString deriving (Eq, Ord)
+
+-- | Takes a raw 'ByteString' chunk and returns a pair of 'ByteStringUTF8' decoding the prefix of the chunk and the
+-- remaining suffix that is either null or contains the incomplete last character of the chunk.
+decode :: ByteString -> (ByteStringUTF8, ByteString)
+decode bs
+   | ByteString.null bs || l < 0x80 = (ByteStringUTF8 bs, mempty)
+   | l >= 0xC0 = (ByteStringUTF8 (ByteString.init bs), ByteString.singleton l)
+   | ByteString.null prefix = (mempty, bs)
+   | otherwise =
+      case toChar (ByteString.last prefix) suffix
+      of Nothing -> (ByteStringUTF8 (ByteString.init prefix), drop (ByteString.length prefix - 1) bs)
+         Just{} -> (ByteStringUTF8 bs, mempty)
+   where (prefix, suffix) = ByteString.breakEnd byteStartsCharacter bs
+         l = ByteString.last bs
+
+-- | O(n)
+instance Semigroup ByteStringUTF8 where
+   ByteStringUTF8 a <> ByteStringUTF8 b = ByteStringUTF8 (a <> b)
+   {-# INLINE (<>) #-}
+
+-- | O(n)
+instance Monoid ByteStringUTF8 where
+   mempty = ByteStringUTF8 ByteString.empty
+   {-# INLINE mempty #-}
+   ByteStringUTF8 a `mappend` ByteStringUTF8 b = ByteStringUTF8 (a `mappend` b)
+   {-# INLINE mappend #-}
+
+-- | O(1)
+instance MonoidNull ByteStringUTF8 where
+   null (ByteStringUTF8 b) = ByteString.null b
+   {-# INLINE null #-}
+
+-- | O(n)
+instance LeftReductive ByteStringUTF8 where
+   stripPrefix (ByteStringUTF8 a) (ByteStringUTF8 b) = fmap ByteStringUTF8 (stripPrefix a b)
+   {-# INLINE stripPrefix #-}
+   ByteStringUTF8 a `isPrefixOf` ByteStringUTF8 b = a `isPrefixOf` b
+   {-# INLINE isPrefixOf #-}
+
+instance LeftCancellative ByteStringUTF8
+
+-- | O(prefixLength)
+instance LeftGCDMonoid ByteStringUTF8 where
+   commonPrefix (ByteStringUTF8 a) (ByteStringUTF8 b) = ByteStringUTF8 (commonPrefix a b)
+   {-# INLINE commonPrefix #-}
+   stripCommonPrefix (ByteStringUTF8 a) (ByteStringUTF8 b) = wrapTriple (stripCommonPrefix a b)
+   {-# INLINE stripCommonPrefix #-}
+
+instance Show ByteStringUTF8 where
+   showsPrec _ bs s0 = '"' : Textual.foldr showsBytes showsChar ('"' : s0) bs
+      where showsBytes (ByteStringUTF8 b) s = '\\' : shows (ByteString.unpack b) s
+            showsChar c s
+              | isPrint c = c : s
+              | h:_ <- s, isDigit h = "\\" ++ show (ord c) ++ "\\&" ++ s
+              | otherwise = "\\" ++ show (ord c) ++ s
+
+instance IsString ByteStringUTF8 where
+   fromString = ByteStringUTF8 . Foldable.foldMap fromChar
+   {-# INLINE fromString #-}
+
+instance PositiveMonoid ByteStringUTF8
+
+instance Factorial ByteStringUTF8 where
+   primePrefix utf8@(ByteStringUTF8 bs)
+      | ByteString.null bs = utf8
+      | unsafeHead bs < 0x80 = ByteStringUTF8 (ByteString.take 1 bs)
+      | otherwise = case ByteString.findIndex byteStartsCharacter (unsafeTail bs)
+                    of Just i -> ByteStringUTF8 (ByteString.take (succ i) bs)
+                       Nothing -> utf8
+   {-# INLINABLE primePrefix #-}
+   factors (ByteStringUTF8 bs) = List.map ByteStringUTF8 $ ByteString.groupBy continued bs
+      where continued a b = a >= 0x80 && b >= 0x80 && b < 0xC0
+   {-# INLINABLE factors #-}
+   length (ByteStringUTF8 bs) = fst (ByteString.foldl' count (0, False) bs)
+      where count (n, high) byte | byte < 0x80 = (succ n, False)
+                                 | byte < 0xC0 = (if high then n else succ n, True)
+                                 | otherwise = (succ n, True)
+   {-# INLINABLE length #-}
+   foldl f a0 (ByteStringUTF8 bs) = List.foldl f' a0 (groupASCII bs)
+      where f' a b | unsafeHead b < 0x80 = ByteString.foldl f'' a b
+                   | otherwise = f a (ByteStringUTF8 b)
+            f'' a w = f a (ByteStringUTF8 $ ByteString.singleton w)
+   {-# INLINABLE foldl #-}
+   foldl' f a0 (ByteStringUTF8 bs) = List.foldl' f' a0 (groupASCII bs)
+      where f' a b | unsafeHead b < 0x80 = ByteString.foldl' f'' a b
+                   | otherwise = f a (ByteStringUTF8 b)
+            f'' a w = f a (ByteStringUTF8 $ ByteString.singleton w)
+   {-# INLINABLE foldl' #-}
+   foldr f a0 (ByteStringUTF8 bs) = List.foldr f' a0 (groupASCII bs)
+      where f' b a | unsafeHead b < 0x80 = ByteString.foldr f'' a b
+                   | otherwise = f (ByteStringUTF8 b) a
+            f'' w a = f (ByteStringUTF8 $ ByteString.singleton w) a
+   {-# INLINABLE foldr #-}
+   reverse (ByteStringUTF8 bs) =
+      ByteStringUTF8 (ByteString.concat $ List.reverse $ List.map reverseASCII $ groupASCII bs)
+      where reverseASCII b | unsafeHead b < 0x80 = ByteString.reverse b
+                           | otherwise = b
+   {-# INLINABLE reverse #-}
+
+instance FactorialMonoid ByteStringUTF8 where
+   splitPrimePrefix utf8@(ByteStringUTF8 bs)
+      | ByteString.null bs = Nothing
+      | unsafeHead bs < 0x80 = Just (wrapPair $ ByteString.splitAt 1 bs)
+      | otherwise = case ByteString.findIndex byteStartsCharacter (unsafeTail bs)
+                    of Just i -> Just (wrapPair $ ByteString.splitAt (succ i) bs)
+                       Nothing -> Just (utf8, ByteStringUTF8 $ ByteString.empty)
+   {-# INLINABLE splitPrimePrefix #-}
+   splitPrimeSuffix (ByteStringUTF8 bs)
+      | ByteString.null bs = Nothing
+      | ByteString.null prefix = Just (wrapPair splitBS)
+      | not (ByteString.null suffix) && ByteString.last prefix < 0x80 = Just (wrapPair splitBS)
+      | otherwise = Just (wrapPair $ ByteString.splitAt (pred $ ByteString.length prefix) bs)
+      where splitBS@(prefix, suffix) = ByteString.breakEnd byteStartsCharacter bs
+   {-# INLINABLE splitPrimeSuffix #-}
+   splitAt n (ByteStringUTF8 bs) = wrapPair (ByteString.splitAt (charStartIndex n bs) bs)
+   {-# INLINE splitAt #-}
+   take n (ByteStringUTF8 bs) = ByteStringUTF8 (ByteString.take (charStartIndex n bs) bs)
+   {-# INLINE take #-}
+   drop n (ByteStringUTF8 bs) = ByteStringUTF8 (ByteString.drop (charStartIndex n bs) bs)
+   {-# INLINE drop #-}
+   dropWhile p (ByteStringUTF8 bs0) = dropASCII bs0
+      where dropASCII bs =
+               let suffix = ByteString.dropWhile (\w-> w < 0x80 && p (ByteStringUTF8 $ ByteString.singleton w)) bs
+               in if ByteString.null suffix || unsafeHead suffix < 0x80
+                  then ByteStringUTF8 suffix
+                  else dropMultiByte suffix
+            dropMultiByte bs =
+               let utf8 = ByteStringUTF8 bs
+               in case ByteString.findIndex byteStartsCharacter (unsafeTail bs)
+                  of Nothing -> if p utf8 then ByteStringUTF8 ByteString.empty else utf8
+                     Just i -> let (hd, tl) = ByteString.splitAt (succ i) bs
+                               in if p (ByteStringUTF8 hd)
+                                  then dropASCII tl
+                                  else utf8
+   {-# INLINE dropWhile #-}
+   takeWhile p utf8@(ByteStringUTF8 bs) =
+      ByteStringUTF8 $ ByteString.take (ByteString.length bs - ByteString.length s) bs
+      where (ByteStringUTF8 s) = Factorial.dropWhile p utf8
+   {-# INLINE takeWhile #-}
+   span p utf8@(ByteStringUTF8 bs) =
+      (ByteStringUTF8 $ ByteString.take (ByteString.length bs - ByteString.length s) bs, suffix)
+      where suffix@(ByteStringUTF8 s) = Factorial.dropWhile p utf8
+   {-# INLINE span #-}
+   break p = Factorial.span (not . p)
+   {-# INLINE break #-}
+   spanMaybe s0 f (ByteStringUTF8 bs0) = (ByteStringUTF8 $ ByteString.take (ByteString.length bs0 - ByteString.length dropped) bs0,
+                                          ByteStringUTF8 dropped,
+                                          s')
+      where (dropped, s') = dropASCII s0 bs0
+            dropASCII s bs =
+               let suffix = ByteString.drop index bs
+                   (index, s1) = ByteString.foldr f8 id bs (0, s)
+                   f8 w cont (i, s2)
+                     | w < 0x80, Just s3 <- f s2 (ByteStringUTF8 $ ByteString.singleton w) =
+                         let i' = succ i :: Int in seq i' $ cont (i', s3)
+                     | otherwise = (i, s2)
+               in if ByteString.null suffix || unsafeHead suffix < 0x80
+                  then (suffix, s1)
+                  else dropMultiByte s1 suffix
+            dropMultiByte s bs =
+               case ByteString.findIndex byteStartsCharacter (unsafeTail bs)
+               of Nothing -> case f s (ByteStringUTF8 bs)
+                             of Just s1 -> (ByteString.empty, s1)
+                                Nothing -> (bs, s)
+                  Just i -> let (hd, tl) = ByteString.splitAt (succ i) bs
+                            in case f s (ByteStringUTF8 hd)
+                               of Just s1 -> dropASCII s1 tl
+                                  Nothing -> (bs, s)
+   {-# INLINE spanMaybe #-}
+   spanMaybe' s0 f (ByteStringUTF8 bs0) = (ByteStringUTF8 $
+                                           ByteString.take (ByteString.length bs0 - ByteString.length dropped) bs0,
+                                           ByteStringUTF8 dropped,
+                                           s')
+      where (dropped, s') = dropASCII s0 bs0
+            dropASCII s bs =
+               let suffix = ByteString.drop index bs
+                   (index, s1) = ByteString.foldr f8 id bs (0, s)
+                   f8 w cont (i, s2)
+                     | w < 0x80, Just s3 <- f s2 (ByteStringUTF8 $ ByteString.singleton w) =
+                         let i' = succ i :: Int in seq i' $ seq s3 $ cont (i', s3)
+                     | otherwise = (i, s)
+               in if ByteString.null suffix || unsafeHead suffix < 0x80
+                  then (suffix, s1)
+                  else dropMultiByte s1 suffix
+            dropMultiByte s bs =
+               case ByteString.findIndex byteStartsCharacter (unsafeTail bs)
+               of Nothing -> case f s (ByteStringUTF8 bs)
+                             of Just s1 -> seq s1 (ByteString.empty, s1)
+                                Nothing -> (bs, s)
+                  Just i -> let (hd, tl) = ByteString.splitAt (succ i) bs
+                            in case f s (ByteStringUTF8 hd)
+                               of Just s1 -> seq s1 (dropASCII s1 tl)
+                                  Nothing -> (bs, s)
+   {-# INLINE spanMaybe' #-}
+
+instance TextualMonoid ByteStringUTF8 where
+   singleton = ByteStringUTF8 . fromChar
+   {-# INLINE singleton #-}
+   splitCharacterPrefix (ByteStringUTF8 bs) = ByteString.uncons bs >>= uncurry toChar
+   {-# INLINE splitCharacterPrefix #-}
+   foldl ft fc a0 (ByteStringUTF8 bs) = case ByteString.Char8.foldl f (a0, []) bs
+                                        of (a, []) -> a
+                                           (a, acc) -> multiByte a acc
+      where f (a, []) c | c < '\x80' = (fc a c, [])
+                        | otherwise = (a, [fromIntegral $ ord c])
+            f (a, acc) c | c < '\x80' = (fc (multiByte a acc) c, [])
+                         | c < '\xC0' = (a, fromIntegral (ord c) : acc)
+                         | otherwise = (multiByte a acc, [fromIntegral $ ord c])
+            multiByte a acc = reverseBytesToChar (ft a . ByteStringUTF8) (fc a) acc
+   {-# INLINE foldl #-}
+   foldl' ft fc a0 (ByteStringUTF8 bs) = case ByteString.Char8.foldl' f (a0, []) bs
+                                         of (a, []) -> a
+                                            (a, acc) -> multiByte a acc
+      where f (a, []) c | c < '\x80' = (fc a c, [])
+                        | otherwise = seq a (a, [fromIntegral $ ord c])
+            f (a, acc) c | seq a c < '\x80' = let a' = multiByte a acc in seq a' (fc a' c, [])
+                         | c < '\xC0' = (a, fromIntegral (ord c) : acc)
+                         | otherwise = let a' = multiByte a acc in seq a' (a', [fromIntegral $ ord c])
+            multiByte a acc = reverseBytesToChar (ft a . ByteStringUTF8) (fc a) acc
+   {-# INLINE foldl' #-}
+   foldr ft fc a0 (ByteStringUTF8 bs) = case ByteString.Char8.foldr f (a0, []) bs
+                                        of (a, []) -> a
+                                           (a, acc) -> multiByte a acc
+      where f c (a, []) | c < '\x80' = (fc c a, [])
+                        | c < '\xC0' = (a, [fromIntegral $ ord c])
+                        | otherwise = (ft (ByteStringUTF8 $ ByteString.Char8.singleton c) a, [])
+            f c (a, acc) | c < '\x80' = (fc c (ft (ByteStringUTF8 $ ByteString.pack acc) a), [])
+                         | c < '\xC0' = (a, fromIntegral (ord c) : acc)
+                         | otherwise = (multiByte a (fromIntegral (ord c) : acc), [])
+            multiByte a acc = bytesToChar ((`ft` a) . ByteStringUTF8) (`fc` a) acc
+   {-# INLINE foldr #-}
+   dropWhile pb pc (ByteStringUTF8 bs) = ByteStringUTF8 $ dropASCII bs
+      where dropASCII rest = case ByteString.Char8.findIndex (\c-> c > '\x7f' || not (pc c)) rest
+                             of Nothing -> ByteString.empty
+                                Just j -> let rest' = unsafeDrop j rest
+                                          in if unsafeHead rest' > 0x7f
+                                             then dropMultiByte rest'
+                                             else rest'
+            dropMultiByte rest = case splitCharacterPrefix (ByteStringUTF8 rest)
+                                 of Just (c, ByteStringUTF8 rest') | pc c -> dropASCII rest'
+                                    Nothing -> let j = succ (headIndex $ drop 1 rest)
+                                               in if pb (ByteStringUTF8 $ ByteString.take j rest)
+                                                  then dropASCII (unsafeDrop j rest)
+                                                  else rest
+                                    _ -> rest
+   {-# INLINE dropWhile #-}
+   takeWhile pb pc utf8@(ByteStringUTF8 bs) =
+      ByteStringUTF8 $ unsafeTake (ByteString.length bs - ByteString.length suffix) bs
+      where ByteStringUTF8 suffix = Textual.dropWhile pb pc utf8
+   {-# INLINE takeWhile #-}
+   span pb pc utf8@(ByteStringUTF8 bs) = (ByteStringUTF8 $ unsafeTake (ByteString.length bs - ByteString.length suffix') bs, suffix)
+      where suffix@(ByteStringUTF8 suffix') = Textual.dropWhile pb pc utf8
+   {-# INLINE span #-}
+   break pb pc = Textual.span (not . pb) (not . pc)
+   {-# INLINE break #-}
+   spanMaybe s0 ft fc (ByteStringUTF8 bs)  =
+      let inner i s
+            | i < len =
+                let w = unsafeIndex bs i
+                in if w < 0x80
+                   then case fc s (w2c w)
+                        of Just s' -> inner (i + 1) s'
+                           Nothing -> done i s
+                   else case splitCharacterPrefix (ByteStringUTF8 $ unsafeDrop i bs)
+                        of Just (c, ByteStringUTF8 rest) | Just s' <- fc s c -> inner (len - ByteString.length rest) s'
+                           Nothing -> let j = succ (headIndex $ drop (i + 1) bs)
+                                      in case ft s (ByteStringUTF8 $ ByteString.take j $ unsafeDrop i bs)
+                                         of Just s' -> inner (i + j) s'
+                                            Nothing -> done i s
+                           _ -> done i s
+            | otherwise = done i s
+          done i s = i `seq` s `seq` (ByteStringUTF8 $ unsafeTake i bs, ByteStringUTF8 $ unsafeDrop i bs, s)
+          len = ByteString.length bs
+      in inner 0 s0
+   {-# INLINE spanMaybe #-}
+   spanMaybe' s0 ft fc (ByteStringUTF8 bs)  =
+      let inner i s
+            | i < len =
+                s `seq`
+                let w = unsafeIndex bs i
+                in if w < 0x80
+                   then case fc s (w2c w)
+                        of Just s' -> inner (i + 1) s'
+                           Nothing -> done i s
+                   else case splitCharacterPrefix (ByteStringUTF8 $ unsafeDrop i bs)
+                        of Just (c, ByteStringUTF8 rest) | Just s' <- fc s c -> inner (len - ByteString.length rest) s'
+                           Nothing -> let j = succ (headIndex $ drop (i + 1) bs)
+                                      in case ft s (ByteStringUTF8 $ ByteString.take j $ unsafeDrop i bs)
+                                         of Just s' -> inner (i + j) s'
+                                            Nothing -> done i s
+                           _ -> done i s
+            | otherwise = done i s
+          done i s = i `seq` s `seq` (ByteStringUTF8 $ unsafeTake i bs, ByteStringUTF8 $ unsafeDrop i bs, s)
+          len = ByteString.length bs
+      in inner 0 s0
+   {-# INLINE spanMaybe' #-}
+   find p (ByteStringUTF8 bs0) = loop bs0
+      where loop bs = case ByteString.Char8.findIndex (\c-> c >= '\x80' || p c) bs
+                      of Nothing -> Nothing
+                         Just i -> let x = unsafeIndex bs i
+                                       bs' = unsafeDrop (i + 1) bs
+                                   in if x < 0x80
+                                      then Just (w2c x)
+                                      else case toChar x bs'
+                                           of Just (c, ByteStringUTF8 rest) | p c -> Just c
+                                                                            | otherwise -> loop rest
+                                              Nothing -> loop (ByteString.dropWhile (not . byteStartsCharacter) bs')
+   {-# INLINE find #-}
+   any p utf8 = isJust (find p utf8)
+   {-# INLINE any #-}
+   all p utf8 = isNothing (find (not . p) utf8)
+   {-# INLINE all #-}
+   elem c utf8@(ByteStringUTF8 bs)
+     | c < '\x80' = ByteString.Char8.elem c bs
+     | otherwise = any (== c) utf8
+   {-# INLINE elem #-}
+
+reverseBytesToChar :: (ByteString -> a) -> (Char -> a) -> [Word8] -> a
+reverseBytesToChar ft fc [w] = if w < 0x80 then fc (w2c w) else ft (ByteString.singleton w)
+reverseBytesToChar ft fc [b0, b1] =
+  assert (0x80 <= b0 && b0 < 0xC0) $
+  if 0xC2 <= b1 && b1 < 0xE0
+  then fc (chr (shiftL (fromIntegral b1 .&. 0x1F) 6 .|. fromIntegral b0 .&. 0x3F))
+  else ft (ByteString.pack [b1, b0])
+reverseBytesToChar ft fc [b0, b1, b2] =
+  assert (0x80 <= b0 && b0 < 0xC0 && 0x80 <= b1 && b1 < 0xC0) $
+  if (0xE0 < b2 || 0xE0 == b2 && 0xA0 <= b1) && b2 < 0xF0
+  then fc (chr (shiftL (fromIntegral b2 .&. 0xF) 12
+                .|. shiftL (fromIntegral b1 .&. 0x3F) 6
+                .|. fromIntegral b0 .&. 0x3F))
+  else ft (ByteString.pack [b2, b1, b0])
+reverseBytesToChar ft fc [b0, b1, b2, b3] =
+  assert (0x80 <= b0 && b0 < 0xC0 && 0x80 <= b1 && b1 < 0xC0 && 0x80 <= b2 && b2 < 0xC0) $
+  if (0xF0 < b3 || 0xF0 == b3 && 0x90 <= b2) && b3 < 0xF5 && (b3 < 0xF4 || b2 < 0x90)
+  then fc (chr (shiftL (fromIntegral b3 .&. 0x7) 18
+                .|. shiftL (fromIntegral b2 .&. 0x3F) 12
+                .|. shiftL (fromIntegral b1 .&. 0x3F) 6
+                .|. fromIntegral b0 .&. 0x3F))
+  else ft (ByteString.pack [b3, b2, b1, b0])
+reverseBytesToChar ft _fc bytes = ft (ByteString.reverse $ ByteString.pack bytes)
+
+bytesToChar :: (ByteString -> a) -> (Char -> a) -> [Word8] -> a
+bytesToChar ft fc [w] = if w < 0x80 then fc (w2c w) else ft (ByteString.singleton w)
+bytesToChar ft fc bytes@[b1, b0] =
+  assert (0x80 <= b0 && b0 < 0xC0) $
+  if 0xC2 <= b1 && b1 < 0xE0
+  then fc (chr (shiftL (fromIntegral b1 .&. 0x1F) 6 .|. fromIntegral b0 .&. 0x3F))
+  else ft (ByteString.pack bytes)
+bytesToChar ft fc bytes@[b2, b1, b0] =
+  assert (0x80 <= b0 && b0 < 0xC0 && 0x80 <= b1 && b1 < 0xC0) $
+  if (0xE0 < b2 || 0xE0 == b2 && 0xA0 <= b1) && b2 < 0xF0
+  then fc (chr (shiftL (fromIntegral b2 .&. 0xF) 12
+                .|. shiftL (fromIntegral b1 .&. 0x3F) 6
+                .|. fromIntegral b0 .&. 0x3F))
+  else ft (ByteString.pack bytes)
+bytesToChar ft fc bytes@[b3, b2, b1, b0] =
+  assert (0x80 <= b0 && b0 < 0xC0 && 0x80 <= b1 && b1 < 0xC0 && 0x80 <= b2 && b2 < 0xC0) $
+  if (0xF0 < b3 || 0xF0 == b3 && 0x90 <= b2) && b3 < 0xF5 && (b3 < 0xF4 || b2 < 0x90)
+  then fc (chr (shiftL (fromIntegral b3 .&. 0x7) 18
+                .|. shiftL (fromIntegral b2 .&. 0x3F) 12
+                .|. shiftL (fromIntegral b1 .&. 0x3F) 6
+                .|. fromIntegral b0 .&. 0x3F))
+  else ft (ByteString.pack bytes)
+bytesToChar ft _fc bytes = ft (ByteString.pack bytes)
+
+wrapPair :: (ByteString, ByteString) -> (ByteStringUTF8, ByteStringUTF8)
+wrapPair (bs1, bs2) = (ByteStringUTF8 bs1, ByteStringUTF8 bs2)
+{-# INLINE wrapPair #-}
+
+wrapTriple :: (ByteString, ByteString, ByteString) -> (ByteStringUTF8, ByteStringUTF8, ByteStringUTF8)
+wrapTriple (bs1, bs2, bs3) = (ByteStringUTF8 bs1, ByteStringUTF8 bs2, ByteStringUTF8 bs3)
+{-# INLINE wrapTriple #-}
+
+fromChar :: Char -> ByteString
+fromChar c | c < '\x80'    = ByteString.Char8.singleton c
+           | c < '\x800'   = ByteString.pack [0xC0 + fromIntegral (shiftR n 6),
+                                              0x80 + fromIntegral (n .&. 0x3F)]
+           | c < '\x10000' = ByteString.pack [0xE0 + fromIntegral (shiftR n 12),
+                                              0x80 + fromIntegral (shiftR n 6 .&. 0x3F),
+                                              0x80 + fromIntegral (n .&. 0x3F)]
+           | n < 0x200000  = ByteString.pack [0xF0 + fromIntegral (shiftR n 18),
+                                              0x80 + fromIntegral (shiftR n 12 .&. 0x3F),
+                                              0x80 + fromIntegral (shiftR n 6 .&. 0x3F),
+                                              0x80 + fromIntegral (n .&. 0x3F)]
+           | otherwise  = error ("Data.Char.ord '" ++ (c : "' >=0x200000"))
+   where n = ord c
+
+toChar :: Word8 -> ByteString -> Maybe (Char, ByteStringUTF8)
+toChar hd tl | hd < 0x80 = Just (w2c hd, ByteStringUTF8 tl)
+             | hd < 0xC2 = Nothing
+             | hd < 0xE0 = do (b0, t0) <- ByteString.uncons tl
+                              if headIndex tl == 1
+                                 then return (chr (shiftL (fromIntegral hd .&. 0x1F) 6
+                                                   .|. fromIntegral b0 .&. 0x3F),
+                                              ByteStringUTF8 t0)
+                                 else Nothing
+             | hd < 0xF0 = do (b1, t1) <- ByteString.uncons tl
+                              (b0, t0) <- ByteString.uncons t1
+                              if (hd > 0xE0 || b1 >= 0xA0) && headIndex tl == 2
+                                 then return (chr (shiftL (fromIntegral hd .&. 0xF) 12
+                                                   .|. shiftL (fromIntegral b1 .&. 0x3F) 6
+                                                   .|. fromIntegral b0 .&. 0x3F),
+                                              ByteStringUTF8 t0)
+                                 else Nothing
+             | hd < 0xF5 = do (b2, t2) <- ByteString.uncons tl
+                              (b1, t1) <- ByteString.uncons t2
+                              (b0, t0) <- ByteString.uncons t1
+                              if (hd > 0xF0 || b2 >= 0x90) && (hd < 0xF4 || b2 < 0x90) && headIndex tl == 3
+                                 then return (chr (shiftL (fromIntegral hd .&. 0x7) 18
+                                                   .|. shiftL (fromIntegral b2 .&. 0x3F) 12
+                                                   .|. shiftL (fromIntegral b1 .&. 0x3F) 6
+                                                   .|. fromIntegral b0 .&. 0x3F),
+                                              ByteStringUTF8 t0)
+                                 else Nothing
+             | otherwise = Nothing
+
+groupASCII :: ByteString -> [ByteString]
+groupASCII = ByteString.groupBy continued
+   where continued a b = (a < 0x80) == (b < 0x80) && b < 0xC0
+{-# INLINE groupASCII #-}
+
+headIndex :: ByteString -> Int
+headIndex bs = fromMaybe (ByteString.length bs) $ ByteString.findIndex byteStartsCharacter bs
+{-# INLINE headIndex #-}
+
+byteStartsCharacter :: Word8 -> Bool
+byteStartsCharacter b = b < 0x80 || b >= 0xC0
+{-# INLINE byteStartsCharacter #-}
+
+charStartIndex :: Int -> ByteString -> Int
+charStartIndex n _ | n <= 0 = 0
+charStartIndex n0 bs = ByteString.foldr count (const $ ByteString.length bs) bs (n0, False, 0)
+      where count byte _    (0, high, i) | byte < 0x80 || byte >= 0xC0 || not high = i
+            count byte cont (n, high, i) | byte < 0x80 = cont (pred n, False, succ i)
+                                         | byte < 0xC0 = cont (if high then n else pred n, True, succ i)
+                                         | otherwise = cont (pred n, True, succ i)
+{-# INLINE charStartIndex #-}
diff --git a/src/Data/Monoid/Instances/CharVector.hs b/src/Data/Monoid/Instances/CharVector.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Instances/CharVector.hs
@@ -0,0 +1,90 @@
+{- 
+    Copyright 2017 Mario Blazevic
+
+    License: BSD3 (see BSD3-LICENSE.txt file)
+-}
+
+-- | This module contains orphan 'IsString' and 'TextualMonoid' instances of @Vector Char@.
+-- 
+
+{-# LANGUAGE Haskell2010, FlexibleInstances, Trustworthy #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Data.Monoid.Instances.CharVector where
+
+import Data.String (IsString(fromString))
+import qualified Data.Vector as Vector
+
+import Data.Monoid.Textual (TextualMonoid(..))
+
+instance IsString (Vector.Vector Char) where
+   fromString = Vector.fromList
+
+instance TextualMonoid (Vector.Vector Char) where
+   singleton = Vector.singleton
+   splitCharacterPrefix t = if Vector.null t then Nothing else Just (Vector.unsafeHead t, Vector.unsafeTail t)
+   characterPrefix = (Vector.!? 0)
+   map = Vector.map
+   concatMap = Vector.concatMap
+   toString = const Vector.toList
+   any = Vector.any
+   all = Vector.all
+
+   foldl   = const Vector.foldl
+   foldl'  = const Vector.foldl'
+   foldr   = const Vector.foldr
+
+   scanl = Vector.scanl
+   scanl1 f v | Vector.null v = Vector.empty
+              | otherwise = Vector.scanl1 f v
+   scanr = Vector.scanr
+   scanr1 f v | Vector.null v = Vector.empty
+              | otherwise = Vector.scanr1 f v
+   mapAccumL f a0 t = (a', Vector.reverse $ Vector.fromList l')
+      where (a', l') = Vector.foldl fc (a0, []) t
+            fc (a, l) c = (:l) <$> f a c
+   mapAccumR f a0 t = (a', Vector.fromList l')
+      where (a', l') = Vector.foldr fc (a0, []) t
+            fc c (a, l) = (:l) <$> f a c
+
+   takeWhile _ = Vector.takeWhile
+   dropWhile _ = Vector.dropWhile
+   break _ = Vector.break
+   span _ = Vector.span
+   spanMaybe s0 _ft fc v = case Vector.ifoldr g Left v s0
+                           of Left s' -> (v, Vector.empty, s')
+                              Right (i, s') | (prefix, suffix) <- Vector.splitAt i v -> (prefix, suffix, s')
+      where g i c cont s | Just s' <- fc s c = cont s'
+                         | otherwise = Right (i, s)
+   spanMaybe' s0 _ft fc v = case Vector.ifoldr' g Left v s0
+                            of Left s' -> (v, Vector.empty, s')
+                               Right (i, s') | (prefix, suffix) <- Vector.splitAt i v -> (prefix, suffix, s')
+      where g i c cont s | Just s' <- fc s c = seq s' (cont s')
+                         | otherwise = Right (i, s)
+   find = Vector.find
+   elem = Vector.elem
+
+   {-# INLINE all #-}
+   {-# INLINE any #-}
+   {-# INLINE break #-}
+   {-# INLINE characterPrefix #-}
+   {-# INLINE concatMap #-}
+   {-# INLINE dropWhile #-}
+   {-# INLINE elem #-}
+   {-# INLINE find #-}
+   {-# INLINE foldl   #-}
+   {-# INLINE foldl'  #-}
+   {-# INLINE foldr   #-}
+   {-# INLINE map #-}
+   {-# INLINE mapAccumL #-}
+   {-# INLINE mapAccumR #-}
+   {-# INLINE scanl #-}
+   {-# INLINE scanl1 #-}
+   {-# INLINE scanr #-}
+   {-# INLINE scanr1 #-}
+   {-# INLINE singleton #-}
+   {-# INLINE span #-}
+   {-# INLINE spanMaybe #-}
+   {-# INLINE spanMaybe' #-}
+   {-# INLINE splitCharacterPrefix #-}
+   {-# INLINE takeWhile #-}
diff --git a/src/Data/Monoid/Instances/Concat.hs b/src/Data/Monoid/Instances/Concat.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Instances/Concat.hs
@@ -0,0 +1,296 @@
+{- 
+    Copyright 2013-2019 Mario Blazevic
+
+    License: BSD3 (see BSD3-LICENSE.txt file)
+-}
+
+-- | This module defines the monoid transformer data type 'Concat'.
+-- 
+
+{-# LANGUAGE Haskell2010 #-}
+
+module Data.Monoid.Instances.Concat (
+   Concat, concatenate, extract, force
+   )
+where
+
+import Control.Applicative -- (Applicative(..))
+import Control.Arrow (first)
+import qualified Data.Foldable as Foldable
+import qualified Data.List as List
+import Data.String (IsString(..))
+import Data.Semigroup (Semigroup(..))
+import Data.Monoid (Monoid(..), First(..), Sum(..))
+import Data.Semigroup.Cancellative (LeftReductive(..), RightReductive(..))
+import Data.Semigroup.Factorial (Factorial(..), StableFactorial)
+import Data.Monoid.GCD (LeftGCDMonoid(..), RightGCDMonoid(..))
+import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)
+import Data.Monoid.Factorial (FactorialMonoid(..))
+import Data.Monoid.Textual (TextualMonoid(..))
+import qualified Data.Monoid.Factorial as Factorial
+import qualified Data.Monoid.Textual as Textual
+import Data.Sequence (Seq)
+import qualified Data.Sequence as Seq
+
+import Prelude hiding (all, any, break, filter, foldl, foldl1, foldr, foldr1, map, concatMap,
+                       length, null, reverse, scanl, scanr, scanl1, scanr1, span, splitAt, pi)
+
+-- | @'Concat'@ is a transparent monoid transformer. The behaviour of the @'Concat' a@ instances of monoid subclasses is
+-- identical to the behaviour of their @a@ instances, up to the 'pure' isomorphism.
+--
+-- The only purpose of 'Concat' then is to change the performance characteristics of various operations. Most
+-- importantly, injecting a monoid into 'Concat' has the effect of making 'mappend' a constant-time operation. The
+-- `splitPrimePrefix` and `splitPrimeSuffix` operations are amortized to constant time, provided that only one or the
+-- other is used. Using both operations alternately will trigger the worst-case behaviour of O(n).
+--
+data Concat a = Leaf a
+              | Concat a :<> Concat a
+              deriving Show
+
+{-# DEPRECATED concatenate, extract "Concat is not wrapping Seq any more, don't use concatenate nor extract." #-}
+concatenate :: PositiveMonoid a => Seq a -> Concat a
+concatenate q
+   | Foldable.all null q = mempty
+   | otherwise = Foldable.foldr (\a c-> if null a then c else Leaf a <> c) mempty q
+
+extract :: Concat a -> Seq a
+extract = Seq.fromList . Foldable.toList
+
+force :: Semigroup a => Concat a -> a
+force (Leaf x) = x
+force (x :<> y) = force x <> force y
+
+instance (Eq a, Semigroup a) => Eq (Concat a) where
+   x == y = force x == force y
+
+instance (Ord a, Semigroup a) => Ord (Concat a) where
+   compare x y = compare (force x) (force y)
+
+instance Functor Concat where
+   fmap f (Leaf x) = Leaf (f x)
+   fmap f (l :<> r) = fmap f l :<> fmap f r
+
+instance Applicative Concat where
+   pure = Leaf
+   Leaf f <*> x = f <$> x
+   (f1 :<> f2) <*> x = (f1 <*> x) :<> (f2 <*> x)
+
+instance Foldable.Foldable Concat where
+   fold (Leaf x) = x
+   fold (x :<> y) = Foldable.fold x `mappend` Foldable.fold y
+   foldMap f (Leaf x) = f x
+   foldMap f (x :<> y) = Foldable.foldMap f x `mappend` Foldable.foldMap f y
+   foldl f a (Leaf x) = f a x
+   foldl f a (x :<> y) = Foldable.foldl f (Foldable.foldl f a x) y
+   foldl' f a (Leaf x) = f a x
+   foldl' f a (x :<> y) = let a' = Foldable.foldl' f a x in a' `seq` Foldable.foldl' f a' y
+   foldr f a (Leaf x) = f x a
+   foldr f a (x :<> y) = Foldable.foldr f (Foldable.foldr f a y) x
+   foldr' f a (Leaf x) = f x a
+   foldr' f a (x :<> y) = let a' = Foldable.foldr' f a y in Foldable.foldr' f a' x
+
+instance PositiveMonoid a => Semigroup (Concat a) where
+   x <> y 
+      | null x = y
+      | null y = x
+      | otherwise = x :<> y
+
+instance PositiveMonoid a => Monoid (Concat a) where
+   mempty = Leaf mempty
+   mappend = (<>)
+
+instance PositiveMonoid a => MonoidNull (Concat a) where
+   null (Leaf x) = null x
+   null _ = False
+
+instance PositiveMonoid a => PositiveMonoid (Concat a)
+
+instance (LeftReductive a, StableFactorial a, PositiveMonoid a) => LeftReductive (Concat a) where
+   stripPrefix (Leaf x) (Leaf y) = Leaf <$> stripPrefix x y
+   stripPrefix (xp :<> xs) y = stripPrefix xp y >>= stripPrefix xs
+   stripPrefix x (yp :<> ys) = case (stripPrefix x yp, stripPrefix yp x)
+                               of (Just yps, _) -> Just (yps <> ys)
+                                  (Nothing, Nothing) -> Nothing
+                                  (Nothing, Just xs) -> stripPrefix xs ys
+
+instance (RightReductive a, StableFactorial a, PositiveMonoid a) => RightReductive (Concat a) where
+   stripSuffix (Leaf x) (Leaf y) = Leaf <$> stripSuffix x y
+   stripSuffix (xp :<> xs) y = stripSuffix xs y >>= stripSuffix xp
+   stripSuffix x (yp :<> ys) = case (stripSuffix x ys, stripSuffix ys x)
+                               of (Just ysp, _) -> Just (yp <> ysp)
+                                  (Nothing, Nothing) -> Nothing
+                                  (Nothing, Just xp) -> stripSuffix xp yp
+
+instance (LeftGCDMonoid a, StableFactorial a, PositiveMonoid a) => LeftGCDMonoid (Concat a) where
+   stripCommonPrefix (Leaf x) (Leaf y) = map3 Leaf (stripCommonPrefix x y)
+   stripCommonPrefix (xp :<> xs) y
+      | null xps = (xp <> xsp, xss, yss)
+      | otherwise = (xpp, xps <> xs, ys)
+      where (xpp, xps, ys) = stripCommonPrefix xp y
+            (xsp, xss, yss) = stripCommonPrefix xs ys
+   stripCommonPrefix x (yp :<> ys)
+      | null yps = (yp <> ysp, xss, yss)
+      | otherwise = (ypp, xs, yps <> ys)
+      where (ypp, xs, yps) = stripCommonPrefix x yp
+            (ysp, xss, yss) = stripCommonPrefix xs ys
+
+instance (RightGCDMonoid a, StableFactorial a, PositiveMonoid a) => RightGCDMonoid (Concat a) where
+   stripCommonSuffix (Leaf x) (Leaf y) = map3 Leaf (stripCommonSuffix x y)
+   stripCommonSuffix (xp :<> xs) y
+      | null xsp = (xpp, ypp, xps <> xs)
+      | otherwise = (xp <> xsp, yp, xss)
+      where (xsp, yp, xss) = stripCommonSuffix xs y
+            (xpp, ypp, xps) = stripCommonSuffix xp yp
+   stripCommonSuffix x (yp :<> ys)
+      | null ysp = (xpp, ypp, yps <> ys)
+      | otherwise = (xp, yp <> ysp, yss)
+      where (xp, ysp, yss) = stripCommonSuffix x ys
+            (xpp, ypp, yps) = stripCommonSuffix xp yp
+
+instance (Factorial a, PositiveMonoid a) => Factorial (Concat a) where
+   factors c = toList c []
+      where toList (Leaf x) rest
+               | null x = rest
+               | otherwise = (Leaf <$> factors x) ++ rest
+            toList (x :<> y) rest = toList x (toList y rest)
+   primePrefix (Leaf x) = Leaf (primePrefix x)
+   primePrefix (x :<> _) = primePrefix x
+   primeSuffix (Leaf x) = Leaf (primeSuffix x)
+   primeSuffix (_ :<> y) = primeSuffix y
+
+   foldl f = Foldable.foldl g
+      where g = Factorial.foldl (\a-> f a . Leaf)
+   foldl' f = Foldable.foldl' g
+      where g = Factorial.foldl' (\a-> f a . Leaf)
+   foldr f = Foldable.foldr g
+      where g a b = Factorial.foldr (f . Leaf) b a
+   foldMap f = Foldable.foldMap (Factorial.foldMap (f . Leaf))
+   length x = getSum $ Foldable.foldMap (Sum . length) x
+   reverse (Leaf x) = Leaf (reverse x)
+   reverse (x :<> y) = reverse y :<> reverse x
+
+instance (FactorialMonoid a, PositiveMonoid a) => FactorialMonoid (Concat a) where
+   splitPrimePrefix (Leaf x) = map2 Leaf <$> splitPrimePrefix x
+   splitPrimePrefix (x :<> y) = ((<> y) <$>) <$> splitPrimePrefix x
+   splitPrimeSuffix (Leaf x) = map2 Leaf <$> splitPrimeSuffix x
+   splitPrimeSuffix (x :<> y) = first (x <>) <$> splitPrimeSuffix y
+   span p (Leaf x) = map2 Leaf (Factorial.span (p . Leaf) x)
+   span p (x :<> y)
+      | null xs = (x <> yp, ys)
+      | otherwise = (xp, xs :<> y)
+      where (xp, xs) = Factorial.span p x
+            (yp, ys) = Factorial.span p y
+   spanMaybe s0 f (Leaf x) = first2 Leaf (Factorial.spanMaybe s0 (\s-> f s . Leaf) x)
+   spanMaybe s0 f (x :<> y)
+      | null xs = (x :<> yp, ys, s2)
+      | otherwise = (xp, xs :<> y, s1)
+      where (xp, xs, s1) = Factorial.spanMaybe s0 f x
+            (yp, ys, s2) = Factorial.spanMaybe s1 f y
+   spanMaybe' s0 f c = seq s0 $
+      case c
+      of Leaf x -> first2 Leaf (Factorial.spanMaybe' s0 (\s-> f s . Leaf) x)
+         x :<> y -> let (xp, xs, s1) = Factorial.spanMaybe' s0 f x
+                        (yp, ys, s2) = Factorial.spanMaybe' s1 f y
+                    in if null xs then (x :<> yp, ys, s2) else (xp, xs :<> y, s1)
+
+   split p = Foldable.foldr splitNext [mempty]
+      where splitNext a ~(xp:xs) =
+               let as = Leaf <$> Factorial.split (p . Leaf) a
+               in if null xp
+                  then as ++ xs
+                  else init as ++ (last as <> xp):xs
+   splitAt 0 c = (mempty, c)
+   splitAt n (Leaf x) = map2 Leaf (Factorial.splitAt n x)
+   splitAt n (x :<> y)
+      | k < n = (x :<> yp, ys)
+      | k > n = (xp, xs :<> y)
+      | otherwise = (x, y)
+      where k = length x
+            (yp, ys) = splitAt (n - k) y
+            (xp, xs) = splitAt n x
+
+instance (Factorial a, PositiveMonoid a) => StableFactorial (Concat a)
+
+instance (IsString a) => IsString (Concat a) where
+   fromString s = Leaf (fromString s)
+
+instance (Eq a, TextualMonoid a, StableFactorial a, PositiveMonoid a) => TextualMonoid (Concat a) where
+   fromText t = Leaf (fromText t)
+   singleton = Leaf . singleton
+   splitCharacterPrefix (Leaf x) = (Leaf <$>) <$> splitCharacterPrefix x
+   splitCharacterPrefix (x :<> y) = ((<> y) <$>) <$> splitCharacterPrefix x
+   characterPrefix (Leaf x) = characterPrefix x
+   characterPrefix (x :<> _) = characterPrefix x
+   map f x = map f <$> x
+   toString ft x = List.concatMap (toString $ ft . Leaf) (Foldable.toList x)
+
+   foldl ft fc = Foldable.foldl g
+      where g = Textual.foldl (\a-> ft a . Leaf) fc
+   foldl' ft fc = Foldable.foldl' g
+      where g = Textual.foldl' (\a-> ft a . Leaf) fc
+   foldr ft fc = Foldable.foldr g
+      where g a b = Textual.foldr (ft . Leaf) fc b a
+   any p = Foldable.any (any p)
+   all p = Foldable.all (all p)
+
+   span pt pc (Leaf x) = map2 Leaf (Textual.span (pt . Leaf) pc x)
+   span pt pc (x :<> y)
+      | null xs = (x <> yp, ys)
+      | otherwise = (xp, xs :<> y)
+      where (xp, xs) = Textual.span pt pc x
+            (yp, ys) = Textual.span pt pc y
+   span_ bt pc (Leaf x) = map2 Leaf (Textual.span_ bt pc x)
+   span_ bt pc (x :<> y)
+      | null xs = (x <> yp, ys)
+      | otherwise = (xp, xs :<> y)
+      where (xp, xs) = Textual.span_ bt pc x
+            (yp, ys) = Textual.span_ bt pc y
+   break pt pc = Textual.span (not . pt) (not . pc)
+   takeWhile_ bt pc = fst . span_ bt pc
+   dropWhile_ bt pc = snd . span_ bt pc
+   break_ bt pc = span_ (not bt) (not . pc)
+
+   spanMaybe s0 ft fc (Leaf x) = first2 Leaf (Textual.spanMaybe s0 (\s-> ft s . Leaf) fc x)
+   spanMaybe s0 ft fc (x :<> y)
+      | null xs = (x :<> yp, ys, s2)
+      | otherwise = (xp, xs :<> y, s1)
+      where (xp, xs, s1) = Textual.spanMaybe s0 ft fc x
+            (yp, ys, s2) = Textual.spanMaybe s1 ft fc y
+   spanMaybe' s0 ft fc c = seq s0 $
+      case c
+      of Leaf x -> first2 Leaf (Textual.spanMaybe' s0 (\s-> ft s . Leaf) fc x)
+         x :<> y -> let (xp, xs, s1) = Textual.spanMaybe' s0 ft fc x
+                        (yp, ys, s2) = Textual.spanMaybe' s1 ft fc y
+                    in if null xs then (x :<> yp, ys, s2) else (xp, xs :<> y, s1)
+   spanMaybe_ s0 fc (Leaf x) = first2 Leaf (Textual.spanMaybe_ s0 fc x)
+   spanMaybe_ s0 fc (x :<> y)
+      | null xs = (x :<> yp, ys, s2)
+      | otherwise = (xp, xs :<> y, s1)
+      where (xp, xs, s1) = Textual.spanMaybe_ s0 fc x
+            (yp, ys, s2) = Textual.spanMaybe_ s1 fc y
+   spanMaybe_' s0 fc c = seq s0 $
+      case c
+      of Leaf x -> first2 Leaf (Textual.spanMaybe_' s0 fc x)
+         x :<> y -> let (xp, xs, s1) = Textual.spanMaybe_' s0 fc x
+                        (yp, ys, s2) = Textual.spanMaybe_' s1 fc y
+                    in if null xs then (x :<> yp, ys, s2) else (xp, xs :<> y, s1)
+
+   split p = Foldable.foldr splitNext [mempty]
+      where splitNext a ~(xp:xs) =
+               let as = Leaf <$> Textual.split p a
+               in if null xp
+                  then as ++ xs
+                  else init as ++ (last as <> xp):xs
+   find p x = getFirst $ Foldable.foldMap (First . find p) x
+   elem i = Foldable.any (Textual.elem i)
+
+-- Utility functions
+
+map2 :: (a -> b) -> (a, a) -> (b, b)
+map2 f (x, y) = (f x, f y)
+
+map3 :: (a -> b) -> (a, a, a) -> (b, b, b)
+map3 f (x, y, z) = (f x, f y, f z)
+
+first2 :: (a -> b) -> (a, a, c) -> (b, b, c)
+first2 f (x, y, z) = (f x, f y, z)
diff --git a/src/Data/Monoid/Instances/Measured.hs b/src/Data/Monoid/Instances/Measured.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Instances/Measured.hs
@@ -0,0 +1,127 @@
+{- 
+    Copyright 2013-2019 Mario Blazevic
+
+    License: BSD3 (see BSD3-LICENSE.txt file)
+-}
+
+-- | This module defines the monoid transformer data type 'Measured'.
+-- 
+
+{-# LANGUAGE Haskell2010 #-}
+
+module Data.Monoid.Instances.Measured (
+   Measured, measure, extract
+   )
+where
+
+import Data.Functor -- ((<$>))
+import qualified Data.List as List
+import Data.String (IsString(..))
+import Data.Semigroup (Semigroup(..))
+import Data.Monoid (Monoid(..))
+import Data.Semigroup.Cancellative (LeftReductive(..), RightReductive(..))
+import Data.Semigroup.Factorial (Factorial(..), StableFactorial)
+import Data.Monoid.GCD (LeftGCDMonoid(..), RightGCDMonoid(..))
+import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)
+import Data.Monoid.Factorial (FactorialMonoid(..))
+import Data.Monoid.Textual (TextualMonoid(..))
+import qualified Data.Monoid.Factorial as Factorial
+import qualified Data.Monoid.Textual as Textual
+
+import Prelude hiding (all, any, break, filter, foldl, foldl1, foldr, foldr1, map, concatMap,
+                       length, null, reverse, scanl, scanr, scanl1, scanr1, span, splitAt)
+
+-- | @'Measured' a@ is a wrapper around the 'FactorialMonoid' @a@ that memoizes the monoid's 'length' so it becomes a
+-- constant-time operation. The parameter is restricted to the 'StableFactorial' class, which guarantees that
+-- @'length' (a <> b) == 'length' a + 'length' b@.
+
+data Measured a = Measured{_measuredLength :: Int, extract :: a} deriving (Eq, Show)
+
+-- | Create a new 'Measured' value.
+measure :: Factorial a => a -> Measured a
+measure x = Measured (length x) x
+
+instance Ord a => Ord (Measured a) where
+   compare (Measured _ x) (Measured _ y) = compare x y
+
+instance StableFactorial a => Semigroup (Measured a) where
+   Measured m a <> Measured n b = Measured (m + n) (a <> b)
+
+instance (StableFactorial a, Monoid a) => Monoid (Measured a) where
+   mempty = Measured 0 mempty
+   mappend = (<>)
+
+instance (StableFactorial a, Monoid a) => MonoidNull (Measured a) where
+   null (Measured n _) = n == 0
+
+instance (StableFactorial a, Monoid a) => PositiveMonoid (Measured a)
+
+instance (LeftReductive a, StableFactorial a) => LeftReductive (Measured a) where
+   stripPrefix (Measured m x) (Measured n y) = fmap (Measured (n - m)) (stripPrefix x y)
+
+instance (RightReductive a, StableFactorial a) => RightReductive (Measured a) where
+   stripSuffix (Measured m x) (Measured n y) = fmap (Measured (n - m)) (stripSuffix x y)
+
+instance (LeftGCDMonoid a, StableFactorial a) => LeftGCDMonoid (Measured a) where
+   commonPrefix (Measured _ x) (Measured _ y) = measure (commonPrefix x y)
+
+instance (RightGCDMonoid a, StableFactorial a) => RightGCDMonoid (Measured a) where
+   commonSuffix (Measured _ x) (Measured _ y) = measure (commonSuffix x y)
+
+instance (StableFactorial a, MonoidNull a) => Factorial (Measured a) where
+   factors (Measured _ x) = List.map (Measured 1) (factors x)
+   primePrefix m@(Measured _ x) = if null x then m else Measured 1 (primePrefix x)
+   primeSuffix m@(Measured _ x) = if null x then m else Measured 1 (primeSuffix x)
+   foldl f a0 (Measured _ x) = Factorial.foldl g a0 x
+      where g a = f a . Measured 1
+   foldl' f a0 (Measured _ x) = Factorial.foldl' g a0 x
+      where g a = f a . Measured 1
+   foldr f a0 (Measured _ x) = Factorial.foldr g a0 x
+      where g = f . Measured 1
+   foldMap f (Measured _ x) = Factorial.foldMap (f . Measured 1) x
+   length (Measured n _) = n
+   reverse (Measured n x) = Measured n (reverse x)
+
+instance (StableFactorial a, FactorialMonoid a) => FactorialMonoid (Measured a) where
+   splitPrimePrefix (Measured n x) = case splitPrimePrefix x
+                                     of Nothing -> Nothing
+                                        Just (p, s) -> Just (Measured 1 p, Measured (n - 1) s)
+   splitPrimeSuffix (Measured n x) = case splitPrimeSuffix x
+                                     of Nothing -> Nothing
+                                        Just (p, s) -> Just (Measured (n - 1) p, Measured 1 s)
+   span p (Measured n x) = (xp', xs')
+      where (xp, xs) = Factorial.span (p . Measured 1) x
+            xp' = measure xp
+            xs' = Measured (n - length xp') xs
+   split p (Measured _ x) = measure <$> Factorial.split (p . Measured 1) x
+   splitAt m (Measured n x) | m <= 0 = (mempty, Measured n x)
+                            | m >= n = (Measured n x, mempty)
+                            | otherwise = (Measured m xp, Measured (n - m) xs)
+      where (xp, xs) = splitAt m x
+
+instance (StableFactorial a, MonoidNull a) => StableFactorial (Measured a)
+
+instance (FactorialMonoid a, IsString a) => IsString (Measured a) where
+   fromString = measure . fromString
+
+instance (Eq a, StableFactorial a, TextualMonoid a) => TextualMonoid (Measured a) where
+   fromText = measure . fromText
+   singleton = Measured 1 . singleton
+   splitCharacterPrefix (Measured n x) = (Measured (n - 1) <$>) <$> splitCharacterPrefix x
+   characterPrefix (Measured _ x) = characterPrefix x
+   map f (Measured n x) = Measured n (map f x)
+   any p (Measured _ x) = any p x
+   all p (Measured _ x) = all p x
+
+   foldl ft fc a0 (Measured _ x) = Textual.foldl (\a-> ft a . Measured 1) fc a0 x
+   foldl' ft fc a0 (Measured _ x) = Textual.foldl' (\a-> ft a . Measured 1) fc a0 x
+   foldr ft fc a0 (Measured _ x) = Textual.foldr (ft . Measured 1) fc a0 x
+   toString ft (Measured _ x) = toString (ft . Measured 1) x
+
+   span pt pc (Measured n x) = (xp', xs')
+      where (xp, xs) = Textual.span (pt . Measured 1) pc x
+            xp' = measure xp
+            xs' = Measured (n - length xp') xs
+   break pt pc = Textual.span (not . pt) (not . pc)
+
+   find p (Measured _ x) = find p x
diff --git a/src/Data/Monoid/Instances/Positioned.hs b/src/Data/Monoid/Instances/Positioned.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Instances/Positioned.hs
@@ -0,0 +1,616 @@
+{-
+    Copyright 2014-2019 Mario Blazevic
+
+    License: BSD3 (see BSD3-LICENSE.txt file)
+-}
+
+-- | This module defines two monoid transformer data types, 'OffsetPositioned' and 'LinePositioned'. Both data types add
+-- a notion of the current position to their base monoid. In case of 'OffsetPositioned', the current position is a
+-- simple integer offset from the beginning of the monoid, and it can be applied to any 'StableFactorial'. The
+-- base monoid of 'LinePositioned' must be a 'TextualMonoid', but for the price it will keep track of the current line
+-- and column numbers as well.
+--
+-- All positions are zero-based:
+--
+-- >> let p = pure "abcd\nefgh\nijkl\nmnop\n" :: LinePositioned String
+-- >> p
+-- >Line 0, column 0: "abcd\nefgh\nijkl\nmnop\n"
+-- >> Data.Monoid.Factorial.drop 13 p
+-- >Line 2, column 3: "l\nmnop\n"
+
+{-# LANGUAGE Haskell2010 #-}
+
+module Data.Monoid.Instances.Positioned (
+   OffsetPositioned, LinePositioned, extract, position, line, column
+   )
+where
+
+import Control.Applicative -- (Applicative(..))
+import qualified Data.List as List
+import Data.String (IsString(..))
+
+import Data.Semigroup (Semigroup(..))
+import Data.Monoid (Monoid(..), Endo(..))
+import Data.Semigroup.Cancellative (LeftReductive(..), RightReductive(..))
+import Data.Semigroup.Factorial (Factorial(..), StableFactorial)
+import Data.Monoid.GCD (LeftGCDMonoid(..), RightGCDMonoid(..))
+import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)
+import Data.Monoid.Factorial (FactorialMonoid(..))
+import Data.Monoid.Textual (TextualMonoid(..))
+import qualified Data.Semigroup.Factorial as Factorial
+import qualified Data.Monoid.Factorial as Factorial
+import qualified Data.Monoid.Textual as Textual
+
+import Prelude hiding (all, any, break, filter, foldl, foldl1, foldr, foldr1, lines, map, concatMap,
+                       length, null, reverse, scanl, scanr, scanl1, scanr1, span, splitAt)
+
+class Positioned p where
+   extract :: p a -> a
+   position :: p a -> Int
+
+data OffsetPositioned m = OffsetPositioned{offset :: !Int,
+                                           -- ^ the current offset
+                                           extractOffset :: m}
+
+data LinePositioned m = LinePositioned{fullOffset :: !Int,
+                                       -- | the current line
+                                       line :: !Int,
+                                       lineStart :: !Int,
+                                       extractLines :: m}
+
+-- | the current column
+column :: LinePositioned m -> Int
+column lp = position lp - lineStart lp
+
+instance Functor OffsetPositioned where
+   fmap f (OffsetPositioned p c) = OffsetPositioned p (f c)
+
+instance Functor LinePositioned where
+   fmap f (LinePositioned p l lp c) = LinePositioned p l lp (f c)
+
+instance Applicative OffsetPositioned where
+   pure = OffsetPositioned 0
+   OffsetPositioned _ f <*> OffsetPositioned p c = OffsetPositioned p (f c)
+
+instance Applicative LinePositioned where
+   pure = LinePositioned 0 0 0
+   LinePositioned _ _ _ f <*> LinePositioned p l lp c = LinePositioned p l lp (f c)
+
+instance Positioned OffsetPositioned where
+   extract = extractOffset
+   position = offset
+
+instance Positioned LinePositioned where
+   extract = extractLines
+   position = fullOffset
+
+instance Eq m => Eq (OffsetPositioned m) where
+   OffsetPositioned{extractOffset= a} == OffsetPositioned{extractOffset= b} = a == b
+
+instance Eq m => Eq (LinePositioned m) where
+   LinePositioned{extractLines= a} == LinePositioned{extractLines= b} = a == b
+
+instance Ord m => Ord (OffsetPositioned m) where
+   compare OffsetPositioned{extractOffset= a} OffsetPositioned{extractOffset= b} = compare a b
+
+instance Ord m => Ord (LinePositioned m) where
+   compare LinePositioned{extractLines= a} LinePositioned{extractLines= b} = compare a b
+
+instance Show m => Show (OffsetPositioned m) where
+   showsPrec prec (OffsetPositioned pos c) = shows pos . (": " ++) . showsPrec prec c
+
+instance Show m => Show (LinePositioned m) where
+   showsPrec prec (LinePositioned pos l lpos c) =
+      ("Line " ++) . shows l . (", column " ++) . shows (pos - lpos) . (": " ++) . showsPrec prec c
+
+instance StableFactorial m => Semigroup (OffsetPositioned m) where
+   OffsetPositioned p1 c1 <> OffsetPositioned p2 c2 =
+      OffsetPositioned (if p1 /= 0 || p2 == 0 then p1 else max 0 $ p2 - length c1) (c1 <> c2)
+   {-# INLINE (<>) #-}
+
+instance (FactorialMonoid m, StableFactorial m) => Monoid (OffsetPositioned m) where
+   mempty = pure mempty
+   mappend = (<>)
+   {-# INLINE mempty #-}
+   {-# INLINE mappend #-}
+
+instance (StableFactorial m, TextualMonoid m) => Semigroup (LinePositioned m) where
+   LinePositioned p1 l1 lp1 c1 <> LinePositioned p2 l2 lp2 c2
+     | p1 /= 0 || p2 == 0 = LinePositioned p1 l1 lp1 c
+     | otherwise = LinePositioned p2' l2' lp2' c
+     where c = mappend c1 c2
+           p2' = max 0 $ p2 - length c1
+           lp2' = min p2' lp2
+           l2' = if l2 == 0 then 0 else max 0 $ l2 - Textual.foldl_' countLines 0 c1
+           countLines :: Int -> Char -> Int
+           countLines n '\n' = succ n
+           countLines n _ = n
+   {-# INLINE (<>) #-}
+
+instance (StableFactorial m, TextualMonoid m) => Monoid (LinePositioned m) where
+   mempty = pure mempty
+   mappend = (<>)
+   {-# INLINE mempty #-}
+
+instance (StableFactorial m, FactorialMonoid m) => MonoidNull (OffsetPositioned m) where
+   null = null . extractOffset
+   {-# INLINE null #-}
+
+instance (StableFactorial m, TextualMonoid m, MonoidNull m) => MonoidNull (LinePositioned m) where
+   null = null . extractLines
+   {-# INLINE null #-}
+
+instance (StableFactorial m, FactorialMonoid m) => PositiveMonoid (OffsetPositioned m)
+
+instance (StableFactorial m, TextualMonoid m) => PositiveMonoid (LinePositioned m)
+
+instance (StableFactorial m, LeftReductive m) => LeftReductive (OffsetPositioned m) where
+   isPrefixOf (OffsetPositioned _ c1) (OffsetPositioned _ c2) = isPrefixOf c1 c2
+   stripPrefix (OffsetPositioned _ c1) (OffsetPositioned p c2) = fmap (OffsetPositioned (p + length c1)) (stripPrefix c1 c2)
+   {-# INLINE isPrefixOf #-}
+   {-# INLINE stripPrefix #-}
+
+instance (StableFactorial m, TextualMonoid m) => LeftReductive (LinePositioned m) where
+   isPrefixOf a b = isPrefixOf (extractLines a) (extractLines b)
+   stripPrefix LinePositioned{extractLines= c1} (LinePositioned p l lpos c2) =
+      let (lines, columns) = linesColumns' c1
+          len = length c1
+      in fmap (LinePositioned (p + len) (l + lines) (lpos + len - columns)) (stripPrefix c1 c2)
+   {-# INLINE isPrefixOf #-}
+   {-# INLINE stripPrefix #-}
+
+instance (StableFactorial m, FactorialMonoid m, LeftGCDMonoid m) => LeftGCDMonoid (OffsetPositioned m) where
+   commonPrefix (OffsetPositioned p1 c1) (OffsetPositioned p2 c2) = OffsetPositioned (min p1 p2) (commonPrefix c1 c2)
+   stripCommonPrefix (OffsetPositioned p1 c1) (OffsetPositioned p2 c2) =
+      (OffsetPositioned (min p1 p2) prefix, OffsetPositioned (p1 + l) c1', OffsetPositioned (p2 + l) c2')
+      where (prefix, c1', c2') = stripCommonPrefix c1 c2
+            l = length prefix
+   {-# INLINE commonPrefix #-}
+   {-# INLINE stripCommonPrefix #-}
+
+instance (StableFactorial m, TextualMonoid m, LeftGCDMonoid m) => LeftGCDMonoid (LinePositioned m) where
+   commonPrefix (LinePositioned p1 l1 lp1 c1) (LinePositioned p2 l2 lp2 c2) =
+      if p1 <= p2
+      then LinePositioned p1 l1 lp1 (commonPrefix c1 c2)
+      else LinePositioned p2 l2 lp2 (commonPrefix c1 c2)
+   stripCommonPrefix (LinePositioned p1 l1 lp1 c1) (LinePositioned p2 l2 lp2 c2) =
+      let (prefix, c1', c2') = stripCommonPrefix c1 c2
+          (lines, columns) = linesColumns' prefix
+          len = length prefix
+      in (if p1 <= p2 then LinePositioned p1 l1 lp1 prefix else LinePositioned p2 l2 lp2 prefix,
+          LinePositioned (p1 + len) (l1 + lines) (lp1 + len - columns) c1',
+          LinePositioned (p2 + len) (l2 + lines) (lp2 + len - columns) c2')
+   {-# INLINE commonPrefix #-}
+   {-# INLINE stripCommonPrefix #-}
+
+instance (StableFactorial m, FactorialMonoid m, RightReductive m) => RightReductive (OffsetPositioned m) where
+   isSuffixOf (OffsetPositioned _ c1) (OffsetPositioned _ c2) = isSuffixOf c1 c2
+   stripSuffix (OffsetPositioned _ c1) (OffsetPositioned p c2) = fmap (OffsetPositioned p) (stripSuffix c1 c2)
+   {-# INLINE isSuffixOf #-}
+   {-# INLINE stripSuffix #-}
+
+instance (StableFactorial m, TextualMonoid m, RightReductive m) => RightReductive (LinePositioned m) where
+   isSuffixOf LinePositioned{extractLines=c1} LinePositioned{extractLines=c2} = isSuffixOf c1 c2
+   stripSuffix (LinePositioned p l lp c1) LinePositioned{extractLines=c2} =
+      fmap (LinePositioned p l lp) (stripSuffix c1 c2)
+   {-# INLINE isSuffixOf #-}
+   {-# INLINE stripSuffix #-}
+
+instance (StableFactorial m, FactorialMonoid m, RightGCDMonoid m) => RightGCDMonoid (OffsetPositioned m) where
+   commonSuffix (OffsetPositioned p1 c1) (OffsetPositioned p2 c2) =
+      OffsetPositioned (min (p1 + length c1) (p2 + length c2) - length suffix) suffix
+      where suffix = commonSuffix c1 c2
+   stripCommonSuffix (OffsetPositioned p1 c1) (OffsetPositioned p2 c2) =
+      (OffsetPositioned p1 c1', OffsetPositioned p2 c2',
+       OffsetPositioned (min (p1 + length c1') (p2 + length c2')) suffix)
+      where (c1', c2', suffix) = stripCommonSuffix c1 c2
+   {-# INLINE commonSuffix #-}
+   {-# INLINE stripCommonSuffix #-}
+
+instance (StableFactorial m, TextualMonoid m, RightGCDMonoid m) => RightGCDMonoid (LinePositioned m) where
+   stripCommonSuffix (LinePositioned p1 l1 lp1 c1) (LinePositioned p2 l2 lp2 c2) =
+      (LinePositioned p1 l1 lp1 c1', LinePositioned p2 l2 lp2 c2',
+       if p1 < p2
+       then LinePositioned (p1 + len1) (l1 + lines1) (lp1 + len1 - columns1) suffix
+       else LinePositioned (p2 + len2) (l2 + lines2) (lp2 + len2 - columns2) suffix)
+      where (c1', c2', suffix) = stripCommonSuffix c1 c2
+            len1 = length c1'
+            len2 = length c2'
+            (lines1, columns1) = linesColumns' c1'
+            (lines2, columns2) = linesColumns' c2'
+
+instance StableFactorial m => Factorial (OffsetPositioned m) where
+   factors (OffsetPositioned p c) = snd $ List.mapAccumL next p (factors c)
+      where next p1 c1 = (succ p1, OffsetPositioned p1 c1)
+   primePrefix (OffsetPositioned p c) = OffsetPositioned p (primePrefix c)
+   foldl f a0 (OffsetPositioned p0 c0) = fst $ Factorial.foldl f' (a0, p0) c0
+      where f' (a, p) c = (f a (OffsetPositioned p c), succ p)
+   foldl' f a0 (OffsetPositioned p0 c0) = fst $ Factorial.foldl' f' (a0, p0) c0
+      where f' (a, p) c = let a' = f a (OffsetPositioned p c) in seq a' (a', succ p)
+   foldr f a0 (OffsetPositioned p0 c0) = Factorial.foldr f' (const a0) c0 p0
+      where f' c cont p = f (OffsetPositioned p c) (cont $! succ p)
+   foldMap f (OffsetPositioned p c) = appEndo (Factorial.foldMap f' c) (const mempty) p
+      where -- f' :: m -> Endo (Int -> m)
+            f' prime = Endo (\cont pos-> f (OffsetPositioned pos prime) `mappend` cont (succ pos))
+   length (OffsetPositioned _ c) = length c
+   reverse (OffsetPositioned p c) = OffsetPositioned p (Factorial.reverse c)
+   {-# INLINE primePrefix #-}
+   {-# INLINE foldl #-}
+   {-# INLINE foldl' #-}
+   {-# INLINE foldr #-}
+   {-# INLINE foldMap #-}
+
+instance (StableFactorial m, FactorialMonoid m) => FactorialMonoid (OffsetPositioned m) where
+   splitPrimePrefix (OffsetPositioned p c) = fmap rewrap (splitPrimePrefix c)
+      where rewrap (cp, cs) = (OffsetPositioned p cp, OffsetPositioned (succ p) cs)
+   splitPrimeSuffix (OffsetPositioned p c) = fmap rewrap (splitPrimeSuffix c)
+      where rewrap (cp, cs) = (OffsetPositioned p cp, OffsetPositioned (p + length cp) cs)
+   spanMaybe s0 f (OffsetPositioned p0 t) = rewrap $ Factorial.spanMaybe (s0, p0) f' t
+      where f' (s, p) prime = do s' <- f s (OffsetPositioned p prime)
+                                 let p' = succ p
+                                 Just $! seq p' (s', p')
+            rewrap (prefix, suffix, (s, p)) = (OffsetPositioned p0 prefix, OffsetPositioned p suffix, s)
+   spanMaybe' s0 f (OffsetPositioned p0 t) = rewrap $! Factorial.spanMaybe' (s0, p0) f' t
+      where f' (s, p) prime = do s' <- f s (OffsetPositioned p prime)
+                                 let p' = succ p
+                                 Just $! s' `seq` p' `seq` (s', p')
+            rewrap (prefix, suffix, (s, p)) = (OffsetPositioned p0 prefix, OffsetPositioned p suffix, s)
+   span f (OffsetPositioned p0 t) = rewrap $ Factorial.spanMaybe' p0 f' t
+      where f' p prime = if f (OffsetPositioned p prime)
+                         then Just $! succ p
+                         else Nothing
+            rewrap (prefix, suffix, p) = (OffsetPositioned p0 prefix, OffsetPositioned p suffix)
+   splitAt n m@(OffsetPositioned p c) | n <= 0 = (mempty, m)
+                                      | n >= length c = (m, mempty)
+                                      | otherwise = (OffsetPositioned p prefix, OffsetPositioned (p + n) suffix)
+      where (prefix, suffix) = splitAt n c
+   drop n (OffsetPositioned p c) = OffsetPositioned (p + n) (Factorial.drop n c)
+   take n (OffsetPositioned p c) = OffsetPositioned p (Factorial.take n c)
+   {-# INLINE splitPrimePrefix #-}
+   {-# INLINE splitPrimeSuffix #-}
+   {-# INLINE span #-}
+   {-# INLINE splitAt #-}
+   {-# INLINE take #-}
+   {-# INLINE drop #-}
+
+instance (StableFactorial m, TextualMonoid m) => Factorial (LinePositioned m) where
+   factors (LinePositioned p0 l0 lp0 c) = snd $ List.mapAccumL next (p0, l0, lp0) (factors c)
+      where next (p, l, lp) c1 | characterPrefix c1 == Just '\n' = ((succ p, succ l, p), LinePositioned p l lp c1)
+                               | otherwise = ((succ p, l, lp), LinePositioned p l lp c1)
+   primePrefix (LinePositioned p l lp c) = LinePositioned p l lp (primePrefix c)
+   foldl f a0 (LinePositioned p0 l0 lp0 c0) = fstOf4 $! Factorial.foldl f' (a0, p0, l0, lp0) c0
+      where f' (a, p, l, lp) c | characterPrefix c == Just '\n' = (f a (LinePositioned p l lp c), succ p, succ l, p)
+                               | otherwise = (f a (LinePositioned p l lp c), succ p, l, lp)
+   foldl' f a0 (LinePositioned p0 l0 lp0 c0) = fstOf4 $! Factorial.foldl' f' (a0, p0, l0, lp0) c0
+      where f' (a, p, l, lp) c = let a' = f a (LinePositioned p l lp c)
+                                 in seq a' (if characterPrefix c == Just '\n'
+                                            then (a', succ p, succ l, p)
+                                            else (a', succ p, l, lp))
+   foldr f a0 (LinePositioned p0 l0 lp0 c0) = Factorial.foldr f' (const3 a0) c0 p0 l0 lp0
+      where f' c cont p l lp
+               | characterPrefix c == Just '\n' = f (LinePositioned p l lp c) $ ((cont $! succ p) $! succ l) p
+               | otherwise = f (LinePositioned p l lp c) $ (cont $! succ p) l lp
+   foldMap f (LinePositioned p0 l0 lp0 c) = appEndo (Factorial.foldMap f' c) (const mempty) p0 l0 lp0
+      where -- f' :: m -> Endo (Int -> Int -> Int -> m)
+            f' prime = Endo (\cont p l lp-> f (LinePositioned p l lp prime)
+                                            <>
+                                            if characterPrefix prime == Just '\n'
+                                            then cont (succ p) (succ l) p
+                                            else cont (succ p) l lp)
+   length = length . extractLines
+   reverse (LinePositioned p l lp c) = LinePositioned p l lp (Factorial.reverse c)
+   {-# INLINE primePrefix #-}
+   {-# INLINE foldl #-}
+   {-# INLINE foldl' #-}
+   {-# INLINE foldr #-}
+   {-# INLINE foldMap #-}
+   {-# INLINE length #-}
+   {-# INLINE reverse #-}
+
+instance (StableFactorial m, TextualMonoid m) => FactorialMonoid (LinePositioned m) where
+   splitPrimePrefix (LinePositioned p l lp c) = fmap rewrap (splitPrimePrefix c)
+      where rewrap (cp, cs) = (LinePositioned p l lp cp,
+                               if characterPrefix cp == Just '\n'
+                               then LinePositioned (succ p) (succ l) p cs
+                               else LinePositioned (succ p) l lp cs)
+   splitPrimeSuffix (LinePositioned p l lp c) = fmap rewrap (splitPrimeSuffix c)
+      where rewrap (cp, cs) = (LinePositioned p l lp cp, LinePositioned p' (l + lines) (p' - columns) cs)
+               where len = length cp
+                     (lines, columns) = linesColumns cp
+                     p' = p + len
+   spanMaybe s0 f (LinePositioned p0 l0 lp0 c) = rewrap $ Factorial.spanMaybe (s0, p0, l0, lp0) f' c
+      where f' (s, p, l, lp) prime = do s' <- f s (LinePositioned p l lp prime)
+                                        let p' = succ p
+                                            l' = succ l
+                                        Just $! p' `seq` if characterPrefix prime == Just '\n'
+                                                         then l' `seq` (s', p', l', p)
+                                                         else (s', p', l, lp)
+            rewrap (prefix, suffix, (s, p, l, lp)) = (LinePositioned p0 l0 lp0 prefix, LinePositioned p l lp suffix, s)
+   spanMaybe' s0 f (LinePositioned p0 l0 lp0 c) = rewrap $! Factorial.spanMaybe' (s0, p0, l0, lp0) f' c
+      where f' (s, p, l, lp) prime = do s' <- f s (LinePositioned p l lp prime)
+                                        let p' = succ p
+                                            l' = succ l
+                                        Just $! s' `seq` p' `seq` if characterPrefix prime == Just '\n'
+                                                                  then l' `seq` (s', p', l', p)
+                                                                  else (s', p', l, lp)
+            rewrap (prefix, suffix, (s, p, l, lp)) = (LinePositioned p0 l0 lp0 prefix, LinePositioned p l lp suffix, s)
+
+   span f (LinePositioned p0 l0 lp0 t) = rewrap $ Factorial.spanMaybe' (p0, l0, lp0) f' t
+      where f' (p, l, lp) prime = if f (LinePositioned p l lp prime)
+                                  then let p' = succ p
+                                           l' = succ l
+                                       in Just $! p' `seq` if characterPrefix prime == Just '\n'
+                                                           then l' `seq` (p', l', p)
+                                                           else (p', l, lp)
+                                  else Nothing
+            rewrap (prefix, suffix, (p, l, lp)) = (LinePositioned p0 l0 lp0 prefix, LinePositioned p l lp suffix)
+   splitAt n m@(LinePositioned p l lp c) | n <= 0 = (mempty, m)
+                                         | n >= length c = (m, mempty)
+                                         | otherwise = (LinePositioned p l lp prefix,
+                                                        LinePositioned p' (l + lines) (p' - columns) suffix)
+      where (prefix, suffix) = splitAt n c
+            (lines, columns) = linesColumns prefix
+            p' = p + n
+   take n (LinePositioned p l lp c) = LinePositioned p l lp (Factorial.take n c)
+   {-# INLINE splitPrimePrefix #-}
+   {-# INLINE splitPrimeSuffix #-}
+   {-# INLINE span #-}
+   {-# INLINE splitAt #-}
+   {-# INLINE take #-}
+
+instance StableFactorial m => StableFactorial (OffsetPositioned m)
+
+instance (StableFactorial m, TextualMonoid m) => StableFactorial (LinePositioned m)
+
+instance IsString m => IsString (OffsetPositioned m) where
+   fromString = pure . fromString
+
+instance IsString m => IsString (LinePositioned m) where
+   fromString = pure . fromString
+
+instance (StableFactorial m, TextualMonoid m) => TextualMonoid (OffsetPositioned m) where
+   splitCharacterPrefix (OffsetPositioned p c) = fmap (fmap $ OffsetPositioned $ succ p) (splitCharacterPrefix c)
+
+   fromText = pure . fromText
+   singleton = pure . singleton
+
+   characterPrefix = characterPrefix . extractOffset
+
+   map f (OffsetPositioned p c) = OffsetPositioned p (map f c)
+   concatMap f (OffsetPositioned p c) = OffsetPositioned p (concatMap (extractOffset . f) c)
+   all p = all p . extractOffset
+   any p = any p . extractOffset
+
+   foldl ft fc a0 (OffsetPositioned p0 c0) = fst $ Textual.foldl ft' fc' (a0, p0) c0
+      where ft' (a, p) c = (ft a (OffsetPositioned p c), succ p)
+            fc' (a, p) c = (fc a c, succ p)
+   foldl' ft fc a0 (OffsetPositioned p0 c0) = fst $ Textual.foldl' ft' fc' (a0, p0) c0
+      where ft' (a, p) c = ((,) $! ft a (OffsetPositioned p c)) $! succ p
+            fc' (a, p) c = ((,) $! fc a c) $! succ p
+   foldr ft fc a0 (OffsetPositioned p0 c0) = snd $ Textual.foldr ft' fc' (p0, a0) c0
+      where ft' c (p, a) = (succ p, ft (OffsetPositioned p c) a)
+            fc' c (p, a) = (succ p, fc c a)
+
+   scanl f ch (OffsetPositioned p c) = OffsetPositioned p (Textual.scanl f ch c)
+   scanl1 f (OffsetPositioned p c) = OffsetPositioned p (Textual.scanl1 f c)
+   scanr f ch (OffsetPositioned p c) = OffsetPositioned p (Textual.scanr f ch c)
+   scanr1 f (OffsetPositioned p c) = OffsetPositioned p (Textual.scanr1 f c)
+   mapAccumL f a0 (OffsetPositioned p c) = fmap (OffsetPositioned p) (Textual.mapAccumL f a0 c)
+   mapAccumR f a0 (OffsetPositioned p c) = fmap (OffsetPositioned p) (Textual.mapAccumR f a0 c)
+
+   spanMaybe s0 ft fc (OffsetPositioned p0 t) = rewrap $ Textual.spanMaybe (s0, p0) ft' fc' t
+      where ft' (s, p) prime = do s' <- ft s (OffsetPositioned p prime)
+                                  let p' = succ p
+                                  Just $! seq p' (s', p')
+            fc' (s, p) c = do s' <- fc s c
+                              let p' = succ p
+                              Just $! seq p' (s', p')
+            rewrap (prefix, suffix, (s, p)) = (OffsetPositioned p0 prefix, OffsetPositioned p suffix, s)
+   spanMaybe' s0 ft fc (OffsetPositioned p0 t) = rewrap $! Textual.spanMaybe' (s0, p0) ft' fc' t
+      where ft' (s, p) prime = do s' <- ft s (OffsetPositioned p prime)
+                                  let p' = succ p
+                                  Just $! s' `seq` p' `seq` (s', p')
+            fc' (s, p) c = do s' <- fc s c
+                              let p' = succ p
+                              Just $! s' `seq` p' `seq` (s', p')
+            rewrap (prefix, suffix, (s, p)) = (OffsetPositioned p0 prefix, OffsetPositioned p suffix, s)
+   span ft fc (OffsetPositioned p0 t) = rewrap $ Textual.spanMaybe' p0 ft' fc' t
+      where ft' p prime = if ft (OffsetPositioned p prime)
+                          then Just $! succ p
+                          else Nothing
+            fc' p c = if fc c
+                      then Just $! succ p
+                      else Nothing
+            rewrap (prefix, suffix, p) = (OffsetPositioned p0 prefix, OffsetPositioned p suffix)
+
+   split f (OffsetPositioned p0 c0) = rewrap p0 (Textual.split f c0)
+      where rewrap _ [] = []
+            rewrap p (c:rest) = OffsetPositioned p c : rewrap (p + length c) rest
+   find p = find p . extractOffset
+
+   foldl_ fc a0 (OffsetPositioned _ c) = Textual.foldl_ fc a0 c
+   foldl_' fc a0 (OffsetPositioned _ c) = Textual.foldl_' fc a0 c
+   foldr_ fc a0 (OffsetPositioned _ c) = Textual.foldr_ fc a0 c
+
+   spanMaybe_ s0 fc (OffsetPositioned p0 t) = rewrap $ Textual.spanMaybe_' (s0, p0) fc' t
+      where fc' (s, p) c = do s' <- fc s c
+                              let p' = succ p
+                              Just $! seq p' (s', p')
+            rewrap (prefix, suffix, (s, p)) = (OffsetPositioned p0 prefix, OffsetPositioned p suffix, s)
+   spanMaybe_' s0 fc (OffsetPositioned p0 t) = rewrap $! Textual.spanMaybe_' (s0, p0) fc' t
+      where fc' (s, p) c = do s' <- fc s c
+                              let p' = succ p
+                              Just $! s' `seq` p' `seq` (s', p')
+            rewrap (prefix, suffix, (s, p)) = (OffsetPositioned p0 prefix, OffsetPositioned p suffix, s)
+   span_ bt fc (OffsetPositioned p0 t) = rewrap $ Textual.span_ bt fc t
+      where rewrap (prefix, suffix) = (OffsetPositioned p0 prefix, OffsetPositioned (p0 + length prefix) suffix)
+   break_ bt fc (OffsetPositioned p0 t) = rewrap $ Textual.break_ bt fc t
+      where rewrap (prefix, suffix) = (OffsetPositioned p0 prefix, OffsetPositioned (p0 + length prefix) suffix)
+   dropWhile_ bt fc t = snd (span_ bt fc t)
+   takeWhile_ bt fc (OffsetPositioned p t) = OffsetPositioned p (takeWhile_ bt fc t)
+
+   {-# INLINE characterPrefix #-}
+   {-# INLINE splitCharacterPrefix #-}
+   {-# INLINE map #-}
+   {-# INLINE concatMap #-}
+   {-# INLINE foldl' #-}
+   {-# INLINE foldr #-}
+   {-# INLINE spanMaybe' #-}
+   {-# INLINE span #-}
+   {-# INLINE foldl_' #-}
+   {-# INLINE foldr_ #-}
+   {-# INLINE any #-}
+   {-# INLINE all #-}
+   {-# INLINE spanMaybe_' #-}
+   {-# INLINE span_ #-}
+   {-# INLINE break_ #-}
+   {-# INLINE dropWhile_ #-}
+   {-# INLINE takeWhile_ #-}
+   {-# INLINE split #-}
+   {-# INLINE find #-}
+
+instance (StableFactorial m, TextualMonoid m) => TextualMonoid (LinePositioned m) where
+   splitCharacterPrefix (LinePositioned p l lp c) =
+      case splitCharacterPrefix c
+      of Nothing -> Nothing
+         Just ('\n', rest) -> Just ('\n', LinePositioned (succ p) (succ l) p rest)
+         Just (ch, rest) -> Just (ch, LinePositioned (succ p) l lp rest)
+
+   fromText = pure . fromText
+   singleton = pure . singleton
+
+   characterPrefix = characterPrefix . extractLines
+
+   map f (LinePositioned p l lp c) = LinePositioned p l lp (map f c)
+   concatMap f (LinePositioned p l lp c) = LinePositioned p l lp (concatMap (extractLines . f) c)
+   all p = all p . extractLines
+   any p = any p . extractLines
+
+   foldl ft fc a0 (LinePositioned p0 l0 lp0 c0) = fstOf4 $ Textual.foldl ft' fc' (a0, p0, l0, lp0) c0
+      where ft' (a, p, l, lp) c = (ft a (LinePositioned p l lp c), succ p, l, lp)
+            fc' (a, p, l, _lp) '\n' = (fc a '\n', succ p, succ l, p)
+            fc' (a, p, l, lp) c = (fc a c, succ p, l, lp)
+   foldl' ft fc a0 (LinePositioned p0 l0 lp0 c0) = fstOf4 $ Textual.foldl' ft' fc' (a0, p0, l0, lp0) c0
+      where ft' (a, p, l, lp) c = let a' = ft a (LinePositioned p l lp c)
+                                      p' = succ p
+                                  in a' `seq` p' `seq` (a', p', l, lp)
+            fc' (a, p, l, lp) c = let a' = fc a c
+                                      p' = succ p
+                                      l' = succ l
+                                  in a' `seq` p' `seq` if c == '\n'
+                                                       then l' `seq` (a', p', l', p)
+                                                       else (a', p', l, lp)
+   foldr ft fc a0 (LinePositioned p0 l0 lp0 c0) = Textual.foldr ft' fc' (const3 a0) c0 p0 l0 lp0
+      where ft' c cont p l lp = ft (LinePositioned p l lp c) $ (cont $! succ p) l lp
+            fc' c cont p l lp
+               | c == '\n' = fc c $ ((cont $! succ p) $! succ l) p
+               | otherwise = fc c $ (cont $! succ p) l lp
+
+   spanMaybe s0 ft fc (LinePositioned p0 l0 lp0 t) = rewrap $ Textual.spanMaybe (s0, p0, l0, lp0) ft' fc' t
+      where ft' (s, p, l, lp) prime = do s' <- ft s (LinePositioned p l lp prime)
+                                         let p' = succ p
+                                         Just $! seq p' (s', p', l, lp)
+            fc' (s, p, l, lp) c = fc s c
+                                  >>= \s'-> Just $! seq p' (if c == '\n' then seq l' (s', p', l', p) else (s', p', l, lp))
+               where p' = succ p
+                     l' = succ l
+            rewrap (prefix, suffix, (s, p, l, lp)) = (LinePositioned p0 l0 lp0 prefix, LinePositioned p l lp suffix, s)
+   spanMaybe' s0 ft fc (LinePositioned p0 l0 lp0 t) = rewrap $! Textual.spanMaybe' (s0, p0, l0, lp0) ft' fc' t
+      where ft' (s, p, l, lp) prime = do s' <- ft s (LinePositioned p l lp prime)
+                                         let p' = succ p
+                                         Just $! s' `seq` p' `seq` (s', p', l, lp)
+            fc' (s, p, l, lp) c = do s' <- fc s c
+                                     let p' = succ p
+                                         l' = succ l
+                                     Just $! s' `seq` p' `seq` (if c == '\n' then seq l' (s', p', l', p) else (s', p', l, lp))
+            rewrap (prefix, suffix, (s, p, l, lp)) = (LinePositioned p0 l0 lp0 prefix, LinePositioned p l lp suffix, s)
+   span ft fc (LinePositioned p0 l0 lp0 t) = rewrap $ Textual.spanMaybe' (p0, l0, lp0) ft' fc' t
+      where ft' (p, l, lp) prime = if ft (LinePositioned p l lp prime)
+                                   then let p' = succ p
+                                        in p' `seq` Just (p', l, lp)
+                                   else Nothing
+            fc' (p, l, lp) c | fc c = Just $! seq p' (if c == '\n' then seq l' (p', l', p) else (p', l, lp))
+                             | otherwise = Nothing
+               where p' = succ p
+                     l' = succ l
+            rewrap (prefix, suffix, (p, l, lp)) = (LinePositioned p0 l0 lp0 prefix, LinePositioned p l lp suffix)
+
+   scanl f ch (LinePositioned p l lp c) = LinePositioned p l lp (Textual.scanl f ch c)
+   scanl1 f (LinePositioned p l lp c) = LinePositioned p l lp (Textual.scanl1 f c)
+   scanr f ch (LinePositioned p l lp c) = LinePositioned p l lp (Textual.scanr f ch c)
+   scanr1 f (LinePositioned p l lp c) = LinePositioned p l lp (Textual.scanr1 f c)
+   mapAccumL f a0 (LinePositioned p l lp c) = fmap (LinePositioned p l lp) (Textual.mapAccumL f a0 c)
+   mapAccumR f a0 (LinePositioned p l lp c) = fmap (LinePositioned p l lp) (Textual.mapAccumR f a0 c)
+
+   split f (LinePositioned p0 l0 lp0 c0) = rewrap p0 l0 lp0 (Textual.split f c0)
+      where rewrap _ _ _ [] = []
+            rewrap p l lp (c:rest) = LinePositioned p l lp c
+                                     : rewrap p' (l + lines) (if lines == 0 then lp else p' - columns) rest
+               where p' = p + length c
+                     (lines, columns) = linesColumns c
+   find p = find p . extractLines
+
+   foldl_ fc a0 (LinePositioned _ _ _ t) = Textual.foldl_ fc a0 t
+   foldl_' fc a0 (LinePositioned _ _ _ t) = Textual.foldl_' fc a0 t
+   foldr_ fc a0 (LinePositioned _ _ _ t) = Textual.foldr_ fc a0 t
+
+   spanMaybe_ s0 fc (LinePositioned p0 l0 lp0 t) = rewrap $ Textual.spanMaybe_ s0 fc t
+      where rewrap (prefix, suffix, s) = (LinePositioned p0 l0 lp0 prefix,
+                                          LinePositioned p1 (l0 + l) (if l == 0 then lp0 else p1 - col) suffix,
+                                          s)
+              where (l, col) = linesColumns prefix
+                    p1 = p0 + length prefix
+   spanMaybe_' s0 fc (LinePositioned p0 l0 lp0 t) = rewrap $ Textual.spanMaybe_' s0 fc t
+      where rewrap (prefix, suffix, s) = p1 `seq` l1 `seq` lp1 `seq`
+                                         (LinePositioned p0 l0 lp0 prefix, LinePositioned p1 l1 lp1 suffix, s)
+              where (l, col) = linesColumns' prefix
+                    p1 = p0 + length prefix
+                    l1 = l0 + l
+                    lp1 = if l == 0 then lp0 else p1 - col
+   span_ bt fc (LinePositioned p0 l0 lp0 t) = rewrap $ Textual.span_ bt fc t
+      where rewrap (prefix, suffix) = (LinePositioned p0 l0 lp0 prefix,
+                                       LinePositioned p1 (l0 + l) (if l == 0 then lp0 else p1 - col) suffix)
+              where (l, col) = linesColumns' prefix
+                    p1 = p0 + length prefix
+   break_ bt fc t = span_ (not bt) (not . fc) t
+   dropWhile_ bt fc t = snd (span_ bt fc t)
+   takeWhile_ bt fc (LinePositioned p l lp t) = LinePositioned p l lp (takeWhile_ bt fc t)
+
+   {-# INLINE characterPrefix #-}
+   {-# INLINE splitCharacterPrefix #-}
+   {-# INLINE map #-}
+   {-# INLINE concatMap #-}
+   {-# INLINE foldl' #-}
+   {-# INLINE foldr #-}
+   {-# INLINE spanMaybe' #-}
+   {-# INLINE span #-}
+   {-# INLINE split #-}
+   {-# INLINE find #-}
+   {-# INLINE foldl_' #-}
+   {-# INLINE foldr_ #-}
+   {-# INLINE any #-}
+   {-# INLINE all #-}
+   {-# INLINE spanMaybe_' #-}
+   {-# INLINE span_ #-}
+   {-# INLINE break_ #-}
+   {-# INLINE dropWhile_ #-}
+   {-# INLINE takeWhile_ #-}
+
+linesColumns :: TextualMonoid m => m -> (Int, Int)
+linesColumns t = Textual.foldl (const . fmap succ) fc (0, 0) t
+   where fc (l, _) '\n' = (succ l, 0)
+         fc (l, c) _ = (l, succ c)
+linesColumns' :: TextualMonoid m => m -> (Int, Int)
+linesColumns' t = Textual.foldl' (const . fmap succ) fc (0, 0) t
+   where fc (l, _) '\n' = let l' = succ l in seq l' (l', 0)
+         fc (l, c) _ = let c' = succ c in seq c' (l, c')
+{-# INLINE linesColumns #-}
+{-# INLINE linesColumns' #-}
+
+const3 :: a -> b -> c -> d -> a
+const3 a _p _l _lp = a
+{-# INLINE const3 #-}
+
+fstOf4 :: (a, b, c, d) -> a
+fstOf4 (a, _, _, _) = a
+{-# INLINE fstOf4  #-}
diff --git a/src/Data/Monoid/Instances/Stateful.hs b/src/Data/Monoid/Instances/Stateful.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Instances/Stateful.hs
@@ -0,0 +1,241 @@
+{-
+    Copyright 2013-2019 Mario Blazevic
+
+    License: BSD3 (see BSD3-LICENSE.txt file)
+-}
+
+-- | This module defines the monoid transformer data type 'Stateful'.
+--
+-- >> let s = setState [4] $ pure "data" :: Stateful [Int] String
+-- >> s
+-- >Stateful ("data",[4])
+-- >> factors s
+-- >[Stateful ("d",[]),Stateful ("a",[]),Stateful ("t",[]),Stateful ("a",[]),Stateful ("",[4])]
+
+{-# LANGUAGE Haskell2010 #-}
+
+module Data.Monoid.Instances.Stateful (
+   Stateful(Stateful), extract, state, setState
+   )
+where
+
+import Control.Applicative -- (Applicative(..))
+import Data.Functor -- ((<$>))
+import qualified Data.List as List
+import Data.String (IsString(..))
+import Data.Semigroup (Semigroup(..))
+import Data.Monoid (Monoid(..))
+import Data.Semigroup.Cancellative (LeftReductive(..), RightReductive(..))
+import Data.Semigroup.Factorial (Factorial(..), StableFactorial)
+import Data.Monoid.GCD (LeftGCDMonoid(..), RightGCDMonoid(..))
+import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)
+import Data.Monoid.Factorial (FactorialMonoid(..))
+import Data.Monoid.Textual (TextualMonoid(..))
+import qualified Data.Semigroup.Factorial as Factorial
+import qualified Data.Monoid.Factorial as Factorial
+import qualified Data.Monoid.Textual as Textual
+
+import Prelude hiding (all, any, break, elem, drop, filter, foldl, foldl1, foldr, foldr1, gcd, map, concatMap,
+                       length, null, reverse, scanl, scanr, scanl1, scanr1, span, splitAt, take)
+
+-- | @'Stateful' a b@ is a wrapper around the 'Monoid' @b@ that carries the state @a@ along. The state type @a@ must be
+-- a monoid as well if 'Stateful' is to be of any use. In the 'FactorialMonoid' and 'TextualMonoid' class instances, the
+-- monoid @b@ has the priority and the state @a@ is left for the end.
+newtype Stateful a b = Stateful (b, a) deriving (Eq, Ord, Show)
+
+extract :: Stateful a b -> b
+extract (Stateful (t, _)) = t
+
+state :: Stateful a b -> a
+state (Stateful (_, x)) = x
+
+setState :: a -> Stateful a b -> Stateful a b
+setState s (Stateful (t, _)) = Stateful (t, s)
+
+instance Functor (Stateful a) where
+   fmap f (Stateful (x, s)) = Stateful (f x, s)
+
+instance Monoid a => Applicative (Stateful a) where
+   pure m = Stateful (m, mempty)
+   Stateful (f, s1) <*> Stateful (x, s2) = Stateful (f x, mappend s1 s2)
+
+instance (Semigroup a, Semigroup b) => Semigroup (Stateful a b) where
+   Stateful x <> Stateful y = Stateful (x <> y)
+   {-# INLINE (<>) #-}
+
+instance (Monoid a, Monoid b) => Monoid (Stateful a b) where
+   mempty = Stateful mempty
+   Stateful x `mappend` Stateful y = Stateful (mappend x y)
+   {-# INLINE mempty #-}
+   {-# INLINE mappend #-}
+
+instance (MonoidNull a, MonoidNull b) => MonoidNull (Stateful a b) where
+   null (Stateful x) = null x
+   {-# INLINE null #-}
+
+instance (PositiveMonoid a, PositiveMonoid b) => PositiveMonoid (Stateful a b)
+
+instance (LeftReductive a, LeftReductive b) => LeftReductive (Stateful a b) where
+   isPrefixOf (Stateful x) (Stateful x') = isPrefixOf x x'
+   stripPrefix (Stateful x) (Stateful x') = Stateful <$> stripPrefix x x'
+   {-# INLINE isPrefixOf #-}
+   {-# INLINE stripPrefix #-}
+
+instance (RightReductive a, RightReductive b) => RightReductive (Stateful a b) where
+   isSuffixOf (Stateful x) (Stateful x') = isSuffixOf x x'
+   stripSuffix (Stateful x) (Stateful x') = Stateful <$> stripSuffix x x'
+   {-# INLINE stripSuffix #-}
+   {-# INLINE isSuffixOf #-}
+
+instance (LeftGCDMonoid a, LeftGCDMonoid b) => LeftGCDMonoid (Stateful a b) where
+   commonPrefix (Stateful x) (Stateful x') = Stateful (commonPrefix x x')
+   stripCommonPrefix (Stateful x) (Stateful x') = (Stateful prefix, Stateful suffix1, Stateful suffix2)
+      where (prefix, suffix1, suffix2) = stripCommonPrefix x x'
+   {-# INLINE commonPrefix #-}
+   {-# INLINE stripCommonPrefix #-}
+
+instance (RightGCDMonoid a, RightGCDMonoid b) => RightGCDMonoid (Stateful a b) where
+   commonSuffix (Stateful x) (Stateful x') = Stateful (commonSuffix x x')
+   {-# INLINE commonSuffix #-}
+
+instance (FactorialMonoid a, FactorialMonoid b) => Factorial (Stateful a b) where
+   factors (Stateful x) = List.map Stateful (factors x)
+   length (Stateful x) = length x
+   reverse (Stateful x) = Stateful (reverse x)
+   primePrefix (Stateful x) = Stateful (primePrefix x)
+   primeSuffix (Stateful x) = Stateful (primeSuffix x)
+   foldl f a0 (Stateful x) = Factorial.foldl f' a0 x
+      where f' a x1 = f a (Stateful x1)
+   foldl' f a0 (Stateful x) = Factorial.foldl' f' a0 x
+      where f' a x1 = f a (Stateful x1)
+   foldr f a (Stateful x) = Factorial.foldr (f . Stateful) a x
+   foldMap f (Stateful x) = Factorial.foldMap (f . Stateful) x
+   {-# INLINE primePrefix #-}
+   {-# INLINE primeSuffix #-}
+   {-# INLINE foldl' #-}
+   {-# INLINE foldr #-}
+   {-# INLINE foldMap #-}
+   {-# INLINE length #-}
+
+instance (FactorialMonoid a, FactorialMonoid b) => FactorialMonoid (Stateful a b) where
+   splitPrimePrefix (Stateful x) = do (xp, xs) <- splitPrimePrefix x
+                                      return (Stateful xp, Stateful xs)
+   splitPrimeSuffix (Stateful x) = do (xp, xs) <- splitPrimeSuffix x
+                                      return (Stateful xp, Stateful xs)
+   span p (Stateful x) = (Stateful xp, Stateful xs)
+      where (xp, xs) = Factorial.span (p . Stateful) x
+   spanMaybe s0 f (Stateful x) = (Stateful xp, Stateful xs, s')
+      where (xp, xs, s') = Factorial.spanMaybe s0 f' x
+            f' s x1 = f s (Stateful x1)
+   spanMaybe' s0 f (Stateful x) = (Stateful xp, Stateful xs, s')
+      where (xp, xs, s') = Factorial.spanMaybe' s0 f' x
+            f' s x1 = f s (Stateful x1)
+   split p (Stateful x) = List.map Stateful (Factorial.split (p . Stateful) x)
+   splitAt n (Stateful x) = (Stateful xp, Stateful xs)
+      where (xp, xs) = splitAt n x
+   take n (Stateful x) = Stateful (take n x)
+   drop n (Stateful x) = Stateful (drop n x)
+   {-# INLINE splitPrimePrefix #-}
+   {-# INLINE splitPrimeSuffix #-}
+   {-# INLINE span #-}
+   {-# INLINE spanMaybe #-}
+   {-# INLINE spanMaybe' #-}
+   {-# INLINE splitAt #-}
+   {-# INLINE take #-}
+   {-# INLINE drop #-}
+
+instance (FactorialMonoid a, FactorialMonoid b, StableFactorial a, StableFactorial b) => StableFactorial (Stateful a b)
+
+instance (Monoid a, IsString b) => IsString (Stateful a b) where
+   fromString = pure . fromString
+
+instance (LeftGCDMonoid a, FactorialMonoid a, TextualMonoid b) => TextualMonoid (Stateful a b) where
+   fromText t = Stateful (fromText t, mempty)
+   singleton c = Stateful (singleton c, mempty)
+
+   characterPrefix = characterPrefix . extract
+   splitCharacterPrefix (Stateful (t, x)) = do (c, t') <- splitCharacterPrefix t
+                                               return (c, Stateful (t', x))
+
+   map f (Stateful (t, x)) = Stateful (Textual.map f t, x)
+   all p = all p . extract
+   any p = any p . extract
+
+   foldl fx fc a0 (Stateful (t, x)) = Factorial.foldl f2 (Textual.foldl f1 fc a0 t) x
+      where f1 a = fx a . fromFst
+            f2 a = fx a . fromSnd
+   foldr fx fc a (Stateful (t, x)) = Textual.foldr (fx . fromFst) fc (Factorial.foldr (fx . fromSnd) a x) t
+   foldl' fx fc a0 (Stateful (t, x)) = a' `seq` Factorial.foldl' f2 a' x
+      where a' = Textual.foldl' f1 fc a0 t
+            f1 a = fx a . fromFst
+            f2 a = fx a . fromSnd
+   foldl_' fc a (Stateful (t, _)) = foldl_' fc a t
+   foldr_ fc a (Stateful (t, _)) = Textual.foldr_ fc a t
+   toString fx (Stateful (t, x)) = toString (fx . fromFst) t ++ Factorial.foldMap (fx . fromSnd) x
+
+   scanl f c (Stateful (t, x)) = Stateful (Textual.scanl f c t, x)
+   scanl1 f (Stateful (t, x)) = Stateful (Textual.scanl1 f t, x)
+   scanr f c (Stateful (t, x)) = Stateful (Textual.scanr f c t, x)
+   scanr1 f (Stateful (t, x)) = Stateful (Textual.scanr1 f t, x)
+   mapAccumL f a (Stateful (t, x)) = (a', Stateful (t', x))
+      where (a', t') = Textual.mapAccumL f a t
+   mapAccumR f a (Stateful (t, x)) = (a', Stateful (t', x))
+      where (a', t') = Textual.mapAccumR f a t
+
+   span pt pc (Stateful (t, x)) = (Stateful (tp, xp), Stateful (ts, xs))
+      where (tp, ts) = Textual.span (pt . fromFst) pc t
+            (xp, xs) | null ts = Factorial.span (pt . fromSnd) x
+                     | otherwise = (mempty, x)
+   span_ bt pc (Stateful (t, x)) = (Stateful (tp, xp), Stateful (ts, xs))
+      where (tp, ts) = Textual.span_ bt pc t
+            (xp, xs) | null ts && bt = (x, mempty)
+                     | otherwise = (mempty, x)
+   break pt pc (Stateful (t, x)) = (Stateful (tp, xp), Stateful (ts, xs))
+      where (tp, ts) = Textual.break (pt . fromFst) pc t
+            (xp, xs) | null ts = Factorial.break (pt . fromSnd) x
+                     | otherwise = (mempty, x)
+   spanMaybe s0 ft fc (Stateful (t, x)) = (Stateful (tp, xp), Stateful (ts, xs), s'')
+      where (tp, ts, s') = Textual.spanMaybe s0 ft' fc t
+            (xp, xs, s'') | null ts = Factorial.spanMaybe s' ft'' x
+                          | otherwise = (mempty, x, s')
+            ft' s t1 = ft s (Stateful (t1, mempty))
+            ft'' s x1 = ft s (Stateful (mempty, x1))
+   spanMaybe' s0 ft fc (Stateful (t, x)) = (Stateful (tp, xp), Stateful (ts, xs), s'')
+      where (tp, ts, s') = Textual.spanMaybe' s0 ft' fc t
+            (xp, xs, s'') | null ts = Factorial.spanMaybe' s' ft'' x
+                          | otherwise = (mempty, x, s')
+            ft' s t1 = ft s (Stateful (t1, mempty))
+            ft'' s x1 = ft s (Stateful (mempty, x1))
+   spanMaybe_' s0 fc (Stateful (t, x)) = (Stateful (tp, xp), Stateful (ts, xs), s')
+      where (tp, ts, s') = Textual.spanMaybe_' s0 fc t
+            (xp, xs) | null ts = (x, mempty)
+                     | otherwise = (mempty, x)
+   split p (Stateful (t, x)) = restore id ts
+      where ts = Textual.split p t
+            restore f [t1] = f [Stateful (t1, x)]
+            restore f ~(hd:tl) = restore (f . (Stateful (hd, mempty):)) tl
+   find p = find p . extract
+   elem c = elem c . extract
+
+   {-# INLINE characterPrefix #-}
+   {-# INLINE splitCharacterPrefix #-}
+   {-# INLINE map #-}
+   {-# INLINE foldl' #-}
+   {-# INLINE foldr #-}
+   {-# INLINE spanMaybe' #-}
+   {-# INLINE span #-}
+   {-# INLINE spanMaybe_' #-}
+   {-# INLINE span_ #-}
+   {-# INLINE any #-}
+   {-# INLINE all #-}
+   {-# INLINE split #-}
+   {-# INLINE find #-}
+   {-# INLINE elem #-}
+
+{-# INLINE fromFst #-}
+fromFst :: Monoid b => a -> Stateful b a
+fromFst a = Stateful (a, mempty)
+
+{-# INLINE fromSnd #-}
+fromSnd :: Monoid a => b -> Stateful b a
+fromSnd b = Stateful (mempty, b)
diff --git a/src/Data/Monoid/Monus.hs b/src/Data/Monoid/Monus.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Monus.hs
@@ -0,0 +1,344 @@
+{- 
+    Copyright 2013-2019 Mario Blazevic
+
+    License: BSD3 (see BSD3-LICENSE.txt file)
+-}
+
+-- | This module defines the 'OverlappingGCDMonoid' => 'Monus' subclass of the 'Monoid' class.
+--
+-- @since 1.0
+
+{-# LANGUAGE Haskell2010, FlexibleInstances, Trustworthy #-}
+
+module Data.Monoid.Monus (
+   Monus(..), OverlappingGCDMonoid(..)
+   )
+where
+   
+import Data.Monoid -- (Monoid, Dual(..), Sum(..), Product(..))
+import qualified Data.ByteString 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 Data.Sequence (ViewL((:<)), (|>))
+import qualified Data.Vector as Vector
+import Numeric.Natural (Natural)
+
+import Data.Semigroup.Cancellative
+import Data.Monoid.Null (MonoidNull(null))
+
+import Prelude hiding (null)
+
+-- | Class of Abelian monoids with monus. The monus operation '<\>' is a synonym for both 'stripPrefixOverlap' and
+-- 'stripSuffixOverlap', which must be equivalent as '<>' is both associative and commutative:
+--
+-- > (<\>) = flip stripPrefixOverlap
+-- > (<\>) = flip stripSuffixOverlap
+--
+-- @since 1.0
+class (Commutative m, Monoid m, OverlappingGCDMonoid m) => Monus m where
+   (<\>) :: m -> m -> m
+
+infix 5 <\>
+
+-- | Class of monoids for which the greatest overlap can be found between any two values, such that
+--
+-- > a == a' <> overlap a b
+-- > b == overlap a b <> b'
+--
+-- The methods must satisfy the following laws:
+--
+-- > stripOverlap a b == (stripSuffixOverlap b a, overlap a b, stripPrefixOverlap a b)
+-- > stripSuffixOverlap b a <> overlap a b == a
+-- > overlap a b <> stripPrefixOverlap a b == b
+--
+-- The result of @overlap a b@ must be the largest prefix of @b@ and suffix of @a@, in the sense that it is contained
+-- in any other value @x@ that satifies the property @(x `isPrefixOf` b) && (x `isSuffixOf` a)@:
+--
+-- > (x `isPrefixOf` overlap a b) && (x `isSuffixOf` overlap a b)
+--
+-- and it must be unique so it's not contained in any other value @y@ that satisfies the same property @(y
+-- `isPrefixOf` b) && (y `isSuffixOf` a)@:
+--
+-- > not ((y `isPrefixOf` overlap a b) && (y `isSuffixOf` overlap a b) && y /= overlap a b)
+--
+-- @since 1.0
+class (Monoid m, LeftReductive m, RightReductive m) => OverlappingGCDMonoid m where
+   stripPrefixOverlap :: m -> m -> m
+   stripSuffixOverlap :: m -> m -> m
+   overlap :: m -> m -> m
+   stripOverlap :: m -> m -> (m, m, m)
+
+   stripPrefixOverlap a b = b'
+      where (_, _, b') = stripOverlap a b
+   stripSuffixOverlap a b = b'
+      where (b', _, _) = stripOverlap b a
+   overlap a b = o
+      where (_, o, _) = stripOverlap a b
+   {-# MINIMAL stripOverlap #-}
+
+-- Unit instances
+
+-- | /O(1)/
+instance Monus () where
+   () <\> () = ()
+
+-- | /O(1)/
+instance OverlappingGCDMonoid () where
+   overlap () () = ()
+   stripOverlap () () = ((), (), ())
+   stripPrefixOverlap () () = ()
+   stripSuffixOverlap () () = ()
+
+-- Dual instances
+
+instance Monus a => Monus (Dual a) where
+   Dual a <\> Dual b = Dual (a <\> b)
+
+instance OverlappingGCDMonoid a => OverlappingGCDMonoid (Dual a) where
+   overlap (Dual a) (Dual b) = Dual (overlap b a)
+   stripOverlap (Dual a) (Dual b) = (Dual s, Dual o, Dual p)
+      where (p, o, s) = stripOverlap b a
+   stripPrefixOverlap (Dual a) (Dual b) = Dual (stripSuffixOverlap a b)
+   stripSuffixOverlap (Dual a) (Dual b) = Dual (stripPrefixOverlap a b)
+
+-- Sum instances
+
+-- | /O(1)/
+instance Monus (Sum Natural) where
+   Sum a <\> Sum b
+      | a > b = Sum (a - b)
+      | otherwise = Sum 0
+
+-- | /O(1)/
+instance OverlappingGCDMonoid (Sum Natural) where
+   overlap (Sum a) (Sum b) = Sum (min a b)
+   stripOverlap (Sum a) (Sum b) = (Sum $ a - c, Sum c, Sum $ b - c)
+      where c = min a b
+   stripPrefixOverlap = flip (<\>)
+   stripSuffixOverlap = flip (<\>)
+
+-- Product instances
+
+-- | /O(1)/
+instance Monus (Product Natural) where
+   Product 0 <\> Product 0 = Product 1
+   Product a <\> Product b = Product (a `div` Prelude.gcd a b)
+
+-- | /O(1)/
+instance OverlappingGCDMonoid (Product Natural) where
+   overlap (Product a) (Product b) = Product (gcd a b)
+   stripOverlap (Product 0) (Product 0) = (Product 1, Product 0, Product 1)
+   stripOverlap (Product a) (Product b) = (Product $ div a c, Product c, Product $ div b c)
+      where c = gcd a b
+   stripPrefixOverlap = flip (<\>)
+   stripSuffixOverlap = flip (<\>)
+
+-- Pair instances
+
+instance (Monus a, Monus b) => Monus (a, b) where
+   (a1, b1) <\> (a2, b2) = (a1 <\> a2, b1 <\> b2)
+
+instance (OverlappingGCDMonoid a, OverlappingGCDMonoid b) => OverlappingGCDMonoid (a, b) where
+   overlap (a1, b1) (a2, b2) = (overlap a1 a2, overlap b1 b2)
+   stripOverlap (a1, b1) (a2, b2) = ((ap, bp), (ao, bo), (as, bs))
+      where (ap, ao, as) = stripOverlap a1 a2
+            (bp, bo, bs) = stripOverlap b1 b2
+   stripPrefixOverlap (a1, b1) (a2, b2) = (stripPrefixOverlap a1 a2, stripPrefixOverlap b1 b2)
+   stripSuffixOverlap (a1, b1) (a2, b2) = (stripSuffixOverlap a1 a2, stripSuffixOverlap b1 b2)
+
+-- Triple instances
+
+instance (Monus a, Monus b, Monus c) => Monus (a, b, c) where
+   (a1, b1, c1) <\> (a2, b2, c2) = (a1 <\> a2, b1 <\> b2, c1 <\> c2)
+
+instance (OverlappingGCDMonoid a, OverlappingGCDMonoid b, OverlappingGCDMonoid c) =>
+         OverlappingGCDMonoid (a, b, c) where
+   overlap (a1, b1, c1) (a2, b2, c2) = (overlap a1 a2, overlap b1 b2, overlap c1 c2)
+   stripOverlap (a1, b1, c1) (a2, b2, c2) = ((ap, bp, cp), (ao, bo, co), (as, bs, cs))
+      where (ap, ao, as) = stripOverlap a1 a2
+            (bp, bo, bs) = stripOverlap b1 b2
+            (cp, co, cs) = stripOverlap c1 c2
+   stripPrefixOverlap (a1, b1, c1) (a2, b2, c2) = (stripPrefixOverlap a1 a2, stripPrefixOverlap b1 b2, stripPrefixOverlap c1 c2)
+   stripSuffixOverlap (a1, b1, c1) (a2, b2, c2) = (stripSuffixOverlap a1 a2, stripSuffixOverlap b1 b2, stripSuffixOverlap c1 c2)
+
+-- Quadruple instances
+
+instance (Monus a, Monus b, Monus c, Monus d) => Monus (a, b, c, d) where
+   (a1, b1, c1, d1) <\> (a2, b2, c2, d2) = (a1 <\> a2, b1 <\> b2, c1 <\> c2, d1 <\> d2)
+
+instance (OverlappingGCDMonoid a, OverlappingGCDMonoid b, OverlappingGCDMonoid c, OverlappingGCDMonoid d) =>
+         OverlappingGCDMonoid (a, b, c, d) where
+   overlap (a1, b1, c1, d1) (a2, b2, c2, d2) = (overlap a1 a2, overlap b1 b2, overlap c1 c2, overlap d1 d2)
+   stripOverlap (a1, b1, c1, d1) (a2, b2, c2, d2) = ((ap, bp, cp, dp), (ao, bo, co, dm), (as, bs, cs, ds))
+      where (ap, ao, as) = stripOverlap a1 a2
+            (bp, bo, bs) = stripOverlap b1 b2
+            (cp, co, cs) = stripOverlap c1 c2
+            (dp, dm, ds) = stripOverlap d1 d2
+   stripPrefixOverlap (a1, b1, c1, d1) (a2, b2, c2, d2) =
+      (stripPrefixOverlap a1 a2, stripPrefixOverlap b1 b2, stripPrefixOverlap c1 c2, stripPrefixOverlap d1 d2)
+   stripSuffixOverlap (a1, b1, c1, d1) (a2, b2, c2, d2) =
+      (stripSuffixOverlap a1 a2, stripSuffixOverlap b1 b2, stripSuffixOverlap c1 c2, stripSuffixOverlap d1 d2)
+
+-- Maybe instances
+
+instance (Monus a, MonoidNull a) => Monus (Maybe a) where
+   Just a <\> Just b = Just (a <\> b)
+   Nothing <\> _ = Nothing
+   x <\> Nothing = x
+
+instance (OverlappingGCDMonoid a, MonoidNull a) => OverlappingGCDMonoid (Maybe a) where
+   overlap (Just a) (Just b) = Just (overlap a b)
+   overlap _ _ = Nothing
+   stripOverlap (Just a) (Just b) = (Just a', Just o, Just b')
+      where (a', o, b') = stripOverlap a b
+   stripOverlap a b = (a, Nothing, b)
+   stripPrefixOverlap (Just a) (Just b)
+      | null b' = Nothing
+      | otherwise = Just b'
+      where b' = stripPrefixOverlap a b
+   stripPrefixOverlap Nothing x = x
+   stripPrefixOverlap _ Nothing = Nothing
+   stripSuffixOverlap (Just a) (Just b)
+      | null b' = Nothing
+      | otherwise = Just b'
+      where b' = stripSuffixOverlap a b
+   stripSuffixOverlap Nothing x = x
+   stripSuffixOverlap _ Nothing = Nothing
+
+-- Set instances
+
+-- | /O(m*log(n/m + 1)), m <= n/
+instance Ord a => Monus (Set.Set a) where
+   (<\>) = (Set.\\)
+
+-- | /O(m*log(n/m + 1)), m <= n/
+instance Ord a => OverlappingGCDMonoid (Set.Set a) where
+   overlap = Set.intersection
+   stripOverlap a b = (Set.difference a b, Set.intersection a b, Set.difference b a)
+   stripPrefixOverlap a b = b <\> a
+   stripSuffixOverlap a b = b <\> a
+
+-- IntSet instances
+
+-- | /O(m+n)/
+instance Monus IntSet.IntSet where
+   (<\>) = (IntSet.\\)
+
+-- | /O(m+n)/
+instance OverlappingGCDMonoid IntSet.IntSet where
+   overlap = IntSet.intersection
+   stripOverlap a b = (IntSet.difference a b, IntSet.intersection a b, IntSet.difference b a)
+   stripPrefixOverlap a b = b <\> a
+   stripSuffixOverlap a b = b <\> a
+
+-- Map instances
+
+-- | /O(m+n)/
+instance (Ord k, Eq v) => OverlappingGCDMonoid (Map.Map k v) where
+    overlap = Map.intersection
+    stripOverlap a b = (stripPrefixOverlap b a, overlap a b, stripSuffixOverlap a b)
+    stripPrefixOverlap = flip Map.difference
+    stripSuffixOverlap a b = Map.differenceWith (\x y-> if x == y then Nothing else Just x) b a
+
+-- IntMap instances
+
+-- | /O(m+n)/
+instance Eq a => OverlappingGCDMonoid (IntMap.IntMap a) where
+    overlap = IntMap.intersection
+    stripOverlap a b = (stripPrefixOverlap b a, overlap a b, stripSuffixOverlap a b)
+    stripPrefixOverlap = flip IntMap.difference
+    stripSuffixOverlap a b = IntMap.differenceWith (\x y-> if x == y then Nothing else Just x) b a
+
+-- List instances
+
+-- | /O(m*n)/
+instance Eq a => OverlappingGCDMonoid [a] where
+   overlap a b = go a
+      where go x | x `isPrefixOf` b = x
+                 | otherwise = go (tail x)
+   stripOverlap a b = go [] a
+      where go p o | Just s <- stripPrefix o b = (reverse p, o, s)
+                   | x:xs <- o = go (x:p) xs
+                   | otherwise = error "impossible"
+   stripPrefixOverlap a b = go a
+      where go x | Just s <- stripPrefix x b = s
+                 | otherwise = go (tail x)
+
+-- Seq instances
+
+-- | /O(min(m,n)^2)/
+instance Eq a => OverlappingGCDMonoid (Sequence.Seq a) where
+   overlap a b = go (Sequence.drop (Sequence.length a - Sequence.length b) a)
+      where go x | x `isPrefixOf` b = x
+                 | _ :< x' <- Sequence.viewl x = go x'
+                 | otherwise = error "impossible"
+   stripOverlap a b = uncurry go (Sequence.splitAt (Sequence.length a - Sequence.length b) a)
+      where go p o | Just s <- stripPrefix o b = (p, o, s)
+                   | x :< xs <- Sequence.viewl o = go (p |> x) xs
+                   | otherwise = error "impossible"
+
+-- Vector instances
+
+-- | /O(min(m,n)^2)/
+instance Eq a => OverlappingGCDMonoid (Vector.Vector a) where
+   stripOverlap a b = go (max alen blen)
+      where alen = Vector.length a
+            blen = Vector.length b
+            go i | as == bp = (ap, as, bs)
+                 | otherwise = go (pred i)
+               where (ap, as) = Vector.splitAt (alen - i) a
+                     (bp, bs) = Vector.splitAt i b
+
+-- ByteString instances
+
+-- | /O(min(m,n)^2)/
+instance OverlappingGCDMonoid ByteString.ByteString where
+   stripOverlap a b = go (max alen blen)
+      where alen = ByteString.length a
+            blen = ByteString.length b
+            go i | as == bp = (ap, as, bs)
+                 | otherwise = go (pred i)
+               where (ap, as) = ByteString.splitAt (alen - i) a
+                     (bp, bs) = ByteString.splitAt i b
+
+-- Lazy ByteString instances
+
+-- | /O(m*n)/
+instance OverlappingGCDMonoid LazyByteString.ByteString where
+   stripOverlap a b = go (max alen blen)
+      where alen = LazyByteString.length a
+            blen = LazyByteString.length b
+            go i | as == bp = (ap, as, bs)
+                 | otherwise = go (pred i)
+               where (ap, as) = LazyByteString.splitAt (alen - i) a
+                     (bp, bs) = LazyByteString.splitAt i b
+
+-- Text instances
+
+-- | /O(min(m,n)^2)/
+instance OverlappingGCDMonoid Text.Text where
+   stripOverlap a b
+      | Text.null b = (a, b, b)
+      | otherwise = go (Text.breakOnAll (Text.take 1 b) a)
+      where go [] = (a, mempty, b)
+            go ((ap, as):breaks)
+               | Just bs <- Text.stripPrefix as b = (ap, as, bs)
+               | otherwise = go breaks
+
+-- Lazy Text instances
+
+-- | /O(m*n)/
+instance OverlappingGCDMonoid LazyText.Text where
+   stripOverlap a b
+      | LazyText.null b = (a, b, b)
+      | otherwise = go (LazyText.breakOnAll (LazyText.take 1 b) a)
+      where go [] = (a, mempty, b)
+            go ((ap, as):breaks)
+               | Just bs <- LazyText.stripPrefix as b = (ap, as, bs)
+               | otherwise = go breaks
diff --git a/src/Data/Monoid/Null.hs b/src/Data/Monoid/Null.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Null.hs
@@ -0,0 +1,151 @@
+{- 
+    Copyright 2013-2015 Mario Blazevic
+
+    License: BSD3 (see BSD3-LICENSE.txt file)
+-}
+
+-- | This module defines the MonoidNull class and some of its instances.
+-- 
+
+{-# LANGUAGE Haskell2010, FlexibleInstances, Trustworthy #-}
+
+module Data.Monoid.Null (
+   MonoidNull(..), PositiveMonoid
+   )
+where
+   
+import Data.Monoid -- (Monoid, First(..), Last(..), Dual(..), Sum(..), Product(..), All(getAll), Any(getAny))
+import qualified Data.List as List
+import qualified Data.ByteString 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 Prelude hiding (null)
+
+-- | Extension of 'Monoid' that allows testing a value for equality with 'mempty'. The following law must hold:
+-- 
+-- prop> null x == (x == mempty)
+-- 
+-- Furthermore, the performance of this method should be constant, /i.e./, independent of the length of its argument.
+class Monoid m => MonoidNull m where
+   null :: m -> Bool
+
+-- | Subclass of 'Monoid' for types whose values have no inverse, with the exception of 'Data.Monoid.mempty'. More
+-- formally, the class instances must satisfy the following law:
+-- 
+-- prop> null (x <> y) == (null x && null y)
+class MonoidNull m => PositiveMonoid m
+
+instance MonoidNull () where
+   null () = True
+
+instance MonoidNull Ordering where
+   null = (== EQ)
+
+instance MonoidNull All where
+   null = getAll
+
+instance MonoidNull Any where
+   null = not . getAny
+
+instance MonoidNull (First a) where
+   null (First Nothing) = True
+   null _ = False
+
+instance MonoidNull (Last a) where
+   null (Last Nothing) = True
+   null _ = False
+
+instance MonoidNull a => MonoidNull (Dual a) where
+   null (Dual a) = null a
+
+instance (Num a, Eq a) => MonoidNull (Sum a) where
+   null (Sum a) = a == 0
+
+instance (Num a, Eq a) => MonoidNull (Product a) where
+   null (Product a) = a == 1
+
+instance Monoid a => MonoidNull (Maybe a) where
+   null Nothing = True
+   null _ = False
+
+instance (MonoidNull a, MonoidNull b) => MonoidNull (a, b) where
+   null (a, b) = null a && null b
+
+instance (MonoidNull a, MonoidNull b, MonoidNull c) => MonoidNull (a, b, c) where
+   null (a, b, c) = null a && null b && null c
+
+instance (MonoidNull a, MonoidNull b, MonoidNull c, MonoidNull d) => MonoidNull (a, b, c, d) where
+   null (a, b, c, d) = null a && null b && null c && null d
+
+instance MonoidNull [x] where
+   null = List.null
+
+instance MonoidNull ByteString.ByteString where
+   null = ByteString.null
+   {-# INLINE null #-}
+
+instance MonoidNull LazyByteString.ByteString where
+   null = LazyByteString.null
+   {-# INLINE null #-}
+
+instance MonoidNull Text.Text where
+   null = Text.null
+   {-# INLINE null #-}
+
+instance MonoidNull LazyText.Text where
+   null = LazyText.null
+   {-# INLINE null #-}
+
+instance Ord k => MonoidNull (Map.Map k v) where
+   null = Map.null
+
+instance MonoidNull (IntMap.IntMap v) where
+   null = IntMap.null
+
+instance MonoidNull IntSet.IntSet where
+   null = IntSet.null
+
+instance MonoidNull (Sequence.Seq a) where
+   null = Sequence.null
+
+instance Ord a => MonoidNull (Set.Set a) where
+   null = Set.null
+
+instance MonoidNull (Vector.Vector a) where
+   null = Vector.null
+
+instance PositiveMonoid ()
+instance PositiveMonoid Ordering
+instance PositiveMonoid All
+instance PositiveMonoid Any
+instance PositiveMonoid ByteString.ByteString
+instance PositiveMonoid LazyByteString.ByteString
+instance PositiveMonoid Text.Text
+instance PositiveMonoid LazyText.Text
+instance PositiveMonoid (Product Natural)
+instance PositiveMonoid (Sum Natural)
+instance Monoid a => PositiveMonoid (Maybe a)
+instance PositiveMonoid (First a)
+instance PositiveMonoid (Last a)
+instance PositiveMonoid a => PositiveMonoid (Dual a)
+instance PositiveMonoid [x]
+instance Ord k => PositiveMonoid (Map.Map k v)
+instance PositiveMonoid (IntMap.IntMap v)
+instance PositiveMonoid IntSet.IntSet
+instance PositiveMonoid (Sequence.Seq a)
+instance Ord a => PositiveMonoid (Set.Set a)
+instance PositiveMonoid (Vector.Vector a)
+
+-- The possible tuple instances would be overlapping, so we leave the choice to the user.
+--
+-- instance (PositiveMonoid a, Monoid b) => PositiveMonoid (a, b)
+-- instance (Monoid a, PositiveMonoid b) => PositiveMonoid (a, b)
diff --git a/src/Data/Monoid/Textual.hs b/src/Data/Monoid/Textual.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Monoid/Textual.hs
@@ -0,0 +1,543 @@
+{- 
+    Copyright 2013-2017 Mario Blazevic
+
+    License: BSD3 (see BSD3-LICENSE.txt file)
+-}
+
+-- | This module defines the 'TextualMonoid' class and several of its instances.
+-- 
+
+{-# LANGUAGE Haskell2010, FlexibleInstances #-}
+
+module Data.Monoid.Textual (
+   TextualMonoid(..)
+   )
+where
+
+import qualified Data.Foldable as Foldable
+import qualified Data.Traversable as Traversable
+import Data.Functor -- ((<$>))
+import qualified Data.List as List
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy as LazyText
+import Data.Text (Text)
+import Data.Monoid -- (Monoid(mappend, mempty))
+import qualified Data.Sequence as Sequence
+import Data.String (IsString(fromString))
+import Data.Int (Int64)
+
+import Data.Semigroup.Cancellative (LeftReductive)
+import Data.Monoid.GCD (LeftGCDMonoid)
+import Data.Monoid.Factorial (FactorialMonoid)
+import qualified Data.Monoid.Factorial as Factorial
+
+import Prelude hiding (all, any, break, concatMap, dropWhile, foldl, foldl1, foldr, foldr1, map,
+                       scanl, scanl1, scanr, scanr1, span, takeWhile)
+
+-- | The 'TextualMonoid' class is an extension of 'FactorialMonoid' specialized for monoids that can contain
+-- characters. Its methods are generally equivalent to their namesake functions from "Data.List" and "Data.Text", and
+-- they satisfy the following laws:
+-- 
+-- > unfoldr splitCharacterPrefix . fromString == id
+-- > splitCharacterPrefix . primePrefix == fmap (\(c, t)-> (c, mempty)) . splitCharacterPrefix
+-- >
+-- > map f . fromString == fromString . List.map f
+-- > concatMap (fromString . f) . fromString == fromString . List.concatMap f
+-- >
+-- > foldl  ft fc a . fromString == List.foldl  fc a
+-- > foldr  ft fc a . fromString == List.foldr  fc a
+-- > foldl' ft fc a . fromString == List.foldl' fc a
+-- >
+-- > scanl f c . fromString == fromString . List.scanl f c
+-- > scanr f c . fromString == fromString . List.scanr f c
+-- > mapAccumL f a . fromString == fmap fromString . List.mapAccumL f a
+-- > mapAccumL f a . fromString == fmap fromString . List.mapAccumL f a
+-- >
+-- > takeWhile pt pc . fromString == fromString . takeWhile pc
+-- > dropWhile pt pc . fromString == fromString . dropWhile pc
+-- >
+-- > mconcat . intersperse (singleton c) . split (== c) == id
+-- > find p . fromString == List.find p
+-- > elem c . fromString == List.elem c
+--
+-- A 'TextualMonoid' may contain non-character data insterspersed between its characters. Every class method that
+-- returns a modified 'TextualMonoid' instance generally preserves this non-character data. Methods like 'foldr' can
+-- access both the non-character and character data and expect two arguments for the two purposes. For each of these
+-- methods there is also a simplified version with underscore in name (like 'foldr_') that ignores the non-character
+-- data.
+--
+-- All of the following expressions are identities:
+--
+-- > map id
+-- > concatMap singleton
+-- > foldl  (<>) (\a c-> a <> singleton c) mempty
+-- > foldr  (<>) ((<>) . singleton) mempty
+-- > foldl' (<>) (\a c-> a <> singleton c) mempty
+-- > scanl1 (const id)
+-- > scanr1 const
+-- > uncurry (mapAccumL (,))
+-- > uncurry (mapAccumR (,))
+-- > takeWhile (const True) (const True)
+-- > dropWhile (const False) (const False)
+-- > toString undefined . fromString
+
+class (IsString t, LeftReductive t, LeftGCDMonoid t, FactorialMonoid t) => TextualMonoid t where
+   -- | Contructs a new data type instance Like 'fromString', but from a 'Text' input instead of 'String'.
+   --
+   -- > fromText == fromString . Text.unpack
+   fromText :: Text -> t
+   -- | Creates a prime monoid containing a single character.
+   --
+   -- > singleton c == fromString [c]
+   singleton :: Char -> t
+   -- | Specialized version of 'Factorial.splitPrimePrefix'. Every prime factor of a 'Textual' monoid must consist of a
+   -- single character or no character at all.
+   splitCharacterPrefix :: t -> Maybe (Char, t)
+   -- | Extracts a single character that prefixes the monoid, if the monoid begins with a character. Otherwise returns
+   -- 'Nothing'.
+   --
+   -- > characterPrefix == fmap fst . splitCharacterPrefix
+   characterPrefix :: t -> Maybe Char
+   -- | Equivalent to 'List.map' from "Data.List" with a @Char -> Char@ function. Preserves all non-character data.
+   --
+   -- > map f == concatMap (singleton . f)
+   map :: (Char -> Char) -> t -> t
+   -- | Equivalent to 'List.concatMap' from "Data.List" with a @Char -> String@ function. Preserves all non-character
+   -- data.
+   concatMap :: (Char -> t) -> t -> t
+   -- | Returns the list of characters the monoid contains, once the argument function converts all its non-character
+   -- factors into characters.
+   toString :: (t -> String) -> t -> String
+   -- | Equivalent to 'List.any' from "Data.List". Ignores all non-character data.
+   any :: (Char -> Bool) -> t -> Bool
+   -- | Equivalent to 'List.all' from "Data.List". Ignores all non-character data.
+   all :: (Char -> Bool) -> t -> Bool
+
+   -- | The first argument folds over the non-character prime factors, the second over characters. Otherwise equivalent
+   -- to 'List.foldl' from "Data.List".
+   foldl   :: (a -> t -> a) -> (a -> Char -> a) -> a -> t -> a
+   -- | Strict version of 'foldl'.
+   foldl'  :: (a -> t -> a) -> (a -> Char -> a) -> a -> t -> a
+   -- | The first argument folds over the non-character prime factors, the second over characters. Otherwise equivalent
+   -- to 'List.foldl\'' from "Data.List".
+   foldr   :: (t -> a -> a) -> (Char -> a -> a) -> a -> t -> a
+
+   -- | Equivalent to 'List.scanl' from "Data.List" when applied to a 'String', but preserves all non-character data.
+   scanl :: (Char -> Char -> Char) -> Char -> t -> t
+   -- | Equivalent to 'List.scanl1' from "Data.List" when applied to a 'String', but preserves all non-character data.
+   --
+   -- > scanl f c == scanl1 f . (singleton c <>)
+   scanl1 :: (Char -> Char -> Char) -> t -> t
+   -- | Equivalent to 'List.scanr' from "Data.List" when applied to a 'String', but preserves all non-character data.
+   scanr :: (Char -> Char -> Char) -> Char -> t -> t
+   -- | Equivalent to 'List.scanr1' from "Data.List" when applied to a 'String', but preserves all non-character data.
+   --
+   -- > scanr f c == scanr1 f . (<> singleton c)
+   scanr1 :: (Char -> Char -> Char) -> t -> t
+   -- | Equivalent to 'List.mapAccumL' from "Data.List" when applied to a 'String', but preserves all non-character
+   -- data.
+   mapAccumL :: (a -> Char -> (a, Char)) -> a -> t -> (a, t)
+   -- | Equivalent to 'List.mapAccumR' from "Data.List" when applied to a 'String', but preserves all non-character
+   -- data.
+   mapAccumR :: (a -> Char -> (a, Char)) -> a -> t -> (a, t)
+
+   -- | The first predicate tests the non-character data, the second one the characters. Otherwise equivalent to
+   -- 'List.takeWhile' from "Data.List" when applied to a 'String'.
+   takeWhile :: (t -> Bool) -> (Char -> Bool) -> t -> t
+   -- | The first predicate tests the non-character data, the second one the characters. Otherwise equivalent to
+   -- 'List.dropWhile' from "Data.List" when applied to a 'String'.
+   dropWhile :: (t -> Bool) -> (Char -> Bool) -> t -> t
+   -- | 'break pt pc' is equivalent to @span (not . pt) (not . pc)@.
+   break :: (t -> Bool) -> (Char -> Bool) -> t -> (t, t)
+   -- | 'span pt pc t' is equivalent to @(takeWhile pt pc t, dropWhile pt pc t)@.
+   span :: (t -> Bool) -> (Char -> Bool) -> t -> (t, t)
+   -- | A stateful variant of 'span', threading the result of the test function as long as it returns 'Just'.
+   spanMaybe :: s -> (s -> t -> Maybe s) -> (s -> Char -> Maybe s) -> t -> (t, t, s)
+   -- | Strict version of 'spanMaybe'.
+   spanMaybe' :: s -> (s -> t -> Maybe s) -> (s -> Char -> Maybe s) -> t -> (t, t, s)
+   -- | Splits the monoid into components delimited by character separators satisfying the given predicate. The
+   -- characters satisfying the predicate are not a part of the result.
+   --
+   -- > split p == Factorial.split (maybe False p . characterPrefix)
+   split :: (Char -> Bool) -> t -> [t]
+   -- | Like 'List.find' from "Data.List" when applied to a 'String'. Ignores non-character data.
+   find :: (Char -> Bool) -> t -> Maybe Char
+   -- | Like 'List.elem' from "Data.List" when applied to a 'String'. Ignores non-character data.
+   elem :: Char -> t -> Bool
+
+   -- | > foldl_ = foldl const
+   foldl_   :: (a -> Char -> a) -> a -> t -> a
+   foldl_'  :: (a -> Char -> a) -> a -> t -> a
+   foldr_   :: (Char -> a -> a) -> a -> t -> a
+   -- | > takeWhile_ = takeWhile . const
+   takeWhile_ :: Bool -> (Char -> Bool) -> t -> t
+   -- | > dropWhile_ = dropWhile . const
+   dropWhile_ :: Bool -> (Char -> Bool) -> t -> t
+   -- | > break_ = break . const
+   break_ :: Bool -> (Char -> Bool) -> t -> (t, t)
+   -- | > span_ = span . const
+   span_ :: Bool -> (Char -> Bool) -> t -> (t, t)
+   -- | > spanMaybe_ s = spanMaybe s (const . Just)
+   spanMaybe_ :: s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
+   spanMaybe_' :: s -> (s -> Char -> Maybe s) -> t -> (t, t, s)
+
+
+   fromText = fromString . Text.unpack
+   singleton = fromString . (:[])
+
+   characterPrefix = fmap fst . splitCharacterPrefix
+
+   map f = concatMap (singleton . f)
+   concatMap f = foldr mappend (mappend . f) mempty
+   toString f = foldr (mappend . f) (:) []
+   all p = foldr (const id) ((&&) . p) True
+   any p = foldr (const id) ((||) . p) False
+
+   foldl ft fc = Factorial.foldl (\a prime-> maybe (ft a prime) (fc a) (characterPrefix prime))
+   foldr ft fc = Factorial.foldr (\prime-> maybe (ft prime) fc (characterPrefix prime))
+   foldl' ft fc = Factorial.foldl' (\a prime-> maybe (ft a prime) (fc a) (characterPrefix prime))
+   foldl_ = foldl const
+   foldr_ = foldr (const id)
+   foldl_' = foldl' const
+
+   scanl f c = mappend (singleton c) . fst . foldl foldlOther (foldlChars f) (mempty, c)
+   scanl1 f t = case (Factorial.splitPrimePrefix t, splitCharacterPrefix t)
+                of (Nothing, _) -> t
+                   (Just (prefix, suffix), Nothing) -> mappend prefix (scanl1 f suffix)
+                   (Just _, Just (c, suffix)) -> scanl f c suffix
+   scanr f c = fst . foldr foldrOther (foldrChars f) (singleton c, c)
+   scanr1 f = fst . foldr foldrOther fc (mempty, Nothing)
+      where fc c (t, Nothing) = (mappend (singleton c) t, Just c)
+            fc c1 (t, Just c2) = (mappend (singleton c') t, Just c')
+               where c' = f c1 c2
+   mapAccumL f a0 = foldl ft fc (a0, mempty)
+      where ft (a, t1) t2 = (a, mappend t1 t2)
+            fc (a, t) c = (a', mappend t (singleton c'))
+               where (a', c') = f a c
+   mapAccumR f a0 = foldr ft fc (a0, mempty)
+      where ft t1 (a, t2) = (a, mappend t1 t2)
+            fc c (a, t) = (a', mappend (singleton c') t)
+               where (a', c') = f a c
+
+   takeWhile pt pc = fst . span pt pc
+   dropWhile pt pc = snd . span pt pc
+   span pt pc = Factorial.span (\prime-> maybe (pt prime) pc (characterPrefix prime))
+   break pt pc = Factorial.break (\prime-> maybe (pt prime) pc (characterPrefix prime))
+   spanMaybe s0 ft fc t0 = spanAfter id s0 t0
+      where spanAfter g s t = case Factorial.splitPrimePrefix t
+                              of Just (prime, rest) | Just s' <- maybe (ft s prime) (fc s) (characterPrefix prime) ->
+                                                        spanAfter (g . mappend prime) s' rest
+                                                    | otherwise -> (g mempty, t, s)
+                                 Nothing -> (t0, t, s)
+   spanMaybe' s0 ft fc t0 = spanAfter id s0 t0
+      where spanAfter g s t = seq s $
+                              case Factorial.splitPrimePrefix t
+                              of Just (prime, rest) | Just s' <- maybe (ft s prime) (fc s) (characterPrefix prime) ->
+                                                        spanAfter (g . mappend prime) s' rest
+                                                    | otherwise -> (g mempty, t, s)
+                                 Nothing -> (t0, t, s)
+   takeWhile_ = takeWhile . const
+   dropWhile_ = dropWhile . const
+   break_ = break . const
+   span_ = span . const
+   spanMaybe_ s = spanMaybe s (const . Just)
+   spanMaybe_' s = spanMaybe' s (const . Just)
+
+   split p m = prefix : splitRest
+      where (prefix, rest) = break (const False) p m
+            splitRest = case splitCharacterPrefix rest
+                        of Nothing -> []
+                           Just (_, tl) -> split p tl
+   find p = foldr (const id) (\c r-> if p c then Just c else r) Nothing
+   elem c = any (== c)
+
+   {-# INLINE characterPrefix #-}
+   {-# INLINE concatMap #-}
+   {-# INLINE dropWhile #-}
+   {-# INLINE fromText #-}
+   {-# INLINE map #-}
+   {-# INLINE mapAccumL #-}
+   {-# INLINE mapAccumR #-}
+   {-# INLINE scanl #-}
+   {-# INLINE scanl1 #-}
+   {-# INLINE scanr #-}
+   {-# INLINE scanr1 #-}
+   {-# INLINE singleton #-}
+   {-# INLINE spanMaybe #-}
+   {-# INLINE spanMaybe' #-}
+   {-# INLINE split #-}
+   {-# INLINE takeWhile #-}
+   {-# INLINE foldl_ #-}
+   {-# INLINE foldl_' #-}
+   {-# INLINE foldr_ #-}
+   {-# INLINE spanMaybe_ #-}
+   {-# INLINE spanMaybe_' #-}
+   {-# INLINE span_ #-}
+   {-# INLINE break_ #-}
+   {-# INLINE takeWhile_ #-}
+   {-# INLINE dropWhile_ #-}
+   {-# MINIMAL splitCharacterPrefix #-}
+
+foldlChars :: TextualMonoid t => (Char -> Char -> Char) -> (t, Char) -> Char -> (t, Char)
+foldlOther :: Monoid t => (t, Char) -> t -> (t, Char)
+foldrChars :: TextualMonoid t => (Char -> Char -> Char) -> Char -> (t, Char) -> (t, Char)
+foldrOther :: Monoid t => t -> (t, a) -> (t, a)
+foldlChars f (t, c1) c2 = (mappend t (singleton c'), c')
+   where c' = f c1 c2
+foldlOther (t1, c) t2 = (mappend t1 t2, c)
+foldrChars f c1 (t, c2) = (mappend (singleton c') t, c')
+   where c' = f c1 c2
+foldrOther t1 (t2, c) = (mappend t1 t2, c)
+
+instance TextualMonoid String where
+   fromText = Text.unpack
+   singleton c = [c]
+   splitCharacterPrefix (c:rest) = Just (c, rest)
+   splitCharacterPrefix [] = Nothing
+   characterPrefix (c:_) = Just c
+   characterPrefix [] = Nothing
+   map = List.map
+   concatMap = List.concatMap
+   toString = const id
+   any = List.any
+   all = List.all
+
+   foldl   = const List.foldl
+   foldl'  = const List.foldl'
+   foldr   = const List.foldr
+
+   scanl = List.scanl
+   scanl1 = List.scanl1
+   scanr = List.scanr
+   scanr1 = List.scanr1
+   mapAccumL = List.mapAccumL
+   mapAccumR = List.mapAccumR
+
+   takeWhile _ = List.takeWhile
+   dropWhile _ = List.dropWhile
+   break _ = List.break
+   span _ = List.span
+   spanMaybe s0 _ft fc l = (prefix' [], suffix' [], s')
+      where (prefix', suffix', s', _) = List.foldl' g (id, id, s0, True) l
+            g (prefix, suffix, s, live) c | live, Just s1 <- fc s c = (prefix . (c:), id, s1, True)
+                                          | otherwise = (prefix, suffix . (c:), s, False)
+   spanMaybe' s0 _ft fc l = (prefix' [], suffix' [], s')
+      where (prefix', suffix', s', _) = List.foldl' g (id, id, s0, True) l
+            g (prefix, suffix, s, live) c | live, Just s1 <- fc s c = seq s1 (prefix . (c:), id, s1, True)
+                                          | otherwise = (prefix, suffix . (c:), s, False)
+   find = List.find
+   elem = List.elem
+
+   {-# INLINE all #-}
+   {-# INLINE any #-}
+   {-# INLINE break #-}
+   {-# INLINE characterPrefix #-}
+   {-# INLINE concatMap #-}
+   {-# INLINE dropWhile #-}
+   {-# INLINE elem #-}
+   {-# INLINE find #-}
+   {-# INLINE foldl   #-}
+   {-# INLINE foldl'  #-}
+   {-# INLINE foldr   #-}
+   {-# INLINE fromText #-}
+   {-# INLINE map #-}
+   {-# INLINE mapAccumL #-}
+   {-# INLINE mapAccumR #-}
+   {-# INLINE scanl #-}
+   {-# INLINE scanl1 #-}
+   {-# INLINE scanr #-}
+   {-# INLINE scanr1 #-}
+   {-# INLINE singleton #-}
+   {-# INLINE span #-}
+   {-# INLINE spanMaybe #-}
+   {-# INLINE spanMaybe' #-}
+   {-# INLINE splitCharacterPrefix #-}
+   {-# INLINE takeWhile #-}
+
+instance TextualMonoid Text where
+   fromText = id
+   singleton = Text.singleton
+   splitCharacterPrefix = Text.uncons
+   characterPrefix t = if Text.null t then Nothing else Just (Text.head t)
+   map = Text.map
+   concatMap = Text.concatMap
+   toString = const Text.unpack
+   any = Text.any
+   all = Text.all
+
+   foldl   = const Text.foldl
+   foldl'  = const Text.foldl'
+   foldr   = const Text.foldr
+
+   scanl = Text.scanl
+   scanl1 = Text.scanl1
+   scanr = Text.scanr
+   scanr1 = Text.scanr1
+   mapAccumL = Text.mapAccumL
+   mapAccumR = Text.mapAccumR
+
+   takeWhile _ = Text.takeWhile
+   dropWhile _ = Text.dropWhile
+   break _ = Text.break
+   span _ = Text.span
+   spanMaybe s0 _ft fc t = case Text.foldr g id t (0, s0)
+                           of (i, s') | (prefix, suffix) <- Text.splitAt i t -> (prefix, suffix, s')
+      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int in seq i' $ cont (i', s')
+                            | otherwise = (i, s)
+   spanMaybe' s0 _ft fc t = case Text.foldr g id t (0, s0)
+                            of (i, s') | (prefix, suffix) <- Text.splitAt i t -> (prefix, suffix, s')
+      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')
+                            | otherwise = (i, s)
+   split = Text.split
+   find = Text.find
+
+   {-# INLINE all #-}
+   {-# INLINE any #-}
+   {-# INLINE break #-}
+   {-# INLINE characterPrefix #-}
+   {-# INLINE concatMap #-}
+   {-# INLINE dropWhile #-}
+   {-# INLINE find #-}
+   {-# INLINE foldl   #-}
+   {-# INLINE foldl'  #-}
+   {-# INLINE foldr   #-}
+   {-# INLINE fromText #-}
+   {-# INLINE map #-}
+   {-# INLINE mapAccumL #-}
+   {-# INLINE mapAccumR #-}
+   {-# INLINE scanl #-}
+   {-# INLINE scanl1 #-}
+   {-# INLINE scanr #-}
+   {-# INLINE scanr1 #-}
+   {-# INLINE singleton #-}
+   {-# INLINE span #-}
+   {-# INLINE spanMaybe #-}
+   {-# INLINE spanMaybe' #-}
+   {-# INLINE split #-}
+   {-# INLINE splitCharacterPrefix #-}
+   {-# INLINE takeWhile #-}
+
+instance TextualMonoid LazyText.Text where
+   fromText = LazyText.fromStrict
+   singleton = LazyText.singleton
+   splitCharacterPrefix = LazyText.uncons
+   characterPrefix t = if LazyText.null t then Nothing else Just (LazyText.head t)
+   map = LazyText.map
+   concatMap = LazyText.concatMap
+   toString = const LazyText.unpack
+   any = LazyText.any
+   all = LazyText.all
+
+   foldl   = const LazyText.foldl
+   foldl'  = const LazyText.foldl'
+   foldr   = const LazyText.foldr
+
+   scanl = LazyText.scanl
+   scanl1 = LazyText.scanl1
+   scanr = LazyText.scanr
+   scanr1 = LazyText.scanr1
+   mapAccumL = LazyText.mapAccumL
+   mapAccumR = LazyText.mapAccumR
+
+   takeWhile _ = LazyText.takeWhile
+   dropWhile _ = LazyText.dropWhile
+   break _ = LazyText.break
+   span _ = LazyText.span
+   spanMaybe s0 _ft fc t = case LazyText.foldr g id t (0, s0)
+                           of (i, s') | (prefix, suffix) <- LazyText.splitAt i t -> (prefix, suffix, s')
+      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int64 in seq i' $ cont (i', s')
+                            | otherwise = (i, s)
+   spanMaybe' s0 _ft fc t = case LazyText.foldr g id t (0, s0)
+                            of (i, s') | (prefix, suffix) <- LazyText.splitAt i t -> (prefix, suffix, s')
+      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int64 in seq i' $ seq s' $ cont (i', s')
+                            | otherwise = (i, s)
+   split = LazyText.split
+   find = LazyText.find
+   {-# INLINE all #-}
+   {-# INLINE any #-}
+   {-# INLINE break #-}
+   {-# INLINE characterPrefix #-}
+   {-# INLINE concatMap #-}
+   {-# INLINE dropWhile #-}
+   {-# INLINE find #-}
+   {-# INLINE foldl   #-}
+   {-# INLINE foldl'  #-}
+   {-# INLINE foldr   #-}
+   {-# INLINE fromText #-}
+   {-# INLINE map #-}
+   {-# INLINE mapAccumL #-}
+   {-# INLINE mapAccumR #-}
+   {-# INLINE scanl #-}
+   {-# INLINE scanl1 #-}
+   {-# INLINE scanr #-}
+   {-# INLINE scanr1 #-}
+   {-# INLINE singleton #-}
+   {-# INLINE span #-}
+   {-# INLINE spanMaybe #-}
+   {-# INLINE spanMaybe' #-}
+   {-# INLINE split #-}
+   {-# INLINE splitCharacterPrefix #-}
+   {-# INLINE takeWhile #-}
+
+instance TextualMonoid (Sequence.Seq Char) where
+   singleton = Sequence.singleton
+   splitCharacterPrefix s = case Sequence.viewl s
+                            of Sequence.EmptyL -> Nothing
+                               c Sequence.:< rest -> Just (c, rest)
+   characterPrefix s = case Sequence.viewl s
+                       of Sequence.EmptyL -> Nothing
+                          c Sequence.:< _ -> Just c
+   map = Traversable.fmapDefault
+   concatMap = Foldable.foldMap
+   toString = const Foldable.toList
+   any = Foldable.any
+   all = Foldable.all
+
+   foldl   = const Foldable.foldl
+   foldl'  = const Foldable.foldl'
+   foldr   = const Foldable.foldr
+
+   scanl = Sequence.scanl
+   scanl1 f v | Sequence.null v = Sequence.empty
+              | otherwise = Sequence.scanl1 f v
+   scanr = Sequence.scanr
+   scanr1 f v | Sequence.null v = Sequence.empty
+              | otherwise = Sequence.scanr1 f v
+
+   takeWhile _ = Sequence.takeWhileL
+   dropWhile _ = Sequence.dropWhileL
+   break _ = Sequence.breakl
+   span _ = Sequence.spanl
+   spanMaybe s0 _ft fc b = case Foldable.foldr g id b (0, s0)
+                           of (i, s') | (prefix, suffix) <- Sequence.splitAt i b -> (prefix, suffix, s')
+      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int in seq i' $ cont (i', s')
+                            | otherwise = (i, s)
+   spanMaybe' s0 _ft fc b = case Foldable.foldr g id b (0, s0)
+                            of (i, s') | (prefix, suffix) <- Sequence.splitAt i b -> (prefix, suffix, s')
+      where g c cont (i, s) | Just s' <- fc s c = let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')
+                            | otherwise = (i, s)
+   find = Foldable.find
+   elem = Foldable.elem
+
+   {-# INLINE all #-}
+   {-# INLINE any #-}
+   {-# INLINE break #-}
+   {-# INLINE characterPrefix #-}
+   {-# INLINE concatMap #-}
+   {-# INLINE dropWhile #-}
+   {-# INLINE elem #-}
+   {-# INLINE find #-}
+   {-# INLINE foldl   #-}
+   {-# INLINE foldl'  #-}
+   {-# INLINE foldr   #-}
+   {-# INLINE map #-}
+   {-# INLINE scanl #-}
+   {-# INLINE scanl1 #-}
+   {-# INLINE scanr #-}
+   {-# INLINE scanr1 #-}
+   {-# INLINE singleton #-}
+   {-# INLINE span #-}
+   {-# INLINE spanMaybe #-}
+   {-# INLINE spanMaybe' #-}
+   {-# INLINE splitCharacterPrefix #-}
+   {-# INLINE takeWhile #-}
diff --git a/src/Data/Semigroup/Cancellative.hs b/src/Data/Semigroup/Cancellative.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Semigroup/Cancellative.hs
@@ -0,0 +1,529 @@
+{- 
+    Copyright 2013-2019 Mario Blazevic
+
+    License: BSD3 (see BSD3-LICENSE.txt file)
+-}
+
+-- | This module defines the 'Semigroup' => 'Reductive' => 'Cancellative' class hierarchy.
+--
+-- @since 1.0
+--
+-- The 'Reductive' class introduces operation '</>' which is the inverse of '<>'. For the 'Sum' semigroup, this
+-- operation is subtraction; for 'Product' it is division and for 'Set' it's the set difference. A 'Reductive'
+-- semigroup is not a full group because '</>' may return 'Nothing'.
+--
+-- The 'Cancellative' subclass does not add any operation but it provides the additional guarantee that '<>' can
+-- always be undone with '</>'. Thus 'Sum' is 'Cancellative' but 'Product' is not because @(0*n)/0@ is not defined.
+--
+-- All semigroup subclasses listed above are for Abelian, /i.e./, commutative or symmetric semigroups. Since most
+-- practical semigroups in Haskell are not Abelian, each of the these classes has two symmetric superclasses:
+-- 
+-- * 'LeftReductive'
+-- 
+-- * 'LeftCancellative'
+-- 
+-- * 'RightReductive'
+-- 
+-- * 'RightCancellative'
+
+{-# LANGUAGE Haskell2010, FlexibleInstances, Trustworthy #-}
+
+module Data.Semigroup.Cancellative (
+   -- * Symmetric, commutative semigroup classes
+   Commutative, Reductive(..), Cancellative, SumCancellative(..),
+   -- * Asymmetric semigroup classes
+   LeftReductive(..), RightReductive(..),
+   LeftCancellative, RightCancellative
+   )
+where
+
+import Data.Semigroup -- (Semigroup, Dual(..), Sum(..), Product(..))
+import 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)
+
+-- | Class of all Abelian (/i.e./, commutative) semigroups that satisfy the commutativity property:
+-- 
+-- > a <> b == b <> a
+class Semigroup m => Commutative m
+
+-- | 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 a b = isJust (stripPrefix a 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 a b = isJust (stripSuffix a 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 Commutative ()
+
+instance Reductive () where
+   () </> () = Just ()
+
+instance Cancellative ()
+
+-- | /O(1)/
+instance LeftReductive () where
+   stripPrefix () () = Just ()
+
+-- | /O(1)/
+instance RightReductive () where
+   stripSuffix () () = Just ()
+
+instance LeftCancellative ()
+
+instance RightCancellative ()
+
+-- Dual instances
+
+instance Commutative a => Commutative (Dual a)
+
+instance Reductive a => Reductive (Dual a) where
+   Dual a </> Dual b = fmap Dual (a </> b)
+
+instance Cancellative a => Cancellative (Dual a)
+
+instance LeftReductive a => RightReductive (Dual a) where
+   stripSuffix (Dual a) (Dual b) = fmap Dual (stripPrefix a b)
+   Dual a `isSuffixOf` Dual b = a `isPrefixOf` b
+
+instance RightReductive a => LeftReductive (Dual a) where
+   stripPrefix (Dual a) (Dual b) = fmap Dual (stripSuffix a b)
+   Dual a `isPrefixOf` Dual b = a `isSuffixOf` b
+
+instance LeftCancellative a => RightCancellative (Dual a)
+
+instance RightCancellative a => LeftCancellative (Dual a)
+
+-- Sum instances
+instance Num a => Commutative (Sum a)
+
+-- | Helper class to avoid @FlexibleInstances@
+class Num a => SumCancellative a where
+   cancelAddition :: a -> a -> Maybe a
+   cancelAddition a b = Just (a - b)
+
+instance SumCancellative Int
+instance SumCancellative Integer
+instance SumCancellative Rational
+
+instance SumCancellative Natural where
+   cancelAddition a b
+      | a < b = Nothing
+      | otherwise = Just (a - b)
+
+-- | /O(1)/
+instance SumCancellative a => Reductive (Sum a) where
+   Sum a </> Sum b = Sum <$> cancelAddition a b
+
+-- | /O(1)/
+instance SumCancellative a => LeftReductive (Sum a) where
+   stripPrefix a b = b </> a
+
+-- | /O(1)/
+instance SumCancellative a => RightReductive (Sum a) where
+   stripSuffix a b = b </> a
+
+instance SumCancellative a => Cancellative (Sum a)
+instance SumCancellative a => LeftCancellative (Sum a)
+instance SumCancellative a => RightCancellative (Sum a)
+
+-- Product instances
+
+instance Num a => Commutative (Product a)
+
+instance Integral a => Reductive (Product a) where
+   Product 0 </> Product 0 = Just (Product 0)
+   Product _ </> Product 0 = Nothing
+   Product a </> Product b = if remainder == 0 then Just (Product quotient) else Nothing
+      where (quotient, remainder) = quotRem a b
+
+instance Integral a => LeftReductive (Product a) where
+   stripPrefix a b = b </> a
+
+instance Integral a => RightReductive (Product a) where
+   stripSuffix a b = b </> a
+
+-- Pair instances
+
+instance (Commutative a, Commutative b) => Commutative (a, b)
+
+instance (Reductive a, Reductive b) => Reductive (a, b) where
+   (a, b) </> (c, d) = case (a </> c, b </> d)
+                       of (Just a', Just b') -> Just (a', b')
+                          _ -> Nothing
+
+instance (Cancellative a, Cancellative b) => Cancellative (a, b)
+
+instance (LeftReductive a, LeftReductive b) => LeftReductive (a, b) where
+   stripPrefix (a, b) (c, d) = case (stripPrefix a c, stripPrefix b d)
+                               of (Just a', Just b') -> Just (a', b')
+                                  _ -> Nothing
+   isPrefixOf (a, b) (c, d) = isPrefixOf a c && isPrefixOf b d
+
+instance (RightReductive a, RightReductive b) => RightReductive (a, b) where
+   stripSuffix (a, b) (c, d) = case (stripSuffix a c, stripSuffix b d)
+                               of (Just a', Just b') -> Just (a', b')
+                                  _ -> Nothing
+   isSuffixOf (a, b) (c, d) = isSuffixOf a c && isSuffixOf b d
+
+instance (LeftCancellative a, LeftCancellative b) => LeftCancellative (a, b)
+
+instance (RightCancellative a, RightCancellative b) => RightCancellative (a, b)
+
+-- Triple instances
+
+instance (Commutative a, Commutative b, Commutative c) => Commutative (a, b, c)
+
+instance (Reductive a, Reductive b, Reductive c) => Reductive (a, b, c) where
+   (a1, b1, c1) </> (a2, b2, c2) = (,,) <$> (a1 </> a2) <*> (b1 </> b2) <*> (c1 </> 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 (a1, b1, c1) (a2, b2, c2) = (,,) <$> stripPrefix a1 a2 <*> stripPrefix b1 b2 <*> stripPrefix c1 c2
+   isPrefixOf (a1, b1, c1) (a2, b2, c2) = isPrefixOf a1 a2 && isPrefixOf b1 b2 && isPrefixOf c1 c2
+
+instance (RightReductive a, RightReductive b, RightReductive c) => RightReductive (a, b, c) where
+   stripSuffix (a1, b1, c1) (a2, b2, c2) = (,,) <$> stripSuffix a1 a2 <*> stripSuffix b1 b2 <*> stripSuffix c1 c2
+   isSuffixOf (a1, b1, c1) (a2, b2, c2) = isSuffixOf a1 a2 && isSuffixOf b1 b2 && isSuffixOf c1 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 (Commutative a, Commutative b, Commutative c, Commutative d) => Commutative (a, b, c, d)
+
+instance (Reductive a, Reductive b, Reductive c, Reductive d) => Reductive (a, b, c, d) where
+   (a1, b1, c1, d1) </> (a2, b2, c2, d2) = (,,,) <$> (a1 </> a2) <*> (b1 </> b2) <*> (c1 </> c2) <*> (d1 </> 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 (a1, b1, c1, d1) (a2, b2, c2, d2) =
+      (,,,) <$> stripPrefix a1 a2 <*> stripPrefix b1 b2 <*> stripPrefix c1 c2 <*> stripPrefix d1 d2
+   isPrefixOf (a1, b1, c1, d1) (a2, b2, c2, d2) =
+      isPrefixOf a1 a2 && isPrefixOf b1 b2 && isPrefixOf c1 c2 && isPrefixOf d1 d2
+
+instance (RightReductive a, RightReductive b, RightReductive c, RightReductive d) => RightReductive (a, b, c, d) where
+   stripSuffix (a1, b1, c1, d1) (a2, b2, c2, d2) =
+      (,,,) <$> stripSuffix a1 a2 <*> stripSuffix b1 b2 <*> stripSuffix c1 c2 <*> stripSuffix d1 d2
+   isSuffixOf (a1, b1, c1, d1) (a2, b2, c2, d2) =
+      isSuffixOf a1 a2 && isSuffixOf b1 b2 && isSuffixOf c1 c2 && isSuffixOf d1 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 Commutative x => Commutative (Maybe x)
+
+-- | @since 1.0
+instance Reductive x => Reductive (Maybe x) where
+   Just x </> Just y = Just <$> x </> y
+   x </> Nothing = Just x
+   Nothing </> _ = Nothing
+
+instance LeftReductive x => LeftReductive (Maybe x) where
+   stripPrefix Nothing y = Just y
+   stripPrefix Just{} Nothing = Nothing
+   stripPrefix (Just x) (Just y) = fmap Just $ stripPrefix x y
+
+instance RightReductive x => RightReductive (Maybe x) where
+   stripSuffix Nothing y = Just y
+   stripSuffix Just{} Nothing = Nothing
+   stripSuffix (Just x) (Just y) = fmap Just $ stripSuffix x y
+
+-- Set instances
+
+instance Ord a => Commutative (Set.Set a)
+
+-- | /O(m*log(n/m + 1)), m <= n/
+instance Ord a => LeftReductive (Set.Set a) where
+   isPrefixOf = Set.isSubsetOf
+   stripPrefix a b = b </> a
+
+-- | /O(m*log(n/m + 1)), m <= n/
+instance Ord a => RightReductive (Set.Set a) where
+   isSuffixOf = Set.isSubsetOf
+   stripSuffix a b = b </> a
+
+-- | /O(m*log(n/m + 1)), m <= n/
+instance Ord a => Reductive (Set.Set a) where
+   a </> b | Set.isSubsetOf b a = Just (a Set.\\ b)
+           | otherwise = Nothing
+
+-- IntSet instances
+
+instance Commutative IntSet.IntSet
+
+-- | /O(m+n)/
+instance LeftReductive IntSet.IntSet where
+   isPrefixOf = IntSet.isSubsetOf
+   stripPrefix a b = b </> a
+
+-- | /O(m+n)/
+instance RightReductive IntSet.IntSet where
+   isSuffixOf = IntSet.isSubsetOf
+   stripSuffix a b = b </> a
+
+-- | /O(m+n)/
+instance Reductive IntSet.IntSet where
+   a </> b | IntSet.isSubsetOf b a = Just (a IntSet.\\ b)
+           | otherwise = Nothing
+
+-- Map instances
+
+-- | /O(m+n)/
+instance (Ord k, Eq a) => LeftReductive (Map.Map k a) where
+   isPrefixOf = Map.isSubmapOf
+   stripPrefix a b | Map.isSubmapOf a b = Just (b Map.\\ a)
+                   | otherwise = Nothing
+
+-- | /O(m+n)/
+instance (Ord k, Eq a) => RightReductive (Map.Map k a) where
+   isSuffixOf = Map.isSubmapOfBy (const $ const True)
+   stripSuffix a b | a `isSuffixOf` b = Just (Map.differenceWith (\x y-> if x == y then Nothing else Just x) b a)
+                   | otherwise = Nothing
+
+-- IntMap instances
+
+-- | /O(m+n)/
+instance Eq a => LeftReductive (IntMap.IntMap a) where
+   isPrefixOf = IntMap.isSubmapOf
+   stripPrefix a b | IntMap.isSubmapOf a b = Just (b IntMap.\\ a)
+                   | otherwise = Nothing
+
+-- | /O(m+n)/
+instance Eq a => RightReductive (IntMap.IntMap a) where
+   isSuffixOf = IntMap.isSubmapOfBy (const $ const True)
+   stripSuffix a b | a `isSuffixOf` b = Just (IntMap.differenceWith (\x y-> if x == y then Nothing else Just x) b a)
+                   | otherwise = Nothing
+
+-- List instances
+
+-- | /O(prefixLength)/
+instance Eq x => LeftReductive [x] where
+   stripPrefix = List.stripPrefix
+   isPrefixOf = List.isPrefixOf
+
+-- | @since 1.0
+-- /O(m+n)/
+instance Eq x => RightReductive [x] where
+   isSuffixOf = List.isSuffixOf
+   stripSuffix xs0 ys0 = go1 xs0 ys0
+      where go1 (_:xs) (_:ys) = go1 xs ys
+            go1 [] ys = go2 id ys ys0
+            go1  _ [] = Nothing
+            go2 fy (_:zs) (y:ys) = go2 (fy . (y:)) zs ys
+            go2 fy [] ys
+               | xs0 == ys = Just (fy [])
+               | otherwise = Nothing
+            go2 _ _ _ = error "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 p s | p == s1 = Just s2
+                   | otherwise = Nothing
+      where (s1, s2) = Sequence.splitAt (Sequence.length p) s
+
+-- | /O(log(min(m,n−m)) + suffixLength)/
+instance Eq a => RightReductive (Sequence.Seq a) where
+   stripSuffix p s | p == s2 = Just s1
+                   | otherwise = Nothing
+      where (s1, s2) = Sequence.splitAt (Sequence.length s - Sequence.length p) 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 p l | prefixLength > Vector.length l = Nothing
+                   | otherwise = strip 0
+      where strip i | i == prefixLength = Just (Vector.drop prefixLength l)
+                    | l Vector.! i == p Vector.! i = strip (succ i)
+                    | otherwise = Nothing
+            prefixLength = Vector.length p
+   isPrefixOf p l | prefixLength > Vector.length l = False
+                  | otherwise = test 0
+      where test i | i == prefixLength = True
+                   | l Vector.! i == p Vector.! i = test (succ i)
+                   | otherwise = False
+            prefixLength = Vector.length p
+
+-- | /O(n)/
+instance Eq a => RightReductive (Vector.Vector a) where
+   stripSuffix s l | suffixLength > Vector.length l = Nothing
+                   | otherwise = strip (pred suffixLength)
+      where strip i | i == -1 = Just (Vector.take lengthDifference l)
+                    | l Vector.! (lengthDifference + i) == s Vector.! i = strip (pred i)
+                    | otherwise = Nothing
+            suffixLength = Vector.length s
+            lengthDifference = Vector.length l - suffixLength
+   isSuffixOf s l | suffixLength > Vector.length l = False
+                  | otherwise = test (pred suffixLength)
+      where test i | i == -1 = True
+                   | l Vector.! (lengthDifference + i) == s Vector.! i = test (pred i)
+                   | otherwise = False
+            suffixLength = Vector.length s
+            lengthDifference = Vector.length l - 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 p l = if ByteString.isPrefixOf p l
+                     then Just (ByteString.unsafeDrop (ByteString.length p) l)
+                     else Nothing
+   isPrefixOf = ByteString.isPrefixOf
+
+-- | /O(n)/
+instance RightReductive ByteString.ByteString where
+   stripSuffix s l = if ByteString.isSuffixOf s l
+                     then Just (ByteString.unsafeTake (ByteString.length l - ByteString.length s) l)
+                     else Nothing
+   isSuffixOf = ByteString.isSuffixOf
+
+instance LeftCancellative ByteString.ByteString
+
+instance RightCancellative ByteString.ByteString
+
+-- Lazy ByteString instances
+
+-- | /O(n)/
+instance LeftReductive LazyByteString.ByteString where
+   stripPrefix p l = if LazyByteString.isPrefixOf p l
+                     then Just (LazyByteString.drop (LazyByteString.length p) l)
+                     else Nothing
+   isPrefixOf = LazyByteString.isPrefixOf
+
+-- | /O(n)/
+instance RightReductive LazyByteString.ByteString where
+   stripSuffix s l = if LazyByteString.isSuffixOf s l
+                     then Just (LazyByteString.take (LazyByteString.length l - LazyByteString.length s) l)
+                     else Nothing
+   isSuffixOf = LazyByteString.isSuffixOf
+
+instance LeftCancellative LazyByteString.ByteString
+
+instance RightCancellative LazyByteString.ByteString
+
+-- Text instances
+
+-- | /O(n)/
+instance LeftReductive Text.Text where
+   stripPrefix = Text.stripPrefix
+   isPrefixOf = Text.isPrefixOf
+
+-- | /O(n)/
+instance RightReductive Text.Text where
+   stripSuffix = Text.stripSuffix
+   isSuffixOf = Text.isSuffixOf
+
+instance LeftCancellative Text.Text
+
+instance RightCancellative Text.Text
+
+-- Lazy Text instances
+
+-- | /O(n)/
+instance LeftReductive LazyText.Text where
+   stripPrefix = LazyText.stripPrefix
+   isPrefixOf = LazyText.isPrefixOf
+
+-- | /O(n)/
+instance RightReductive LazyText.Text where
+   stripSuffix = LazyText.stripSuffix
+   isSuffixOf = LazyText.isSuffixOf
+
+instance LeftCancellative LazyText.Text
+
+instance RightCancellative LazyText.Text
diff --git a/src/Data/Semigroup/Factorial.hs b/src/Data/Semigroup/Factorial.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Semigroup/Factorial.hs
@@ -0,0 +1,427 @@
+{- 
+    Copyright 2013-2019 Mario Blazevic
+
+    License: BSD3 (see BSD3-LICENSE.txt file)
+-}
+
+-- | This module defines the 'Semigroup' => 'Factorial' => 'StableFactorial' classes and some of their instances.
+-- 
+
+{-# LANGUAGE Haskell2010, FlexibleInstances, Trustworthy #-}
+
+module Data.Semigroup.Factorial (
+   -- * Classes
+   Factorial(..), StableFactorial,
+   -- * Monad function equivalents
+   mapM, mapM_
+   )
+where
+
+import qualified Control.Monad as Monad
+import Data.Semigroup -- (Semigroup (..), Dual(..), Sum(..), Product(..), Endo(Endo, appEndo))
+import qualified Data.Foldable as Foldable
+import qualified Data.List as List
+import qualified Data.ByteString 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 Data.List.NonEmpty (nonEmpty)
+import Data.Numbers.Primes (primeFactors)
+import Numeric.Natural (Natural)
+
+import Data.Monoid.Null (MonoidNull(null))
+
+import Prelude hiding (break, drop, dropWhile, foldl, foldr, last, length, map, mapM, mapM_, null, reverse)
+
+-- | Class of semigroups that can be split into irreducible (/i.e./, atomic or prime) 'factors' in a unique way. Factors of
+-- a 'Product' are literally its prime factors:
+--
+-- prop> factors (Product 12) == [Product 2, Product 2, Product 3]
+--
+-- Factors of a list are /not/ its elements but all its single-item sublists:
+--
+-- prop> factors "abc" == ["a", "b", "c"]
+-- 
+-- The methods of this class satisfy the following laws:
+-- 
+-- > maybe id sconcat  . nonEmpty . factors == id
+-- > List.all (\prime-> factors prime == [prime]) . factors
+-- > factors . reverse == List.reverse . factors
+-- > primePrefix s == foldr const s s
+-- > primeSuffix s == primePrefix (reverse s)
+-- > foldl f a == List.foldl f a . factors
+-- > foldl' f a == List.foldl' f a . factors
+-- > foldr f a == List.foldr f a . factors
+--
+-- A minimal instance definition must implement 'factors' or 'foldr'. Other methods can and should be implemented only
+-- for performance reasons.
+class Semigroup m => Factorial m where
+   -- | Returns a list of all prime factors; inverse of mconcat.
+   factors :: m -> [m]
+   -- | The prime prefix; @primePrefix mempty == mempty@ for monoids.
+   primePrefix :: m -> m
+   -- | The prime suffix; @primeSuffix mempty == mempty@ for monoids.
+   primeSuffix :: m -> m
+   -- | Like 'List.foldl' from "Data.List" on the list of 'primes'.
+   foldl :: (a -> m -> a) -> a -> m -> a
+   -- | Like 'List.foldl'' from "Data.List" on the list of 'primes'.
+   foldl' :: (a -> m -> a) -> a -> m -> a
+   -- | Like 'List.foldr' from "Data.List" on the list of 'primes'.
+   foldr :: (m -> a -> a) -> a -> m -> a
+   -- | The 'length' of the list of 'primes'.
+   length :: m -> Int
+   -- | Generalizes 'foldMap' from "Data.Foldable", except the function arguments are prime factors rather than the
+   -- structure elements.
+   foldMap :: Monoid n => (m -> n) -> m -> n
+   -- | Equivalent to 'List.reverse' from "Data.List".
+   reverse :: m -> m
+
+   factors = foldr (:) []
+   primePrefix s = foldr const s s
+   primeSuffix s = foldl (const id) s s
+   foldl f f0 = List.foldl f f0 . factors
+   foldl' f f0 = List.foldl' f f0 . factors
+   foldr f f0 = List.foldr f f0 . factors
+   length = foldl' (const . succ) 0
+   foldMap f = foldr (mappend . f) mempty
+   reverse s = maybe s sconcat (nonEmpty $ List.reverse $ factors s)
+   {-# MINIMAL factors | foldr #-}
+
+-- | A subclass of 'Factorial' whose instances satisfy this additional law:
+--
+-- > factors (a <> b) == factors a <> factors b
+class Factorial m => StableFactorial m
+
+instance Factorial () where
+   factors () = []
+   primePrefix () = ()
+   primeSuffix () = ()
+   length () = 0
+   reverse = id
+
+instance Factorial a => Factorial (Dual a) where
+   factors (Dual a) = fmap Dual (reverse $ factors a)
+   length (Dual a) = length a
+   primePrefix (Dual a) = Dual (primeSuffix a)
+   primeSuffix (Dual a) = Dual (primePrefix a)
+   reverse (Dual a) = Dual (reverse a)
+
+instance (Integral a, Eq a) => Factorial (Sum a) where
+   primePrefix (Sum a) = Sum (signum a )
+   primeSuffix = primePrefix
+   factors (Sum n) = replicate (fromIntegral $ abs n) (Sum $ signum n)
+   length (Sum a) = abs (fromIntegral a)
+   reverse = id
+
+instance Integral a => Factorial (Product a) where
+   factors (Product a) = List.map Product (primeFactors a)
+   reverse = id
+
+instance Factorial a => Factorial (Maybe a) where
+   factors Nothing = []
+   factors (Just a) = case factors a
+                      of [] -> [Just a]
+                         as -> List.map Just as
+   length Nothing = 0
+   length (Just a) = max 1 (length a)
+   reverse = fmap reverse
+
+instance (Factorial a, Factorial b, MonoidNull a, MonoidNull b) => Factorial (a, b) where
+   factors (a, b) = List.map (\a1-> (a1, mempty)) (factors a) ++ List.map ((,) mempty) (factors b)
+   primePrefix (a, b) | null a = (a, primePrefix b)
+                      | otherwise = (primePrefix a, mempty)
+   primeSuffix (a, b) | null b = (primeSuffix a, b)
+                      | otherwise = (mempty, primeSuffix b)
+   foldl f a0 (x, y) = foldl f2 (foldl f1 a0 x) y
+      where f1 a = f a . fromFst
+            f2 a = f a . fromSnd
+   foldl' f a0 (x, y) = a' `seq` foldl' f2 a' y
+      where f1 a = f a . fromFst
+            f2 a = f a . fromSnd
+            a' = foldl' f1 a0 x
+   foldr f a (x, y) = foldr (f . fromFst) (foldr (f . fromSnd) a y) x
+   foldMap f (x, y) = Data.Semigroup.Factorial.foldMap (f . fromFst) x `mappend`
+                      Data.Semigroup.Factorial.foldMap (f . fromSnd) y
+   length (a, b) = length a + length b
+   reverse (a, b) = (reverse a, reverse b)
+
+{-# INLINE fromFst #-}
+fromFst :: Monoid b => a -> (a, b)
+fromFst a = (a, mempty)
+
+{-# INLINE fromSnd #-}
+fromSnd :: Monoid a => b -> (a, b)
+fromSnd b = (mempty, b)
+
+instance (Factorial a, Factorial b, Factorial c,
+          MonoidNull a, MonoidNull b, MonoidNull c) => Factorial (a, b, c) where
+   factors (a, b, c) = List.map (\a1-> (a1, mempty, mempty)) (factors a)
+                       ++ List.map (\b1-> (mempty, b1, mempty)) (factors b)
+                       ++ List.map (\c1-> (mempty, mempty, c1)) (factors c)
+   primePrefix (a, b, c) | not (null a) = (primePrefix a, mempty, mempty)
+                         | not (null b) = (mempty, primePrefix b, mempty)
+                         | otherwise = (mempty, mempty, primePrefix c)
+   primeSuffix (a, b, c) | not (null c) = (mempty, mempty, primeSuffix c)
+                         | not (null b) = (mempty, primeSuffix b, mempty)
+                         | otherwise = (primeSuffix a, mempty, mempty)
+   foldl f s0 (a, b, c) = foldl f3 (foldl f2 (foldl f1 s0 a) b) c
+      where f1 x = f x . fromFstOf3
+            f2 x = f x . fromSndOf3
+            f3 x = f x . fromThdOf3
+   foldl' f s0 (a, b, c) = a' `seq` b' `seq` foldl' f3 b' c
+      where f1 x = f x . fromFstOf3
+            f2 x = f x . fromSndOf3
+            f3 x = f x . fromThdOf3
+            a' = foldl' f1 s0 a
+            b' = foldl' f2 a' b
+   foldr f s (a, b, c) = foldr (f . fromFstOf3) (foldr (f . fromSndOf3) (foldr (f . fromThdOf3) s c) b) a
+   foldMap f (a, b, c) = Data.Semigroup.Factorial.foldMap (f . fromFstOf3) a
+                         `mappend` Data.Semigroup.Factorial.foldMap (f . fromSndOf3) b
+                         `mappend` Data.Semigroup.Factorial.foldMap (f . fromThdOf3) c
+   length (a, b, c) = length a + length b + length c
+   reverse (a, b, c) = (reverse a, reverse b, reverse c)
+
+{-# INLINE fromFstOf3 #-}
+fromFstOf3 :: (Monoid b, Monoid c) => a -> (a, b, c)
+fromFstOf3 a = (a, mempty, mempty)
+
+{-# INLINE fromSndOf3 #-}
+fromSndOf3 :: (Monoid a, Monoid c) => b -> (a, b, c)
+fromSndOf3 b = (mempty, b, mempty)
+
+{-# INLINE fromThdOf3 #-}
+fromThdOf3 :: (Monoid a, Monoid b) => c -> (a, b, c)
+fromThdOf3 c = (mempty, mempty, c)
+
+instance (Factorial a, Factorial b, Factorial c, Factorial d,
+          MonoidNull a, MonoidNull b, MonoidNull c, MonoidNull d) => Factorial (a, b, c, d) where
+   factors (a, b, c, d) = List.map (\a1-> (a1, mempty, mempty, mempty)) (factors a)
+                          ++ List.map (\b1-> (mempty, b1, mempty, mempty)) (factors b)
+                          ++ List.map (\c1-> (mempty, mempty, c1, mempty)) (factors c)
+                          ++ List.map (\d1-> (mempty, mempty, mempty, d1)) (factors d)
+   primePrefix (a, b, c, d) | not (null a) = (primePrefix a, mempty, mempty, mempty)
+                            | not (null b) = (mempty, primePrefix b, mempty, mempty)
+                            | not (null c) = (mempty, mempty, primePrefix c, mempty)
+                            | otherwise    = (mempty, mempty, mempty, primePrefix d)
+   primeSuffix (a, b, c, d) | not (null d) = (mempty, mempty, mempty, primeSuffix d)
+                            | not (null c) = (mempty, mempty, primeSuffix c, mempty)
+                            | not (null b) = (mempty, primeSuffix b, mempty, mempty)
+                            | otherwise    = (primeSuffix a, mempty, mempty, mempty)
+   foldl f s0 (a, b, c, d) = foldl f4 (foldl f3 (foldl f2 (foldl f1 s0 a) b) c) d
+      where f1 x = f x . fromFstOf4
+            f2 x = f x . fromSndOf4
+            f3 x = f x . fromThdOf4
+            f4 x = f x . fromFthOf4
+   foldl' f s0 (a, b, c, d) = a' `seq` b' `seq` c' `seq` foldl' f4 c' d
+      where f1 x = f x . fromFstOf4
+            f2 x = f x . fromSndOf4
+            f3 x = f x . fromThdOf4
+            f4 x = f x . fromFthOf4
+            a' = foldl' f1 s0 a
+            b' = foldl' f2 a' b
+            c' = foldl' f3 b' c
+   foldr f s (a, b, c, d) =
+      foldr (f . fromFstOf4) (foldr (f . fromSndOf4) (foldr (f . fromThdOf4) (foldr (f . fromFthOf4) s d) c) b) a
+   foldMap f (a, b, c, d) = Data.Semigroup.Factorial.foldMap (f . fromFstOf4) a
+                            `mappend` Data.Semigroup.Factorial.foldMap (f . fromSndOf4) b
+                            `mappend` Data.Semigroup.Factorial.foldMap (f . fromThdOf4) c
+                            `mappend` Data.Semigroup.Factorial.foldMap (f . fromFthOf4) d
+   length (a, b, c, d) = length a + length b + length c + length d
+   reverse (a, b, c, d) = (reverse a, reverse b, reverse c, reverse d)
+
+{-# INLINE fromFstOf4 #-}
+fromFstOf4 :: (Monoid b, Monoid c, Monoid d) => a -> (a, b, c, d)
+fromFstOf4 a = (a, mempty, mempty, mempty)
+
+{-# INLINE fromSndOf4 #-}
+fromSndOf4 :: (Monoid a, Monoid c, Monoid d) => b -> (a, b, c, d)
+fromSndOf4 b = (mempty, b, mempty, mempty)
+
+{-# INLINE fromThdOf4 #-}
+fromThdOf4 :: (Monoid a, Monoid b, Monoid d) => c -> (a, b, c, d)
+fromThdOf4 c = (mempty, mempty, c, mempty)
+
+{-# INLINE fromFthOf4 #-}
+fromFthOf4 :: (Monoid a, Monoid b, Monoid c) => d -> (a, b, c, d)
+fromFthOf4 d = (mempty, mempty, mempty, d)
+
+instance Factorial [x] where
+   factors xs = List.map (:[]) xs
+   primePrefix [] = []
+   primePrefix (x:_) = [x]
+   primeSuffix [] = []
+   primeSuffix xs = [List.last xs]
+   foldl _ a [] = a
+   foldl f a (x:xs) = foldl f (f a [x]) xs
+   foldl' _ a [] = a
+   foldl' f a (x:xs) = let a' = f a [x] in a' `seq` foldl' f a' xs
+   foldr _ f0 [] = f0
+   foldr f f0 (x:xs) = f [x] (foldr f f0 xs)
+   length = List.length
+   foldMap f = mconcat . List.map (f . (:[]))
+   reverse = List.reverse
+
+instance Factorial ByteString.ByteString where
+   factors x = factorize (ByteString.length x) x
+      where factorize 0 _ = []
+            factorize n xs = xs1 : factorize (pred n) xs'
+              where (xs1, xs') = ByteString.splitAt 1 xs
+   primePrefix = ByteString.take 1
+   primeSuffix x = ByteString.drop (ByteString.length x - 1) x
+   foldl f = ByteString.foldl f'
+      where f' a byte = f a (ByteString.singleton byte)
+   foldl' f = ByteString.foldl' f'
+      where f' a byte = f a (ByteString.singleton byte)
+   foldr f = ByteString.foldr (f . ByteString.singleton)
+   length = ByteString.length
+   reverse = ByteString.reverse
+
+instance Factorial LazyByteString.ByteString where
+   factors x = factorize (LazyByteString.length x) x
+      where factorize 0 _ = []
+            factorize n xs = xs1 : factorize (pred n) xs'
+               where (xs1, xs') = LazyByteString.splitAt 1 xs
+   primePrefix = LazyByteString.take 1
+   primeSuffix x = LazyByteString.drop (LazyByteString.length x - 1) x
+   length = fromIntegral . LazyByteString.length
+   reverse = LazyByteString.reverse
+
+instance Factorial Text.Text where
+   factors = Text.chunksOf 1
+   primePrefix = Text.take 1
+   primeSuffix x = if Text.null x then Text.empty else Text.singleton (Text.last x)
+   foldl f = Text.foldl f'
+      where f' a char = f a (Text.singleton char)
+   foldl' f = Text.foldl' f'
+      where f' a char = f a (Text.singleton char)
+   foldr f = Text.foldr f'
+      where f' char a = f (Text.singleton char) a
+   length = Text.length
+   reverse = Text.reverse
+
+instance Factorial LazyText.Text where
+   factors = LazyText.chunksOf 1
+   primePrefix = LazyText.take 1
+   primeSuffix x = if LazyText.null x then LazyText.empty else LazyText.singleton (LazyText.last x)
+   foldl f = LazyText.foldl f'
+      where f' a char = f a (LazyText.singleton char)
+   foldl' f = LazyText.foldl' f'
+      where f' a char = f a (LazyText.singleton char)
+   foldr f = LazyText.foldr f'
+      where f' char a = f (LazyText.singleton char) a
+   length = fromIntegral . LazyText.length
+   reverse = LazyText.reverse
+
+instance Ord k => Factorial (Map.Map k v) where
+   factors = List.map (uncurry Map.singleton) . Map.toAscList
+   primePrefix map | Map.null map = map
+                   | otherwise = uncurry Map.singleton $ Map.findMin map
+   primeSuffix map | Map.null map = map
+                   | otherwise = uncurry Map.singleton $ Map.findMax map
+   foldl f = Map.foldlWithKey f'
+      where f' a k v = f a (Map.singleton k v)
+   foldl' f = Map.foldlWithKey' f'
+      where f' a k v = f a (Map.singleton k v)
+   foldr f = Map.foldrWithKey f'
+      where f' k v a = f (Map.singleton k v) a
+   length = Map.size
+   reverse = id
+
+instance Factorial (IntMap.IntMap a) where
+   factors = List.map (uncurry IntMap.singleton) . IntMap.toAscList
+   primePrefix map | IntMap.null map = map
+                   | otherwise = uncurry IntMap.singleton $ IntMap.findMin map
+   primeSuffix map | IntMap.null map = map
+                   | otherwise = uncurry IntMap.singleton $ IntMap.findMax map
+   foldl f = IntMap.foldlWithKey f'
+      where f' a k v = f a (IntMap.singleton k v)
+   foldl' f = IntMap.foldlWithKey' f'
+      where f' a k v = f a (IntMap.singleton k v)
+   foldr f = IntMap.foldrWithKey f'
+      where f' k v a = f (IntMap.singleton k v) a
+   length = IntMap.size
+   reverse = id
+
+instance Factorial IntSet.IntSet where
+   factors = List.map IntSet.singleton . IntSet.toAscList
+   primePrefix set | IntSet.null set = set
+                   | otherwise = IntSet.singleton $ IntSet.findMin set
+   primeSuffix set | IntSet.null set = set
+                   | otherwise = IntSet.singleton $ IntSet.findMax set
+   foldl f = IntSet.foldl f'
+      where f' a b = f a (IntSet.singleton b)
+   foldl' f = IntSet.foldl' f'
+      where f' a b = f a (IntSet.singleton b)
+   foldr f = IntSet.foldr f'
+      where f' a b = f (IntSet.singleton a) b
+   length = IntSet.size
+   reverse = id
+
+instance Factorial (Sequence.Seq a) where
+   factors = List.map Sequence.singleton . Foldable.toList
+   primePrefix = Sequence.take 1
+   primeSuffix q = Sequence.drop (Sequence.length q - 1) q
+   foldl f = Foldable.foldl f'
+      where f' a b = f a (Sequence.singleton b)
+   foldl' f = Foldable.foldl' f'
+      where f' a b = f a (Sequence.singleton b)
+   foldr f = Foldable.foldr f'
+      where f' a b = f (Sequence.singleton a) b
+   length = Sequence.length
+   reverse = Sequence.reverse
+
+instance Ord a => Factorial (Set.Set a) where
+   factors = List.map Set.singleton . Set.toAscList
+   primePrefix set | Set.null set = set
+                   | otherwise = Set.singleton $ Set.findMin set
+   primeSuffix set | Set.null set = set
+                   | otherwise = Set.singleton $ Set.findMax set
+   foldl f = Foldable.foldl f'
+      where f' a b = f a (Set.singleton b)
+   foldl' f = Foldable.foldl' f'
+      where f' a b = f a (Set.singleton b)
+   foldr f = Foldable.foldr f'
+      where f' a b = f (Set.singleton a) b
+   length = Set.size
+   reverse = id
+
+instance Factorial (Vector.Vector a) where
+   factors x = factorize (Vector.length x) x
+      where factorize 0 _ = []
+            factorize n xs = xs1 : factorize (pred n) xs'
+               where (xs1, xs') = Vector.splitAt 1 xs
+   primePrefix = Vector.take 1
+   primeSuffix x = Vector.drop (Vector.length x - 1) x
+   foldl f = Vector.foldl f'
+      where f' a byte = f a (Vector.singleton byte)
+   foldl' f = Vector.foldl' f'
+      where f' a byte = f a (Vector.singleton byte)
+   foldr f = Vector.foldr f'
+      where f' byte a = f (Vector.singleton byte) a
+   length = Vector.length
+   reverse = Vector.reverse
+
+instance StableFactorial ()
+instance StableFactorial a => StableFactorial (Dual a)
+instance StableFactorial [x]
+instance StableFactorial ByteString.ByteString
+instance StableFactorial LazyByteString.ByteString
+instance StableFactorial Text.Text
+instance StableFactorial LazyText.Text
+instance StableFactorial (Sequence.Seq a)
+instance StableFactorial (Vector.Vector a)
+instance StableFactorial (Sum Natural)
+
+-- | A 'Monad.mapM' equivalent.
+mapM :: (Factorial a, Monoid b, Monad m) => (a -> m b) -> a -> m b
+mapM f = ($ return mempty) . appEndo . Data.Semigroup.Factorial.foldMap (Endo . Monad.liftM2 (<>) . f)
+
+-- | A 'Monad.mapM_' equivalent.
+mapM_ :: (Factorial a, Applicative m) => (a -> m b) -> a -> m ()
+mapM_ f = foldr ((*>) . f) (pure ())