monoid-subclasses 0.3.3 → 0.3.4
raw patch · 5 files changed
+476/−339 lines, 5 files
Files
- Data/Monoid/Factorial.hs +2/−2
- Data/Monoid/Instances/Concat.hs +0/−10
- Data/Monoid/Instances/Measured.hs +117/−0
- Test/TestMonoidSubclasses.hs +354/−324
- monoid-subclasses.cabal +3/−3
Data/Monoid/Factorial.hs view
@@ -37,7 +37,7 @@ import qualified Data.Vector as Vector import Data.Numbers.Primes (primeFactors) -import Data.Monoid.Null (MonoidNull(null))+import Data.Monoid.Null (MonoidNull(null), PositiveMonoid) -- | 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:@@ -148,7 +148,7 @@ -- | A subclass of 'FactorialMonoid' whose instances satisfy this additional law: -- -- > factors (a <> b) == factors a <> factors b-class FactorialMonoid m => StableFactorialMonoid m+class (FactorialMonoid m, PositiveMonoid m) => StableFactorialMonoid m instance FactorialMonoid () where factors () = []
Data/Monoid/Instances/Concat.hs view
@@ -16,7 +16,6 @@ import Prelude hiding (all, any, break, filter, foldl, foldl1, foldr, foldr1, map, concatMap, length, null, reverse, scanl, scanr, scanl1, scanr1, span, splitAt)-import Control.Applicative (Applicative(..)) import Data.Foldable (Foldable) import Data.Traversable (Traversable, traverse) import qualified Data.Foldable as Foldable@@ -205,15 +204,6 @@ break pt pc = Textual.span (not . pt) (not . pc) find p (Concat x) = getFirst $ Foldable.foldMap (First . find p) x--newtype Pair a = Pair (a, a)--instance Functor Pair where- fmap f (Pair (x, y)) = Pair (f x, f y)--instance Applicative Pair where- pure x = Pair (x, x)- Pair (f, g) <*> Pair (x, y) = Pair (f x, g y) inject :: (MonoidNull a, PositiveMonoid a) => Seq a -> Concat a inject = Concat . filter (not . null)
+ Data/Monoid/Instances/Measured.hs view
@@ -0,0 +1,117 @@+{- + Copyright 2013 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, inject, extract + )+where++import Prelude hiding (all, any, break, filter, foldl, foldl1, foldr, foldr1, map, concatMap, + length, null, reverse, scanl, scanr, scanl1, scanr1, span, splitAt)+import Data.Functor ((<$>))+import qualified Data.List as List+import Data.String (IsString(..))+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++-- | @'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)++inject :: FactorialMonoid a => a -> Measured a+inject x = Measured (length x) x++instance Ord a => Ord (Measured a) where+ compare (Measured _ x) (Measured _ y) = compare x y++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 x) = 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) = inject (commonPrefix x y)++instance (RightGCDMonoid a, StableFactorialMonoid a) => RightGCDMonoid (Measured a) where+ commonSuffix (Measured _ x) (Measured _ y) = inject (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 a (Measured _ x) = Factorial.foldl g a x+ where g a = f a . Measured 1+ foldl' f a (Measured _ x) = Factorial.foldl' g a x+ where g a = f a . Measured 1+ foldr f a (Measured _ x) = Factorial.foldr g a 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' = inject xp+ xs' = Measured (n - length xp') xs+ split p (Measured _ x) = inject <$> 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 = inject . fromString++instance (Eq a, TextualMonoid a, StableFactorialMonoid a) => TextualMonoid (Measured a) where+ fromText = inject . 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 a (Measured _ x) = Textual.foldl (\a-> ft a . Measured 1) fc a x+ foldl' ft fc a (Measured _ x) = Textual.foldl' (\a-> ft a . Measured 1) fc a x+ foldr ft fc a (Measured _ x) = Textual.foldr (ft . Measured 1) fc a x++ span pt pc (Measured n x) = (xp', xs')+ where (xp, xs) = Textual.span (pt . Measured 1) pc x+ xp' = inject xp+ xs' = Measured (n - length xp') xs+ break pt pc = Textual.span (not . pt) (not . pc)++ find p (Measured _ x) = find p x
Test/TestMonoidSubclasses.hs view
@@ -5,6 +5,7 @@ -} {-# LANGUAGE CPP, Rank2Types, ScopedTypeVariables, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ExistentialQuantification #-} module Main where @@ -43,7 +44,10 @@ import Data.Vector (Vector, fromList) import Data.Monoid.Instances.ByteString.UTF8 (ByteStringUTF8(ByteStringUTF8))-import Data.Monoid.Instances.Concat (Concat, extract, inject)+import Data.Monoid.Instances.Concat (Concat)+import qualified Data.Monoid.Instances.Concat as Concat+import Data.Monoid.Instances.Measured (Measured)+import qualified Data.Monoid.Instances.Measured as Measured import Data.Monoid (Monoid, mempty, (<>), mconcat, All(All), Any(Any), Dual(Dual), First(First), Last(Last), Sum(Sum), Product(Product))@@ -60,222 +64,267 @@ import Data.Monoid.Textual (TextualMonoid) import qualified Data.Monoid.Textual as Textual -data Test = CommutativeTest (forall a. (Arbitrary a, Show a, Eq a, CommutativeMonoid a) => a -> Property)- | 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)+data Test = CommutativeTest (CommutativeMonoidInstance -> Property)+ | NullTest (NullMonoidInstance -> Property)+ | PositiveTest (PositiveMonoidInstance -> Property)+ | FactorialTest (FactorialMonoidInstance -> Property)+ | StableFactorialTest (StableFactorialMonoidInstance -> Property)+ | TextualTest (TextualMonoidInstance -> Property)+ | LeftReductiveTest (LeftReductiveMonoidInstance -> Property)+ | RightReductiveTest (RightReductiveMonoidInstance -> Property)+ | ReductiveTest (ReductiveMonoidInstance -> Property)+ | LeftCancellativeTest (LeftCancellativeMonoidInstance -> Property)+ | RightCancellativeTest (RightCancellativeMonoidInstance -> Property)+ | CancellativeTest (CancellativeMonoidInstance -> Property)+ | LeftGCDTest (LeftGCDMonoidInstance -> Property)+ | RightGCDTest (RightGCDMonoidInstance -> Property)+ | GCDTest (GCDMonoidInstance -> Property)+ | CancellativeGCDTest (CancellativeGCDMonoidInstance -> Property) +data CommutativeMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, CommutativeMonoid a) => + CommutativeMonoidInstance 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) =>+ StableFactorialMonoidInstance 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,+ TextualMonoid a) =>+ StableTextualMonoidInstance a+data LeftReductiveMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, LeftReductiveMonoid a) => + LeftReductiveMonoidInstance a+data RightReductiveMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, RightReductiveMonoid a) => + RightReductiveMonoidInstance a+data ReductiveMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, ReductiveMonoid a) => + ReductiveMonoidInstance a+data LeftCancellativeMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, LeftCancellativeMonoid a) => + LeftCancellativeMonoidInstance a+data RightCancellativeMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, RightCancellativeMonoid a) => + RightCancellativeMonoidInstance a+data CancellativeMonoidInstance = forall a. (Arbitrary a, Show a, Eq a, CancellativeMonoid a) => + CancellativeMonoidInstance 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) => + RightGCDMonoidInstance 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) => + CancellativeGCDMonoidInstance a++commutativeInstances :: [CommutativeMonoidInstance]+commutativeInstances = map upcast reductiveInstances+ ++ [CommutativeMonoidInstance (mempty :: Product Double)]+ where upcast (ReductiveMonoidInstance i) = CommutativeMonoidInstance i++nullInstances :: [NullMonoidInstance]+nullInstances = map upcast factorialInstances+ ++ [NullMonoidInstance (mempty :: Ordering),+ NullMonoidInstance (mempty :: All),+ NullMonoidInstance (mempty :: Any),+ NullMonoidInstance (mempty :: Sum Float),+ NullMonoidInstance (mempty :: Product Int),+ NullMonoidInstance (mempty :: First Int),+ NullMonoidInstance (mempty :: Last Int),+ NullMonoidInstance (mempty :: Concat Any),+ NullMonoidInstance (mempty :: Concat (Dual String)),+ NullMonoidInstance (mempty :: Concat (Map String Int))]+ where upcast (FactorialMonoidInstance i) = NullMonoidInstance i++positiveInstances = map upcast stableFactorialInstances+ ++ [PositiveMonoidInstance (mempty :: ()),+ PositiveMonoidInstance (mempty :: Ordering),+ PositiveMonoidInstance (mempty :: All),+ PositiveMonoidInstance (mempty :: Any),+ PositiveMonoidInstance (mempty :: (Maybe (Sum Int))),+ PositiveMonoidInstance (mempty :: (First Char)),+ PositiveMonoidInstance (mempty :: (Last Int)),+ PositiveMonoidInstance (mempty :: String),+ PositiveMonoidInstance (mempty :: (Map Int16 Int)),+ PositiveMonoidInstance (mempty :: (IntMap Char)),+ PositiveMonoidInstance (mempty :: IntSet),+ PositiveMonoidInstance (mempty :: (Set Float)),+ PositiveMonoidInstance (mempty :: (Dual ()))]+ where upcast (StableFactorialMonoidInstance i) = PositiveMonoidInstance i++factorialInstances :: [FactorialMonoidInstance]+factorialInstances = map upcast stableFactorialInstances+ ++ [FactorialMonoidInstance (mempty :: Sum Int8),+ FactorialMonoidInstance (mempty :: Product Int32),+ FactorialMonoidInstance (mempty :: Maybe String),+ FactorialMonoidInstance (mempty :: (Text, String)),+ FactorialMonoidInstance (mempty :: IntMap Int),+ FactorialMonoidInstance (mempty :: IntSet),+ FactorialMonoidInstance (mempty :: Map String Int),+ FactorialMonoidInstance (mempty :: Set String),+ FactorialMonoidInstance (mempty :: Concat ByteString),+ FactorialMonoidInstance (mempty :: Concat (Dual ByteString)),+ FactorialMonoidInstance (mempty :: Concat (Maybe String)),+ FactorialMonoidInstance (mempty :: Concat (Text, String)),+ FactorialMonoidInstance (mempty :: Concat (IntMap Int))]+ where upcast (StableFactorialMonoidInstance i) = FactorialMonoidInstance i++stableFactorialInstances :: [StableFactorialMonoidInstance]+stableFactorialInstances = stable1 ++ map measure stable1+ where stable1 = map upcast stableTextualInstances+ ++ [StableFactorialMonoidInstance (mempty :: ByteString),+ StableFactorialMonoidInstance (mempty :: Lazy.ByteString),+ StableFactorialMonoidInstance (mempty :: Dual String),+ StableFactorialMonoidInstance (mempty :: Seq Int),+ StableFactorialMonoidInstance (mempty :: Vector Int)]+ upcast (StableTextualMonoidInstance i) = StableFactorialMonoidInstance i+ measure (StableFactorialMonoidInstance i) = StableFactorialMonoidInstance (Measured.inject i)++textualInstances :: [TextualMonoidInstance]+textualInstances = map upcast stableTextualInstances+ ++ [TextualMonoidInstance (mempty :: ByteStringUTF8),+ TextualMonoidInstance (mempty :: Text),+ TextualMonoidInstance (mempty :: Lazy.Text),+ TextualMonoidInstance (mempty :: Seq Char),+ TextualMonoidInstance (mempty :: Vector Char)]+ where upcast (StableTextualMonoidInstance i) = TextualMonoidInstance i++stableTextualInstances :: [StableTextualMonoidInstance]+stableTextualInstances = [StableTextualMonoidInstance (mempty :: TestString),+ StableTextualMonoidInstance (mempty :: String),+ StableTextualMonoidInstance (mempty :: Text),+ StableTextualMonoidInstance (mempty :: Lazy.Text),+ StableTextualMonoidInstance (mempty :: Seq Char),+ StableTextualMonoidInstance (mempty :: Vector Char)]++leftReductiveInstances = map upcast leftCancellativeInstances+ ++ [LeftReductiveMonoidInstance (mempty :: Sum Integer),+ LeftReductiveMonoidInstance (mempty :: IntSet),+ LeftReductiveMonoidInstance (mempty :: Set Integer),+ 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))]+ where upcast (LeftCancellativeMonoidInstance i) = LeftReductiveMonoidInstance i++rightReductiveInstances = map upcast rightCancellativeInstances+ ++ [RightReductiveMonoidInstance (mempty :: Product Integer),+ RightReductiveMonoidInstance (mempty :: IntSet),+ 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))]+ where upcast (RightCancellativeMonoidInstance i) = RightReductiveMonoidInstance i++reductiveInstances = map upcast cancellativeInstances+ ++ [ReductiveMonoidInstance (mempty :: Product Integer),+ ReductiveMonoidInstance (mempty :: IntSet),+ ReductiveMonoidInstance (mempty :: Set Integer)]+ where upcast (CancellativeMonoidInstance i) = ReductiveMonoidInstance i++leftCancellativeInstances = map upcast cancellativeInstances+ ++ [LeftCancellativeMonoidInstance (mempty :: String),+ LeftCancellativeMonoidInstance (mempty :: ByteString),+ LeftCancellativeMonoidInstance (mempty :: Lazy.ByteString),+ LeftCancellativeMonoidInstance (mempty :: Text),+ LeftCancellativeMonoidInstance (mempty :: Lazy.Text),+ LeftCancellativeMonoidInstance (mempty :: Dual Text),+ LeftCancellativeMonoidInstance (mempty :: (Text, String)),+ LeftCancellativeMonoidInstance (mempty :: Seq Int),+ LeftCancellativeMonoidInstance (mempty :: Vector Int)]+ where upcast (CancellativeMonoidInstance i) = LeftCancellativeMonoidInstance i++rightCancellativeInstances = map upcast cancellativeInstances+ ++ [RightCancellativeMonoidInstance (mempty :: ByteString),+ RightCancellativeMonoidInstance (mempty :: Lazy.ByteString),+ RightCancellativeMonoidInstance (mempty :: Text),+ RightCancellativeMonoidInstance (mempty :: Lazy.Text),+ RightCancellativeMonoidInstance (mempty :: Dual String),+ RightCancellativeMonoidInstance (mempty :: (Text, ByteString)),+ RightCancellativeMonoidInstance (mempty :: Seq Int),+ RightCancellativeMonoidInstance (mempty :: Vector Int)]+ where upcast (CancellativeMonoidInstance i) = RightCancellativeMonoidInstance i++cancellativeInstances = map upcast cancellativeGCDInstances+ ++ []+ where upcast (CancellativeGCDMonoidInstance i) = CancellativeMonoidInstance i++leftGCDInstances = map upcast gcdInstances+ ++ [LeftGCDMonoidInstance (mempty :: String),+ LeftGCDMonoidInstance (mempty :: ByteString),+ LeftGCDMonoidInstance (mempty :: Lazy.ByteString),+ LeftGCDMonoidInstance (mempty :: Text),+ LeftGCDMonoidInstance (mempty :: Lazy.Text),+ LeftGCDMonoidInstance (mempty :: Dual ByteString),+ LeftGCDMonoidInstance (mempty :: (Text, String)),+ LeftGCDMonoidInstance (mempty :: IntMap Int),+ LeftGCDMonoidInstance (mempty :: Map String Int),+ LeftGCDMonoidInstance (mempty :: Seq Int),+ LeftGCDMonoidInstance (mempty :: Vector Int),+ LeftGCDMonoidInstance (mempty :: Concat String),+ LeftGCDMonoidInstance (mempty :: Concat ByteString),+ LeftGCDMonoidInstance (mempty :: Concat Lazy.ByteString),+ LeftGCDMonoidInstance (mempty :: Concat Text),+ LeftGCDMonoidInstance (mempty :: Concat Lazy.Text),+ LeftGCDMonoidInstance (mempty :: Concat (Dual ByteString))]+ where upcast (GCDMonoidInstance i) = LeftGCDMonoidInstance i++rightGCDInstances = map upcast gcdInstances+ ++ [RightGCDMonoidInstance (mempty :: ByteString),+ RightGCDMonoidInstance (mempty :: Lazy.ByteString),+ RightGCDMonoidInstance (mempty :: Dual String),+ RightGCDMonoidInstance (mempty :: (Seq Int, ByteString)),+ RightGCDMonoidInstance (mempty :: Seq Int),+ RightGCDMonoidInstance (mempty :: Vector Int),+ RightGCDMonoidInstance (mempty :: Concat ByteString),+ RightGCDMonoidInstance (mempty :: Concat Lazy.ByteString),+ RightGCDMonoidInstance (mempty :: Concat (Dual Text))]+ where upcast (GCDMonoidInstance i) = RightGCDMonoidInstance i++gcdInstances = map upcast cancellativeGCDInstances+ ++ [GCDMonoidInstance (mempty :: Product Integer),+ GCDMonoidInstance (mempty :: Dual (Product Integer)),+ 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, Sum Int))]+ main = mapM_ (quickCheck . uncurry checkInstances) tests checkInstances :: String -> Test -> Property-checkInstances name (CommutativeTest checkType) = label name (checkType ()- .&&. 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 (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)- .&&. checkType (mempty :: Concat Any)- .&&. checkType (mempty :: Concat String)- .&&. checkType (mempty :: Concat ByteString)- .&&. checkType (mempty :: Concat Text)- .&&. checkType (mempty :: Concat Lazy.Text)- .&&. checkType (mempty :: Concat (Dual String))- .&&. checkType (mempty :: Concat (Maybe String))- .&&. checkType (mempty :: Concat (Text, String))- .&&. checkType (mempty :: Concat (IntMap Int))- .&&. checkType (mempty :: Concat (Map String Int)))-checkInstances name (FactorialTest checkType) = label name (checkType ()- .&&. 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)- .&&. checkType (mempty :: Concat String)- .&&. checkType (mempty :: Concat ByteString)- .&&. checkType (mempty :: Concat Text)- .&&. checkType (mempty :: Concat Lazy.Text)- .&&. checkType (mempty :: Concat (Dual ByteString))- .&&. checkType (mempty :: Concat (Maybe String))- .&&. checkType (mempty :: Concat (Text, String))- .&&. checkType (mempty :: Concat (IntMap Int)))-checkInstances name (TextualTest checkType) = label name (checkType (mempty :: TestString)- .&&. checkType (mempty :: String)- .&&. checkType (mempty :: ByteStringUTF8)- .&&. checkType (mempty :: Text)- .&&. checkType (mempty :: Lazy.Text)- .&&. checkType (mempty :: Seq Char)- .&&. checkType (mempty :: Vector Char)- .&&. checkType (mempty :: Concat String)- .&&. checkType (mempty :: Concat Text)- .&&. checkType (mempty :: Concat Lazy.Text))-checkInstances name (LeftReductiveTest checkType) = label name (checkType ()- .&&. 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)- .&&. checkType (mempty :: Concat String)- .&&. checkType (mempty :: Concat ByteString)- .&&. checkType (mempty :: Concat Lazy.ByteString)- .&&. checkType (mempty :: Concat Text)- .&&. checkType (mempty :: Concat Lazy.Text)- .&&. checkType (mempty :: Concat (Dual Text)))-checkInstances name (RightReductiveTest checkType) = label name (checkType ()- .&&. 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)- .&&. checkType (mempty :: Concat ByteString)- .&&. checkType (mempty :: Concat Lazy.ByteString)- .&&. checkType (mempty :: Concat Text)- .&&. checkType (mempty :: Concat Lazy.Text)- .&&. checkType (mempty :: Concat (Dual Text)))-checkInstances name (ReductiveTest checkType) = label name (checkType ()- .&&. 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 ()- .&&. 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 ()- .&&. 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 ()- .&&. checkType (mempty :: Sum Integer)- .&&. checkType (mempty :: Dual (Sum Integer))- .&&. checkType (mempty :: (Sum Integer, Sum Int)))-checkInstances name (LeftGCDTest checkType) = label name (checkType ()- .&&. 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)- .&&. checkType (mempty :: Concat String)- .&&. checkType (mempty :: Concat ByteString)- .&&. checkType (mempty :: Concat Lazy.ByteString)- .&&. checkType (mempty :: Concat Text)- .&&. checkType (mempty :: Concat Lazy.Text)- .&&. checkType (mempty :: Concat (Dual ByteString)))-checkInstances name (RightGCDTest checkType) = label name (checkType ()- .&&. 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)- .&&. checkType (mempty :: Concat ByteString)- .&&. checkType (mempty :: Concat Lazy.ByteString)- .&&. checkType (mempty :: Concat (Dual Text)))-checkInstances name (GCDTest checkType) = label name (checkType ()- .&&. 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 ()- .&&. checkType (mempty :: Sum Integer)- .&&. checkType (mempty :: Dual (Sum Integer))- .&&. checkType (mempty :: (Sum Integer, Sum Int)))+checkInstances name (CommutativeTest checkType) = label name $ foldr1 (.&&.) (map checkType commutativeInstances)+checkInstances name (NullTest checkType) = label name $ foldr1 (.&&.) (map checkType nullInstances)+checkInstances name (PositiveTest checkType) = label name $ foldr1 (.&&.) (map checkType positiveInstances)+checkInstances name (FactorialTest checkType) = label name $ foldr1 (.&&.) (map checkType factorialInstances)+checkInstances name (StableFactorialTest checkType) =+ label name $ foldr1 (.&&.) (map checkType stableFactorialInstances)+checkInstances name (TextualTest checkType) = label name $ foldr1 (.&&.) (map checkType textualInstances)+checkInstances name (LeftReductiveTest checkType) = label name $ foldr1 (.&&.) (map checkType leftReductiveInstances)+checkInstances name (RightReductiveTest checkType) = label name $ foldr1 (.&&.) (map checkType rightReductiveInstances)+checkInstances name (ReductiveTest checkType) = label name $ foldr1 (.&&.) (map checkType reductiveInstances)+checkInstances name (LeftCancellativeTest checkType) =+ label name $ foldr1 (.&&.) (map checkType leftCancellativeInstances) +checkInstances name (RightCancellativeTest checkType) =+ label name $ foldr1 (.&&.) (map checkType rightCancellativeInstances) +checkInstances name (CancellativeTest checkType) = label name $ foldr1 (.&&.) (map checkType cancellativeInstances) +checkInstances name (LeftGCDTest checkType) = label name $ foldr1 (.&&.) (map checkType leftGCDInstances) +checkInstances name (RightGCDTest checkType) = label name $ foldr1 (.&&.) (map checkType rightGCDInstances) +checkInstances name (GCDTest checkType) = label name $ foldr1 (.&&.) (map checkType gcdInstances) +checkInstances name (CancellativeGCDTest checkType) = + label name $ foldr1 (.&&.) (map checkType cancellativeGCDInstances) tests :: [(String, Test)] tests = [("CommutativeMonoid", CommutativeTest checkCommutative), ("MonoidNull", NullTest checkNull),+ ("PositiveMonoid", PositiveTest checkPositive), ("mconcat . factors == id", FactorialTest checkConcatFactors), ("all factors . factors", FactorialTest checkFactorsOfFactors), ("splitPrimePrefix", FactorialTest checkSplitPrimePrefix),@@ -290,6 +339,7 @@ ("split", FactorialTest checkSplit), ("splitAt", FactorialTest checkSplitAt), ("reverse", FactorialTest checkReverse),+ ("stable", StableFactorialTest checkStability), ("fromText", TextualTest checkFromText), ("singleton", TextualTest checkSingleton), ("Textual.splitCharacterPrefix", TextualTest checkSplitCharacterPrefix),@@ -332,280 +382,254 @@ ("cancellative gcd", CancellativeGCDTest checkCancellativeGCD) ] -checkCommutative :: forall a. (Arbitrary a, Show a, Eq a, CommutativeMonoid a) => a -> Property-checkCommutative e = forAll (arbitrary :: Gen (a, a)) (\(a, b)-> a <> b == b <> a)+checkCommutative (CommutativeMonoidInstance (e :: a)) = forAll (arbitrary :: Gen (a, a)) (\(a, b)-> a <> b == b <> a) -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))+checkNull (NullMonoidInstance (e :: a)) = 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+checkPositive (PositiveMonoidInstance (_ :: a)) =+ forAll (arbitrary :: Gen (a, a)) (\(a, b)-> null a && null b || not (null (a <> b)))++checkConcatFactors (FactorialMonoidInstance (e :: a)) = 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)+checkFactorsOfFactors (FactorialMonoidInstance (_ :: a)) = 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)+checkSplitPrimePrefix (FactorialMonoidInstance (_ :: a)) = + 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+checkSplitPrimeSuffix (FactorialMonoidInstance (_ :: a)) = 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))+checkPrimePrefix (FactorialMonoidInstance (_ :: a)) = + 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))+checkPrimeSuffix (FactorialMonoidInstance (_ :: a)) = + 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 (FactorialMonoidInstance (_ :: a)) = + 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))+checkLeftFold' (FactorialMonoidInstance (_ :: a)) = + 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))+checkRightFold (FactorialMonoidInstance (_ :: a)) = + 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))+checkLength (FactorialMonoidInstance (_ :: a)) = + 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)+checkSpan (FactorialMonoidInstance (_ :: a)) = 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+checkSplit (FactorialMonoidInstance (_ :: a)) = 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)+checkSplitAt (FactorialMonoidInstance (_ :: a)) = 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))+checkReverse (FactorialMonoidInstance (_ :: a)) = + 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))+checkStability (StableFactorialMonoidInstance (_ :: a)) =+ property $ forAll (arbitrary :: Gen (a, a)) (\(a, b)-> factors (a <> b) == factors a <> factors b) -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))+checkFromText (TextualMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen Text) (\t-> Textual.fromText t == (fromString (Text.unpack t) :: a)) -checkSplitCharacterPrefix :: forall a. (Arbitrary a, CoArbitrary a, Show a, Eq a, TextualMonoid a) => a -> Property-checkSplitCharacterPrefix _ = forAll (arbitrary :: Gen String) check1 .&&. forAll (arbitrary :: Gen a) check2+checkSingleton (TextualMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen Char) (\c-> Textual.singleton c == (fromString [c] :: a))++checkSplitCharacterPrefix (TextualMonoidInstance (_ :: a)) = + forAll (arbitrary :: Gen String) check1 .&&. forAll (arbitrary :: Gen a) check2 where check1 s = unfoldr Textual.splitCharacterPrefix (fromString s :: a) == s check2 t = 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+checkCharacterPrefix (TextualMonoidInstance (_ :: a)) = 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+checkTextualFactors (TextualMonoidInstance (_ :: a)) = 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+checkUnfoldrToFactors (TextualMonoidInstance (_ :: a)) = 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+checkFactorsFromString (TextualMonoidInstance (_ :: a)) = 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+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 && 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+checkConcatMap (TextualMonoidInstance (_ :: a)) = + 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+checkAll (TextualMonoidInstance (_ :: a)) = 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+checkAny (TextualMonoidInstance (_ :: a)) = 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+checkTextualFoldl (TextualMonoidInstance (_ :: a)) = + 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+checkTextualFoldr (TextualMonoidInstance (_ :: a)) = + 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+checkTextualFoldl' (TextualMonoidInstance (_ :: a)) = + 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+checkTextualScanl (TextualMonoidInstance (_ :: a)) = + 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 = min 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+checkTextualScanr (TextualMonoidInstance (_ :: a)) = + 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 = min 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+checkTextualScanl1 (TextualMonoidInstance (_ :: a)) = + 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 = min 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+checkTextualScanr1 (TextualMonoidInstance (_ :: a)) = 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 = min 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+checkTextualMapAccumL (TextualMonoidInstance (_ :: a)) = + 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+checkTextualMapAccumR (TextualMonoidInstance (_ :: a)) = + 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+checkTextualTakeWhile (TextualMonoidInstance (_ :: a)) = + 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+checkTextualDropWhile (TextualMonoidInstance (_ :: a)) = + 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+checkTextualSpan (TextualMonoidInstance (_ :: a)) = 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+checkTextualBreak (TextualMonoidInstance (_ :: a)) = 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+checkTextualSplit (TextualMonoidInstance (_ :: a)) = 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+checkTextualFind (TextualMonoidInstance (_ :: a)) = + 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+checkStripPrefix (LeftReductiveMonoidInstance (_ :: a)) = 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+checkIsPrefixOf (LeftReductiveMonoidInstance (_ :: a)) = 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+checkStripSuffix (RightReductiveMonoidInstance (_ :: a)) = 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+checkIsSuffixOf (RightReductiveMonoidInstance (_ :: a)) = 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+checkUnAppend (ReductiveMonoidInstance (_ :: a)) = 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+checkStripPrefix' (LeftCancellativeMonoidInstance (_ :: a)) = 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+checkStripSuffix' (RightCancellativeMonoidInstance (_ :: a)) = 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+checkUnAppend' (CancellativeMonoidInstance (_ :: a)) = 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+checkStripCommonPrefix1 (LeftGCDMonoidInstance (_ :: a)) = 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+checkStripCommonPrefix2 (LeftGCDMonoidInstance (_ :: a)) = 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+checkStripCommonSuffix1 (RightGCDMonoidInstance (_ :: a)) = 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+checkStripCommonSuffix2 (RightGCDMonoidInstance (_ :: a)) = 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+checkGCD (GCDMonoidInstance (_ :: a)) = 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+checkCancellativeGCD (CancellativeGCDMonoidInstance (_ :: a)) = 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@@ -617,7 +641,7 @@ newtype TestString = TestString String deriving (Eq, Show, Arbitrary, CoArbitrary, Monoid, LeftReductiveMonoid, LeftCancellativeMonoid, LeftGCDMonoid,- MonoidNull, IsString)+ MonoidNull, PositiveMonoid, StableFactorialMonoid, IsString) instance FactorialMonoid TestString where splitPrimePrefix (TestString []) = Nothing@@ -655,8 +679,11 @@ arbitrary = fmap ByteStringUTF8 arbitrary instance (Arbitrary a, MonoidNull a, PositiveMonoid a) => Arbitrary (Concat a) where- arbitrary = fmap inject arbitrary+ arbitrary = fmap Concat.inject arbitrary +instance (Arbitrary a, MonoidNull a, FactorialMonoid a) => Arbitrary (Measured a) where+ arbitrary = fmap Measured.inject arbitrary+ instance CoArbitrary All where coarbitrary (All p) = coarbitrary p @@ -685,7 +712,10 @@ coarbitrary (ByteStringUTF8 bs) = coarbitrary bs instance CoArbitrary a => CoArbitrary (Concat a) where- coarbitrary = coarbitrary . extract+ coarbitrary = coarbitrary . Concat.extract++instance CoArbitrary a => CoArbitrary (Measured a) where+ coarbitrary = coarbitrary . Measured.extract instance Show a => Show (a -> Bool) where show _ = "predicate"
monoid-subclasses.cabal view
@@ -1,5 +1,5 @@ Name: monoid-subclasses-Version: 0.3.3+Version: 0.3.4 Cabal-Version: >= 1.10 Build-Type: Simple Synopsis: Subclasses of Monoid@@ -22,7 +22,7 @@ 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.ByteString.UTF8, Data.Monoid.Instances.Concat, Data.Monoid.Instances.Measured Build-Depends: base < 5, bytestring >= 0.9 && < 1.0, containers == 0.5.*, text == 0.11.*, primes == 0.2.*, vector >= 0.9 && < 0.11 GHC-prof-options: -auto-all@@ -37,5 +37,5 @@ test-framework >= 0.4.1, test-framework-quickcheck2 Main-is: Test/TestMonoidSubclasses.hs Other-Modules: Data.Monoid.Cancellative, Data.Monoid.Factorial, Data.Monoid.Null, Data.Monoid.Textual,- Data.Monoid.Instances.ByteString.UTF8+ Data.Monoid.Instances.ByteString.UTF8, Data.Monoid.Instances.Concat, Data.Monoid.Instances.Measured default-language: Haskell2010