{- 
    Copyright 2013 Mario Blazevic

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

{-# LANGUAGE Rank2Types, ScopedTypeVariables, FlexibleInstances, GeneralizedNewtypeDeriving #-}

module Main where

import Prelude hiding (foldl, foldr, gcd, length, null, reverse, span, splitAt, takeWhile)

import Test.QuickCheck (Arbitrary, CoArbitrary, Property, Gen,
                        quickCheck, arbitrary, coarbitrary, property, label, forAll, variant, whenFail, (.&&.))
import Test.QuickCheck.Instances ()

import Data.Int (Int8, Int32)
import Data.Foldable (toList)
import Data.List (intersperse, unfoldr)
import qualified Data.List as List
import Data.Maybe (isJust)
import Data.Either (lefts, rights)
import Data.Tuple (swap)
import Data.String (IsString, fromString)
import Data.Char (isLetter)

import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as Lazy (ByteString)
import Data.Text (Text)
import qualified Data.Text.Lazy as Lazy (Text)
import qualified Data.Text as Text
import Data.IntMap (IntMap)
import Data.IntSet (IntSet)
import Data.Map (Map)
import Data.Sequence (Seq)
import Data.Set (Set)
import Data.Vector (Vector, fromList)

import Data.Monoid.Instances.ByteString.UTF8 (ByteStringUTF8(ByteStringUTF8))

import Data.Monoid (Monoid, mempty, (<>), mconcat, All(All), Any(Any), Dual(Dual),
                    First(First), Last(Last), Sum(Sum), Product(Product))
import Data.Monoid.Null (MonoidNull, null)
import Data.Monoid.Factorial (FactorialMonoid, factors, splitPrimePrefix, splitPrimeSuffix, primePrefix, primeSuffix,
                              foldl, foldl', foldr, length, reverse, span, split, splitAt)
import Data.Monoid.Cancellative (ReductiveMonoid, LeftReductiveMonoid, RightReductiveMonoid,
                                 CancellativeMonoid, LeftCancellativeMonoid, RightCancellativeMonoid,
                                 GCDMonoid, LeftGCDMonoid, RightGCDMonoid,
                                 (</>), gcd,
                                 isPrefixOf, stripPrefix, commonPrefix, stripCommonPrefix,
                                 isSuffixOf, stripSuffix, commonSuffix, stripCommonSuffix)
import Data.Monoid.Textual (TextualMonoid)
import qualified Data.Monoid.Textual as Textual

data Test = NullTest (forall a. (Arbitrary a, Show a, Eq a, MonoidNull a) => a -> Property)
          | FactorialTest (forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property)
          | TextualTest (forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property)
          | LeftReductiveTest (forall a. (Arbitrary a, Show a, Eq a, LeftReductiveMonoid a) => a -> Property)
          | RightReductiveTest (forall a. (Arbitrary a, Show a, Eq a, RightReductiveMonoid a) => a -> Property)
          | ReductiveTest (forall a. (Arbitrary a, Show a, Eq a, ReductiveMonoid a) => a -> Property)
          | LeftCancellativeTest (forall a. (Arbitrary a, Show a, Eq a, LeftCancellativeMonoid a) => a -> Property)
          | RightCancellativeTest (forall a. (Arbitrary a, Show a, Eq a, RightCancellativeMonoid a) => a -> Property)
          | CancellativeTest (forall a. (Arbitrary a, Show a, Eq a, CancellativeMonoid a) => a -> Property)
          | LeftGCDTest (forall a. (Arbitrary a, Show a, Eq a, LeftGCDMonoid a) => a -> Property)
          | RightGCDTest (forall a. (Arbitrary a, Show a, Eq a, RightGCDMonoid a) => a -> Property)
          | GCDTest (forall a. (Arbitrary a, Show a, Eq a, GCDMonoid a) => a -> Property)
          | CancellativeGCDTest (forall a. (Arbitrary a, Show a, Eq a, CancellativeMonoid a, GCDMonoid a) 
                                 => a -> Property)

main = mapM_ (quickCheck . uncurry checkInstances) tests

checkInstances :: String -> Test -> Property
checkInstances name (NullTest checkType) = label name (checkType ()
                                                       .&&. checkType (mempty :: Ordering)
                                                       .&&. checkType (mempty :: All)
                                                       .&&. checkType (mempty :: Any)
                                                       .&&. checkType (mempty :: String)
                                                       .&&. checkType (mempty :: ByteString)
                                                       .&&. checkType (mempty :: Lazy.ByteString)
                                                       .&&. checkType (mempty :: Text)
                                                       .&&. checkType (mempty :: Lazy.Text)
                                                       .&&. checkType (mempty :: Dual String)
                                                       .&&. checkType (mempty :: Sum Float)
                                                       .&&. checkType (mempty :: Product Int)
                                                       .&&. checkType (mempty :: First Int)
                                                       .&&. checkType (mempty :: Last Int)
                                                       .&&. checkType (mempty :: Maybe String)
                                                       .&&. checkType (mempty :: (Text, String))
                                                       .&&. checkType (mempty :: IntMap Int)
                                                       .&&. checkType (mempty :: IntSet)
                                                       .&&. checkType (mempty :: Map String Int)
                                                       .&&. checkType (mempty :: Seq Int)
                                                       .&&. checkType (mempty :: Set String)
                                                       .&&. checkType (mempty :: Vector Int))
checkInstances name (FactorialTest checkType) = label name (checkType (mempty :: TestString)
                                                            .&&. checkType (mempty :: String)
                                                            .&&. checkType (mempty :: ByteString)
                                                            .&&. checkType (mempty :: Lazy.ByteString)
                                                            .&&. checkType (mempty :: ByteStringUTF8)
                                                            .&&. checkType (mempty :: Text)
                                                            .&&. checkType (mempty :: Lazy.Text)
                                                            .&&. checkType (mempty :: Dual String)
                                                            .&&. checkType (mempty :: Sum Int8)
                                                            .&&. checkType (mempty :: Product Int32)
                                                            .&&. checkType (mempty :: Maybe String)
                                                            .&&. checkType (mempty :: (Text, String))
                                                            .&&. checkType (mempty :: IntMap Int)
                                                            .&&. checkType (mempty :: IntSet)
                                                            .&&. checkType (mempty :: Map String Int)
                                                            .&&. checkType (mempty :: Seq Int)
                                                            .&&. checkType (mempty :: Set String)
                                                            .&&. checkType (mempty :: Vector Int))
checkInstances name (TextualTest checkType) = label name (checkType (mempty :: TestString)
                                                          .&&. checkType (mempty :: String)
                                                          .&&. checkType (mempty :: ByteStringUTF8)
                                                          .&&. checkType (mempty :: Text)
                                                          .&&. checkType (mempty :: Lazy.Text))
checkInstances name (LeftReductiveTest checkType) = label name (checkType (mempty :: String)
                                                                .&&. checkType (mempty :: ByteString)
                                                                .&&. checkType (mempty :: Lazy.ByteString)
                                                                .&&. checkType (mempty :: Text)
                                                                .&&. checkType (mempty :: Lazy.Text)
                                                                .&&. checkType (mempty :: Dual Text)
                                                                .&&. checkType (mempty :: Sum Integer)
                                                                .&&. checkType (mempty :: Product Integer)
                                                                .&&. checkType (mempty :: (Text, String))
                                                                .&&. checkType (mempty :: IntSet)
                                                                .&&. checkType (mempty :: Seq String)
                                                                .&&. checkType (mempty :: Set Integer)
                                                                .&&. checkType (mempty :: Vector Int))
checkInstances name (RightReductiveTest checkType) = label name (checkType (mempty :: ByteString)
                                                                 .&&. checkType (mempty :: Lazy.ByteString)
                                                                 .&&. checkType (mempty :: Text)
                                                                 .&&. checkType (mempty :: Lazy.Text)
                                                                 .&&. checkType (mempty :: Dual String)
                                                                 .&&. checkType (mempty :: Sum Integer)
                                                                 .&&. checkType (mempty :: Product Integer)
                                                                 .&&. checkType (mempty :: (Text, ByteString))
                                                                 .&&. checkType (mempty :: IntSet)
                                                                 .&&. checkType (mempty :: Seq Int)
                                                                 .&&. checkType (mempty :: Set String)
                                                                 .&&. checkType (mempty :: Vector Int))
checkInstances name (ReductiveTest checkType) = label name (checkType (mempty :: Sum Integer)
                                                            .&&. checkType (mempty :: Product Integer)
                                                            .&&. checkType (mempty :: Dual (Sum Integer))
                                                            .&&. checkType (mempty :: (Sum Integer, Sum Int))
                                                            .&&. checkType (mempty :: IntSet)
                                                            .&&. checkType (mempty :: Set Integer))
checkInstances name (LeftCancellativeTest checkType) = label name (checkType (mempty :: String)
                                                                   .&&. checkType (mempty :: ByteString)
                                                                   .&&. checkType (mempty :: Lazy.ByteString)
                                                                   .&&. checkType (mempty :: Text)
                                                                   .&&. checkType (mempty :: Lazy.Text)
                                                                   .&&. checkType (mempty :: Dual Text)
                                                                   .&&. checkType (mempty :: Sum Integer)
                                                                   .&&. checkType (mempty :: (Text, String))
                                                                   .&&. checkType (mempty :: Seq Int)
                                                                   .&&. checkType (mempty :: Vector Int))
checkInstances name (RightCancellativeTest checkType) = label name (checkType (mempty :: ByteString)
                                                                    .&&. checkType (mempty :: Lazy.ByteString)
                                                                    .&&. checkType (mempty :: Text)
                                                                    .&&. checkType (mempty :: Lazy.Text)
                                                                    .&&. checkType (mempty :: Dual String)
                                                                    .&&. checkType (mempty :: Sum Integer)
                                                                    .&&. checkType (mempty :: (Text, ByteString))
                                                                    .&&. checkType (mempty :: Seq Int)
                                                                    .&&. checkType (mempty :: Vector Int))
checkInstances name (CancellativeTest checkType) = label name (checkType (mempty :: Sum Integer)
                                                               .&&. checkType (mempty :: Dual (Sum Integer))
                                                               .&&. checkType (mempty :: (Sum Integer, Sum Int)))
checkInstances name (LeftGCDTest checkType) = label name (checkType (mempty :: String)
                                                          .&&. checkType (mempty :: ByteString)
                                                          .&&. checkType (mempty :: Lazy.ByteString)
                                                          .&&. checkType (mempty :: Text)
                                                          .&&. checkType (mempty :: Lazy.Text)
                                                          .&&. checkType (mempty :: Dual ByteString)
                                                          .&&. checkType (mempty :: Sum Integer)
                                                          .&&. checkType (mempty :: Product Integer)
                                                          .&&. checkType (mempty :: (Text, String))
                                                          .&&. checkType (mempty :: IntMap Int)
                                                          .&&. checkType (mempty :: IntSet)
                                                          .&&. checkType (mempty :: Map String Int)
                                                          .&&. checkType (mempty :: Seq Int)
                                                          .&&. checkType (mempty :: Set String)
                                                          .&&. checkType (mempty :: Vector Int))
checkInstances name (RightGCDTest checkType) = label name (checkType (mempty :: ByteString)
                                                           .&&. checkType (mempty :: Lazy.ByteString)
                                                           .&&. checkType (mempty :: Dual String)
                                                           .&&. checkType (mempty :: Sum Integer)
                                                           .&&. checkType (mempty :: Product Integer)
                                                           .&&. checkType (mempty :: (Seq Int, ByteString))
                                                           .&&. checkType (mempty :: IntSet)
                                                           .&&. checkType (mempty :: Seq Int)
                                                           .&&. checkType (mempty :: Set String)
                                                           .&&. checkType (mempty :: Vector Int))
checkInstances name (GCDTest checkType) = label name (checkType (mempty :: Sum Integer)
                                                      .&&. checkType (mempty :: Product Integer)
                                                      .&&. checkType (mempty :: Dual (Product Integer))
                                                      .&&. checkType (mempty :: (Sum Integer, Sum Int))
                                                      .&&. checkType (mempty :: IntSet)
                                                      .&&. checkType (mempty :: Set String))
checkInstances name (CancellativeGCDTest checkType) = label name (checkType (mempty :: Sum Integer)
                                                                  .&&. checkType (mempty :: Dual (Sum Integer))
                                                                  .&&. checkType (mempty :: (Sum Integer, Sum Int)))

tests :: [(String, Test)]
tests = [("MonoidNull", NullTest checkNull),
         ("mconcat . factors == id", FactorialTest checkConcatFactors),
         ("all factors . factors", FactorialTest checkFactorsOfFactors),
         ("splitPrimePrefix", FactorialTest checkSplitPrimePrefix),
         ("splitPrimeSuffix", FactorialTest checkSplitPrimeSuffix),
         ("primePrefix", FactorialTest checkPrimePrefix),
         ("primeSuffix", FactorialTest checkPrimeSuffix),
         ("foldl", FactorialTest checkLeftFold),
         ("foldl'", FactorialTest checkLeftFold'),
         ("foldr", FactorialTest checkRightFold),
         ("length", FactorialTest checkLength),
         ("span", FactorialTest checkSpan),
         ("split", FactorialTest checkSplit),
         ("splitAt", FactorialTest checkSplitAt),
         ("reverse", FactorialTest checkReverse),
         ("fromText", TextualTest checkFromText),
         ("singleton", TextualTest checkSingleton),
         ("Textual.splitCharacterPrefix", TextualTest checkSplitCharacterPrefix),
         ("Textual.characterPrefix", TextualTest checkCharacterPrefix),
         ("Textual factors", TextualTest checkTextualFactors),
         ("Textual.unfoldr", TextualTest checkUnfoldrToFactors),
         ("factors . fromString", TextualTest checkFactorsFromString),
         ("Textual.map", TextualTest checkTextualMap),
         ("Textual.concatMap", TextualTest checkConcatMap),
         ("Textual.any", TextualTest checkAny),
         ("Textual.all", TextualTest checkAll),
         ("Textual.foldl", TextualTest checkTextualFoldl),
         ("Textual.foldr", TextualTest checkTextualFoldr),
         ("Textual.foldl'", TextualTest checkTextualFoldl'),
         ("Textual.scanl", TextualTest checkTextualScanl),
         ("Textual.scanr", TextualTest checkTextualScanr),
         ("Textual.scanl1", TextualTest checkTextualScanl1),
         ("Textual.scanr1", TextualTest checkTextualScanr1),
         ("Textual.mapAccumL", TextualTest checkTextualMapAccumL),
         ("Textual.mapAccumR", TextualTest checkTextualMapAccumR),
         ("Textual.mapAccumR", TextualTest checkTextualMapAccumR),
         ("Textual.takeWhile", TextualTest checkTextualTakeWhile),
         ("Textual.dropWhile", TextualTest checkTextualDropWhile),
         ("Textual.span", TextualTest checkTextualSpan),
         ("Textual.break", TextualTest checkTextualBreak),
         ("Textual.split", TextualTest checkTextualSplit),
         ("Textual.find", TextualTest checkTextualFind),
         ("stripPrefix", LeftReductiveTest checkStripPrefix),
         ("isPrefixOf", LeftReductiveTest checkIsPrefixOf),
         ("stripSuffix", RightReductiveTest checkStripSuffix),
         ("isSuffixOf", RightReductiveTest checkIsSuffixOf),
         ("</>", ReductiveTest checkUnAppend),
         ("cancellative stripPrefix", LeftCancellativeTest checkStripPrefix'),
         ("cancellative stripSuffix", RightCancellativeTest checkStripSuffix'),
         ("cancellative </>", CancellativeTest checkUnAppend'),
         ("stripCommonPrefix 1", LeftGCDTest checkStripCommonPrefix1),
         ("stripCommonPrefix 2", LeftGCDTest checkStripCommonPrefix2),
         ("stripCommonSuffix 1", RightGCDTest checkStripCommonSuffix1),
         ("stripCommonSuffix 2", RightGCDTest checkStripCommonSuffix2),
         ("gcd", GCDTest checkGCD),
         ("cancellative gcd", CancellativeGCDTest checkCancellativeGCD)
        ]

checkNull :: forall a. (Arbitrary a, Show a, Eq a, MonoidNull a) => a -> Property
checkNull e = null e .&&. forAll (arbitrary :: Gen a) (\a-> null a == (a == mempty))

checkConcatFactors :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property
checkConcatFactors e = null (factors e) .&&. forAll (arbitrary :: Gen a) check
   where check a = mconcat (factors a) == a

checkFactorsOfFactors :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property
checkFactorsOfFactors _ = forAll (arbitrary :: Gen a) (all singleton . factors)
   where singleton prime = factors prime == [prime]

checkSplitPrimePrefix :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property
checkSplitPrimePrefix _ = forAll (arbitrary :: Gen a) (\a-> factors a == unfoldr splitPrimePrefix a)

checkSplitPrimeSuffix :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property
checkSplitPrimeSuffix _ = forAll (arbitrary :: Gen a) check
   where check a = factors a == reverse (unfoldr (fmap swap . splitPrimeSuffix) a)

checkPrimePrefix :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property
checkPrimePrefix _ = forAll (arbitrary :: Gen a) (\a-> primePrefix a == maybe mempty fst (splitPrimePrefix a))

checkPrimeSuffix :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property
checkPrimeSuffix _ = forAll (arbitrary :: Gen a) (\a-> primeSuffix a == maybe mempty snd (splitPrimeSuffix a))

checkLeftFold :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property
checkLeftFold _ = forAll (arbitrary :: Gen a) (\a-> foldl (flip (:)) [] a == List.foldl (flip (:)) [] (factors a))

checkLeftFold' :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property
checkLeftFold' _ = forAll (arbitrary :: Gen a) (\a-> foldl' (flip (:)) [] a == List.foldl' (flip (:)) [] (factors a))

checkRightFold :: forall a. (Arbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property
checkRightFold _ = forAll (arbitrary :: Gen a) (\a-> foldr (:) [] a == List.foldr (:) [] (factors a))

checkLength :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property
checkLength _ = forAll (arbitrary :: Gen a) (\a-> length a == List.length (factors a))

checkSpan :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property
checkSpan _ = property $ \p-> forAll (arbitrary :: Gen a) (check p)
   where check p a = span p a == (mconcat l, mconcat r)
            where (l, r) = List.span p (factors a)

checkSplit :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property
checkSplit _ = forAll (arbitrary :: Gen a) check
   where check a = property (\pred-> all (all (not . pred) . factors) (split pred a))
                   .&&. property (\prime-> mconcat (intersperse prime $ split (== prime) a) == a)

checkSplitAt :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property
checkSplitAt _ = property $ \i-> forAll (arbitrary :: Gen a) (check i)
   where check i a = splitAt i a == (mconcat l, mconcat r)
            where (l, r) = List.splitAt i (factors a)

checkReverse :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, FactorialMonoid a) => a -> Property
checkReverse _ = property $ forAll (arbitrary :: Gen a) (\a-> reverse a == mconcat (List.reverse $ factors a))

checkFromText :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkFromText _ = forAll (arbitrary :: Gen Text) (\t-> Textual.fromText t == (fromString (Text.unpack t) :: a))

checkSingleton :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkSingleton _ = forAll (arbitrary :: Gen Char) (\c-> Textual.singleton c == (fromString [c] :: a))

checkSplitCharacterPrefix :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkSplitCharacterPrefix _ = forAll (arbitrary :: Gen (Char, a)) check
   where check p@(c, t) = Textual.splitCharacterPrefix (Textual.singleton c <> t) == Just p
                          && Textual.splitCharacterPrefix (primePrefix t)
                             == fmap (\(c, t)-> (c, mempty)) (Textual.splitCharacterPrefix t)

checkCharacterPrefix :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkCharacterPrefix _ = forAll (arbitrary :: Gen a) check
   where check t = Textual.characterPrefix t == fmap fst (Textual.splitCharacterPrefix t)

checkTextualFactors :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualFactors _ = forAll (arbitrary :: Gen a) check
   where check a = all (maybe True (null . snd) . Textual.splitCharacterPrefix) (factors a)

checkUnfoldrToFactors :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkUnfoldrToFactors _ = forAll (arbitrary :: Gen a) check
   where check a = factors a == unfoldr splitPrimePrefix a

checkFactorsFromString :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkFactorsFromString _ = forAll (arbitrary :: Gen String) check
   where check s = unfoldr Textual.splitCharacterPrefix (fromString s :: a) == s

checkTextualMap :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualMap _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2
   where check1 a = Textual.map succ a == Textual.concatMap (Textual.singleton . succ) a
                    && Textual.map id a == a
         check2 s = Textual.map succ (fromString s :: a) == fromString (List.map succ s)

checkConcatMap :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkConcatMap _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2
   where check1 a = Textual.concatMap (fromString . f) a == mconcat (map apply $ factors a)
                    && Textual.concatMap Textual.singleton a == a
         check2 s = Textual.concatMap (fromString . f) (fromString s :: a) == fromString (List.concatMap f s)
         f = replicate 3
         apply prime = maybe prime (fromString . f) (Textual.characterPrefix prime)

checkAll :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkAll _ = forAll (arbitrary :: Gen a) check
   where check a = Textual.all isLetter a == Textual.foldr (const id) ((&&) . isLetter) True a

checkAny :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkAny _ = forAll (arbitrary :: Gen a) check
   where check a = Textual.any isLetter a == Textual.foldr (const id) ((||) . isLetter) False a

checkTextualFoldl :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualFoldl _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2
   where check1 a = Textual.foldl (\l a-> Left a : l) (\l c-> Right c : l) [] a == List.reverse (textualFactors a)
                    && Textual.foldl (<>) (\a-> (a <>) . Textual.singleton) mempty a == a
         check2 s = Textual.foldl undefined (flip (:)) [] s == List.foldl (flip (:)) [] s

checkTextualFoldr :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualFoldr _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2
   where check1 a = Textual.foldr (\a l-> Left a : l) (\c l-> Right c : l) [] a == textualFactors a
                    && Textual.foldr (<>) ((<>) . Textual.singleton) mempty a == a
         check2 s = Textual.foldr undefined (:) [] s == s

checkTextualFoldl' :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualFoldl' _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2
   where check1 a = Textual.foldl' (\l a-> Left a : l) (\l c-> Right c : l) [] a == List.reverse (textualFactors a)
                    && Textual.foldl' (<>) (\a-> (a <>) . Textual.singleton) mempty a == a
         check2 s = Textual.foldl' undefined (flip (:)) [] s == List.foldl' (flip (:)) [] s

checkTextualScanl :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualScanl _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2
   where check1 a = (rights . textualFactors . Textual.scanl f 'Z') a == (List.scanl f 'Z' . rights . textualFactors) a
                    && (lefts . textualFactors . Textual.scanl f 'Y') a == (lefts . textualFactors) a
                    && Textual.scanl f 'W' a == Textual.scanl1 f (Textual.singleton 'W' <> a)
         check2 s = Textual.scanl f 'X' (fromString s :: a) == fromString (List.scanl f 'X' s)
         f c1 c2 = succ (max c1 c2)

checkTextualScanr :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualScanr _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2
   where check1 a = (rights . textualFactors . Textual.scanr f 'Z') a == (List.scanr f 'Z' . rights . textualFactors) a
                    && (lefts . textualFactors . Textual.scanr f 'Y') a == (lefts . textualFactors) a
                    && Textual.scanr f 'W' a == Textual.scanr1 f (a <> Textual.singleton 'W')
         check2 s = Textual.scanr f 'X' (fromString s :: a) == fromString (List.scanr f 'X' s)
         f c1 c2 = succ (max c1 c2)

checkTextualScanl1 :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualScanl1 _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2
   where check1 a = Textual.scanl1 (const id) a == a
         check2 s = Textual.scanl1 f (fromString s :: a) == fromString (List.scanl1 f s)
         f c1 c2 = succ (max c1 c2)

checkTextualScanr1 :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualScanr1 _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2
   where check1 a = Textual.scanr1 const a == a
         check2 s = Textual.scanr1 f (fromString s :: a) == fromString (List.scanr1 f s)
         f c1 c2 = succ (max c1 c2)

checkTextualMapAccumL :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualMapAccumL _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2
   where check1 a = uncurry (Textual.mapAccumL (,)) ((), a) == ((), a)
         check2 s = Textual.mapAccumL f c (fromString s :: a) == fmap fromString (List.mapAccumL f c s)
         c = 0 :: Int
         f n c = if isLetter c then (succ n, succ c) else (2*n, c)

checkTextualMapAccumR :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualMapAccumR _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2
   where check1 a = uncurry (Textual.mapAccumR (,)) ((), a) == ((), a)
         check2 s = Textual.mapAccumR f c (fromString s :: a) == fmap fromString (List.mapAccumR f c s)
         c = 0 :: Int
         f n c = if isLetter c then (succ n, succ c) else (2*n, c)

checkTextualTakeWhile :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualTakeWhile _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2
   where check1 a = textualFactors (Textual.takeWhile (const True) isLetter a)
                    == List.takeWhile (either (const True) isLetter) (textualFactors a)
                    && Textual.takeWhile (const True) (const True) a == a
         check2 s = Textual.takeWhile undefined isLetter (fromString s :: a) == fromString (List.takeWhile isLetter s)

checkTextualDropWhile :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualDropWhile _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2
   where check1 a = textualFactors (Textual.dropWhile (const True) isLetter a)
                    == List.dropWhile (either (const True) isLetter) (textualFactors a)
                    && Textual.dropWhile (const False) (const False) a == a
         check2 s = Textual.dropWhile undefined isLetter (fromString s :: a)
                    == fromString (List.dropWhile isLetter s)

checkTextualSpan :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualSpan _ = forAll (arbitrary :: Gen a) check
   where check a = Textual.span pt pc a == (Textual.takeWhile pt pc a, Textual.dropWhile pt pc a)
            where pt = (== primePrefix a)
         pc = isLetter

checkTextualBreak :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualBreak _ = forAll (arbitrary :: Gen a) check
   where check a = Textual.break pt pc a == Textual.span (not . pt) (not . pc) a
            where pt = (/= primePrefix a)
         pc = isLetter

checkTextualSplit :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualSplit _ = forAll (arbitrary :: Gen a) check
   where check a = List.all (List.all isLetter . rights . textualFactors) (Textual.split (not . isLetter) a)
                   && (mconcat . intersperse (fromString " ") . Textual.split (== ' ')) a == a

checkTextualFind :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property
checkTextualFind _ = forAll (arbitrary :: Gen a) check1 .&&. forAll (arbitrary :: Gen String) check2
   where check1 a = Textual.find isLetter a == (List.find isLetter . rights . textualFactors) a
         check2 s = Textual.find isLetter (fromString s :: a) == List.find isLetter s

checkStripPrefix :: forall a. (Arbitrary a, Show a, Eq a, LeftReductiveMonoid a) => a -> Property
checkStripPrefix _ = forAll (arbitrary :: Gen (a, a)) check
   where check (a, b) = maybe b (a <>) (stripPrefix a b) == b

checkIsPrefixOf :: forall a. (Arbitrary a, Show a, Eq a, LeftReductiveMonoid a) => a -> Property
checkIsPrefixOf _ = forAll (arbitrary :: Gen (a, a)) check
   where check (a, b) = isPrefixOf a b == isJust (stripPrefix a b)
                        && a `isPrefixOf` (a <> b)

checkStripSuffix :: forall a. (Arbitrary a, Show a, Eq a, RightReductiveMonoid a) => a -> Property
checkStripSuffix _ = forAll (arbitrary :: Gen (a, a)) check
   where check (a, b) = maybe b (<> a) (stripSuffix a b) == b

checkIsSuffixOf :: forall a. (Arbitrary a, Show a, Eq a, RightReductiveMonoid a) => a -> Property
checkIsSuffixOf _ = forAll (arbitrary :: Gen (a, a)) check
   where check (a, b) = isSuffixOf a b == isJust (stripSuffix a b)
                        && b `isSuffixOf` (a <> b)

checkUnAppend :: forall a. (Arbitrary a, Show a, Eq a, ReductiveMonoid a) => a -> Property
checkUnAppend _ = forAll (arbitrary :: Gen (a, a)) check
   where check (a, b) = maybe a (b <>) (a </> b) == a
                        && maybe a (<> b) (a </> b) == a

checkStripPrefix' :: forall a. (Arbitrary a, Show a, Eq a, LeftCancellativeMonoid a) => a -> Property
checkStripPrefix' _ = forAll (arbitrary :: Gen (a, a)) check
   where check (a, b) = stripPrefix a (a <> b) == Just b

checkStripSuffix' :: forall a. (Arbitrary a, Show a, Eq a, RightCancellativeMonoid a) => a -> Property
checkStripSuffix' _ = forAll (arbitrary :: Gen (a, a)) check
   where check (a, b) = stripSuffix b (a <> b) == Just a

checkUnAppend' :: forall a. (Arbitrary a, Show a, Eq a, CancellativeMonoid a) => a -> Property
checkUnAppend' _ = forAll (arbitrary :: Gen (a, a)) check
   where check (a, b) = a <> b </> a == Just b
                        && a <> b </> b == Just a

checkStripCommonPrefix1 :: forall a. (Arbitrary a, Show a, Eq a, LeftGCDMonoid a) => a -> Property
checkStripCommonPrefix1 _ = forAll (arbitrary :: Gen (a, a)) check
   where check (a, b) = stripCommonPrefix a b == (p, a', b')
            where p = commonPrefix a b
                  Just a' = stripPrefix p a
                  Just b' = stripPrefix p b

checkStripCommonPrefix2 :: forall a. (Arbitrary a, Show a, Eq a, LeftGCDMonoid a) => a -> Property
checkStripCommonPrefix2 _ = forAll (arbitrary :: Gen (a, a)) check
   where check (a, b) = p == commonPrefix a b && p <> a' == a && p <> b' == b
            where (p, a', b') = stripCommonPrefix a b

checkStripCommonSuffix1 :: forall a. (Arbitrary a, Show a, Eq a, RightGCDMonoid a) => a -> Property
checkStripCommonSuffix1 _ = forAll (arbitrary :: Gen (a, a)) check
   where check (a, b) = stripCommonSuffix a b == (a', b', s)
            where s = commonSuffix a b
                  Just a' = stripSuffix s a
                  Just b' = stripSuffix s b

checkStripCommonSuffix2 :: forall a. (Arbitrary a, Show a, Eq a, RightGCDMonoid a) => a -> Property
checkStripCommonSuffix2 _ = forAll (arbitrary :: Gen (a, a)) check
   where check (a, b) = s == commonSuffix a b && a' <> s == a && b' <> s == b
            where (a', b', s) = stripCommonSuffix a b

checkGCD :: forall a. (Arbitrary a, Show a, Eq a, GCDMonoid a) => a -> Property
checkGCD _ = forAll (arbitrary :: Gen (a, a)) check
   where check (a, b) = d == commonPrefix a b
                        && d == commonSuffix a b
                        && isJust (a </> d)
                        && isJust (b </> d)
            where d = gcd a b

checkCancellativeGCD :: forall a. (Arbitrary a, Show a, Eq a, CancellativeMonoid a, GCDMonoid a) => a -> Property
checkCancellativeGCD _ = forAll (arbitrary :: Gen (a, a, a)) check
   where check (a, b, c) = commonPrefix (a <> b) (a <> c) == a <> (commonPrefix b c)
                           && commonSuffix (a <> c) (b <> c) == (commonSuffix a b) <> c
                           && gcd (a <> b) (a <> c) == a <> gcd b c
                           && gcd (a <> c) (b <> c) == gcd a b <> c

textualFactors :: TextualMonoid t => t -> [Either t Char]
textualFactors = map characterize . factors
   where characterize prime = maybe (Left prime) Right (Textual.characterPrefix prime)

newtype TestString = TestString String deriving (Eq, Show, Arbitrary, CoArbitrary, 
                                                 Monoid, LeftReductiveMonoid, LeftCancellativeMonoid, LeftGCDMonoid,
                                                 MonoidNull, IsString)

instance FactorialMonoid TestString where
   splitPrimePrefix (TestString []) = Nothing
   splitPrimePrefix (TestString (x:xs)) = Just (TestString [x], TestString xs)

instance TextualMonoid TestString where
   splitCharacterPrefix (TestString []) = Nothing
   splitCharacterPrefix (TestString (x:xs)) = Just (x, TestString xs)

instance Show a => Show (a -> Bool) where
   show _ = "predicate"

instance Arbitrary All where
   arbitrary = fmap All arbitrary

instance Arbitrary Any where
   arbitrary = fmap Any arbitrary

instance Arbitrary a => Arbitrary (Dual a) where
   arbitrary = fmap Dual arbitrary

instance Arbitrary a => Arbitrary (First a) where
   arbitrary = fmap First arbitrary

instance Arbitrary a => Arbitrary (Last a) where
   arbitrary = fmap Last arbitrary

instance Arbitrary a => Arbitrary (Product a) where
   arbitrary = fmap Product arbitrary

instance Arbitrary a => Arbitrary (Sum a) where
   arbitrary = fmap Sum arbitrary

instance Arbitrary a => Arbitrary (Vector a) where
   arbitrary = fmap fromList arbitrary

instance Arbitrary ByteStringUTF8 where
   arbitrary = fmap ByteStringUTF8 arbitrary

instance CoArbitrary All where
   coarbitrary (All p) = coarbitrary p

instance CoArbitrary Any where
   coarbitrary (Any p) = coarbitrary p

instance CoArbitrary a => CoArbitrary (Dual a) where
   coarbitrary (Dual a) = coarbitrary a

instance CoArbitrary a => CoArbitrary (First a) where
   coarbitrary (First a) = coarbitrary a

instance CoArbitrary a => CoArbitrary (Last a) where
   coarbitrary (Last a) = coarbitrary a

instance CoArbitrary a => CoArbitrary (Product a) where
   coarbitrary (Product a) = coarbitrary a

instance CoArbitrary a => CoArbitrary (Sum a) where
   coarbitrary (Sum a) = coarbitrary a

instance CoArbitrary a => CoArbitrary (Vector a) where
   coarbitrary = coarbitrary . toList

instance CoArbitrary ByteStringUTF8 where
   coarbitrary (ByteStringUTF8 bs) = coarbitrary bs