quickcheck-quid 0.0.1 → 0.0.1.1

raw patch · 44 files changed

+1781/−1692 lines, 44 filesdep ~QuickCheckdep ~basedep ~containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: QuickCheck, base, containers, deepseq, extra, fmt, hashable, hspec, pretty-simple, primes, quickcheck-classes, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• LICENSE +1/−1
• README.md +3/−2
• quickcheck-quid.cabal +61/−31
• src/example/Test/QuickCheck/Quid/Example.hs +34/−0
• src/internal/Internal/Test/QuickCheck.hs +19/−0
• src/internal/Internal/Test/QuickCheck/Quid.hs +102/−0
• src/internal/Internal/Test/QuickCheck/Quid/Combinators/Chunk.hs +40/−0
• src/internal/Internal/Test/QuickCheck/Quid/Combinators/Prefix.hs +47/−0
• src/internal/Internal/Test/QuickCheck/Quid/Combinators/Size.hs +38/−0
• src/internal/Internal/Test/QuickCheck/Quid/Representations.hs +40/−0
• src/internal/Internal/Test/QuickCheck/Quid/Representations/Decimal.hs +55/−0
• src/internal/Internal/Test/QuickCheck/Quid/Representations/Hexadecimal.hs +54/−0
• src/internal/Internal/Test/QuickCheck/Quid/Representations/Latin.hs +164/−0
• src/internal/Internal/Text/Read.hs +28/−0
• src/public/Test/QuickCheck/Quid.hs +29/−0
• src/quickcheck-quid-example/Test/QuickCheck/Quid/Example.hs +0/−34
• src/quickcheck-quid-internal/Internal/Test/QuickCheck.hs +0/−19
• src/quickcheck-quid-internal/Internal/Test/QuickCheck/Quid.hs +0/−102
• src/quickcheck-quid-internal/Internal/Test/QuickCheck/Quid/Combinators/Chunk.hs +0/−40
• src/quickcheck-quid-internal/Internal/Test/QuickCheck/Quid/Combinators/Prefix.hs +0/−47
• src/quickcheck-quid-internal/Internal/Test/QuickCheck/Quid/Combinators/Size.hs +0/−38
• src/quickcheck-quid-internal/Internal/Test/QuickCheck/Quid/Representations.hs +0/−40
• src/quickcheck-quid-internal/Internal/Test/QuickCheck/Quid/Representations/Decimal.hs +0/−55
• src/quickcheck-quid-internal/Internal/Test/QuickCheck/Quid/Representations/Hexadecimal.hs +0/−54
• src/quickcheck-quid-internal/Internal/Test/QuickCheck/Quid/Representations/Latin.hs +0/−162
• src/quickcheck-quid-internal/Internal/Text/Read.hs +0/−28
• src/quickcheck-quid-test/Spec.hs +0/−1
• src/quickcheck-quid-test/Test/Hspec/Unit.hs +0/−56
• src/quickcheck-quid-test/Test/QuickCheck/Classes/Hspec.hs +0/−61
• src/quickcheck-quid-test/Test/QuickCheck/Quid/Combinators/PrefixSpec.hs +0/−49
• src/quickcheck-quid-test/Test/QuickCheck/Quid/Representations/DecimalSpec.hs +0/−91
• src/quickcheck-quid-test/Test/QuickCheck/Quid/Representations/HexadecimalSpec.hs +0/−106
• src/quickcheck-quid-test/Test/QuickCheck/Quid/Representations/LatinSpec.hs +0/−121
• src/quickcheck-quid-test/Test/QuickCheck/QuidSpec.hs +0/−525
• src/quickcheck-quid/Test/QuickCheck/Quid.hs +0/−29
• src/test/Spec.hs +1/−0
• src/test/Test/Hspec/Unit.hs +56/−0
• src/test/Test/QuickCheck/Classes/Hspec.hs +61/−0
• src/test/Test/QuickCheck/Quid/Combinators/PrefixSpec.hs +49/−0
• src/test/Test/QuickCheck/Quid/Representations/DecimalSpec.hs +91/−0
• src/test/Test/QuickCheck/Quid/Representations/HexadecimalSpec.hs +106/−0
• src/test/Test/QuickCheck/Quid/Representations/LatinSpec.hs +145/−0
• src/test/Test/QuickCheck/QuidSpec.hs +550/−0

@@ -0,0 +1,7 @@+# 0.0.1.1++- Added support for GHC 9.8.++# 0.0.1++Initial release.

@@ -186,7 +186,7 @@       same "printed page" as the copyright notice for easier       identification within third-party archives. -   Copyright © 2022 Jonathan Knowles+   Copyright © 2022–2023 Jonathan Knowles     Licensed under the Apache License, Version 2.0 (the "License");    you may not use this file except in compliance with the License.

@@ -1,3 +1,4 @@-Quasi-unique identifiers for QuickCheck.+# `quickcheck-quid`+<a href="https://jonathanknowles.github.io/quickcheck-quid/"><img src="https://img.shields.io/badge/API-Documentation-227755" /></a> -![Build Status](https://github.com/jonathanknowles/quickcheck-quid/actions/workflows/haskell.yml/badge.svg)+Quasi-unique identifiers for QuickCheck.

@@ -1,12 +1,12 @@ cabal-version:  3.0 name:           quickcheck-quid-version:        0.0.1+version:        0.0.1.1 bug-reports:    https://github.com/jonathanknowles/quickcheck-quid/issues license:        Apache-2.0 license-file:   LICENSE author:         Jonathan Knowles maintainer:     mail@jonathanknowles.net-copyright:      2022 Jonathan Knowles+copyright:      2022–2023 Jonathan Knowles category:       Testing synopsis:       Quasi-unique identifiers for QuickCheck description:@@ -16,39 +16,75 @@      https://github.com/jonathanknowles/quickcheck-quid/blob/main/README.md -extra-source-files:+extra-doc-files:+    CHANGELOG.md     README.md  source-repository head     type: git     location: https://github.com/jonathanknowles/quickcheck-quid +common dependency-base+    build-depends:base                          >= 4.14.3.0   && < 4.20+common dependency-containers+    build-depends:containers                    >= 0.5.7.0    && < 0.7+common dependency-deepseq+    build-depends:deepseq                       >= 1.4.4.0    && < 1.6+common dependency-extra+    build-depends:extra                         >= 1.5        && < 1.8+common dependency-fmt+    build-depends:fmt                           >= 0.6.1      && < 0.7+common dependency-hashable+    build-depends:hashable                      >= 1.3.0.0    && < 1.5+common dependency-hspec+    build-depends:hspec                         >= 2.7.1      && < 2.12+common dependency-pretty-simple+    build-depends:pretty-simple                 >= 1.0.0.0    && < 4.2+common dependency-primes+    build-depends:primes                        >= 0.2.0.0    && < 0.3+common dependency-QuickCheck+    build-depends:QuickCheck                    >= 2.14       && < 2.15+common dependency-quickcheck-classes+    build-depends:quickcheck-classes            >= 0.6.2.0    && < 0.7+common dependency-text+    build-depends:text                          >= 1.2.3.2    && < 2.2+ library+    import:+      , dependency-base     hs-source-dirs:-        src/quickcheck-quid+        src/public     exposed-modules:         Test.QuickCheck.Quid     default-language:         Haskell2010     build-depends:-        base >=4.7 && <5-      , quickcheck-quid-internal+      , quickcheck-quid:internal -library quickcheck-quid-example+library example+    import:+      , dependency-base+      , dependency-QuickCheck     hs-source-dirs:-        src/quickcheck-quid-example+        src/example     exposed-modules:         Test.QuickCheck.Quid.Example     default-language:         Haskell2010     build-depends:-        QuickCheck-      , base >=4.7 && <5       , quickcheck-quid -library quickcheck-quid-internal+library internal+    import:+      , dependency-base+      , dependency-containers+      , dependency-deepseq+      , dependency-extra+      , dependency-hashable+      , dependency-QuickCheck+      , dependency-text     hs-source-dirs:-        src/quickcheck-quid-internal+        src/internal     exposed-modules:         Internal.Test.QuickCheck         Internal.Test.QuickCheck.Quid@@ -63,19 +99,22 @@     default-language:         Haskell2010     build-depends:-        QuickCheck-      , base >=4.7 && <5-      , containers-      , deepseq-      , extra-      , hashable-      , text -test-suite quickcheck-quid-test+test-suite test+    import:+      , dependency-base+      , dependency-containers+      , dependency-fmt+      , dependency-hspec+      , dependency-pretty-simple+      , dependency-primes+      , dependency-QuickCheck+      , dependency-quickcheck-classes+      , dependency-text     main-is:         Spec.hs     hs-source-dirs:-        src/quickcheck-quid-test+        src/test     other-modules:         Test.QuickCheck.Classes.Hspec         Test.QuickCheck.QuidSpec@@ -90,14 +129,5 @@     build-tool-depends:         hspec-discover:hspec-discover ==2.*     build-depends:-        QuickCheck-      , base >=4.7 && <5-      , containers-      , fmt-      , hspec-      , pretty-simple-      , primes-      , quickcheck-classes       , quickcheck-quid-      , quickcheck-quid-internal-      , text+      , quickcheck-quid:internal

@@ -0,0 +1,34 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Test.QuickCheck.Quid.Example where++import GHC.Generics+    ( Generic )+import Test.QuickCheck+    ( Arbitrary, CoArbitrary, Function )+import Test.QuickCheck.Quid+    ( Decimal (..), Hexadecimal (..), Latin (..), Quid, Size (..) )++newtype FooId = FooId (Decimal Quid)+    deriving stock (Eq, Generic, Ord, Read, Show)+    deriving Arbitrary via Size 256 Quid+    deriving CoArbitrary via Quid+    deriving anyclass Function+    deriving newtype Num++newtype BarId = BarId (Hexadecimal Quid)+    deriving stock (Eq, Generic, Ord, Read, Show)+    deriving Arbitrary via Size 256 Quid+    deriving CoArbitrary via Quid+    deriving anyclass Function+    deriving newtype Num++newtype BazId = BazId (Latin Quid)+    deriving stock (Eq, Generic, Ord, Read, Show)+    deriving Arbitrary via Size 256 Quid+    deriving CoArbitrary via Quid+    deriving anyclass Function

@@ -0,0 +1,19 @@+module Internal.Test.QuickCheck where++import Data.List.NonEmpty+    ( NonEmpty )+import Data.Maybe+    ( mapMaybe )+import Test.QuickCheck+    ( shrinkList )++import qualified Data.Foldable as F+import qualified Data.List.NonEmpty as NE++--------------------------------------------------------------------------------+-- Shrinking+--------------------------------------------------------------------------------++shrinkListNonEmpty :: (a -> [a]) -> NonEmpty a -> [NonEmpty a]+shrinkListNonEmpty shrinkFn =+    mapMaybe NE.nonEmpty . shrinkList shrinkFn . F.toList

@@ -0,0 +1,102 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}++module Internal.Test.QuickCheck.Quid+    where++import Control.DeepSeq+    ( NFData )+import Data.Data+    ( Data )+import Data.Hashable+    ( Hashable (..) )+import GHC.Generics+    ( Generic )+import Numeric.Natural+    ( Natural )+import Test.QuickCheck+    ( Arbitrary (..)+    , CoArbitrary (..)+    , Function (..)+    , Gen+    , chooseInteger+    , coarbitraryShow+    , functionMap+    , shrinkMapBy+    , sized+    )+import Test.QuickCheck.Function+    ( (:->) )++import qualified Data.List as L++--------------------------------------------------------------------------------+-- Quids+--------------------------------------------------------------------------------++newtype Quid = Quid+    { unQuid :: Natural }+    deriving (Data, Eq, Generic, Ord)+    deriving newtype (Hashable, NFData, Num)++instance Arbitrary Quid where+    arbitrary = arbitraryQuid+    shrink = shrinkQuid++instance CoArbitrary Quid where+    coarbitrary = coarbitraryQuid++instance Function Quid where+    function = functionQuid++--------------------------------------------------------------------------------+-- Generation and shrinking of arbitrary quids+--------------------------------------------------------------------------------++arbitraryQuid :: Gen Quid+arbitraryQuid = sized $ \i -> chooseQuid (Quid 0, Quid $ (2 ^ max 0 i) - 1)++chooseQuid :: (Quid, Quid) -> Gen Quid+chooseQuid (Quid n1, Quid n2) = Quid <$> chooseNatural (n1, n2)++coarbitraryQuid :: Quid -> Gen a -> Gen a+coarbitraryQuid = coarbitraryShow . unQuid++functionQuid :: (Quid -> a) -> Quid :-> a+functionQuid = functionMap (show . unQuid) (Quid . read)++shrinkQuid :: Quid -> [Quid]+shrinkQuid = shrinkMapBy Quid unQuid shrinkNatural++--------------------------------------------------------------------------------+-- Conversion between quids and natural numbers+--------------------------------------------------------------------------------++naturalToQuid :: Natural -> Quid+naturalToQuid = Quid++quidToNatural :: Quid -> Natural+quidToNatural = unQuid++--------------------------------------------------------------------------------+-- Natural number support+--------------------------------------------------------------------------------++chooseNatural :: (Natural, Natural) -> Gen Natural+chooseNatural (p, q) = fromIntegral @Integer @Natural <$>+    chooseInteger (fromIntegral p, fromIntegral q)++shrinkNatural :: Natural -> [Natural]+shrinkNatural n+    | n == 0 = []+    | otherwise = L.nub $ 0 : as <> bs+  where+    as = takeWhile (<= n `div` 2) (iterate (* 2) 1)+    bs = (n -) <$> reverse as

@@ -0,0 +1,40 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Internal.Test.QuickCheck.Quid.Combinators.Chunk+    where++import Control.DeepSeq+    ( NFData )+import Data.Data+    ( Data )+import Data.Hashable+    ( Hashable (..) )+import Data.List.Extra+    ( chunksOf )+import Data.Proxy+    ( Proxy (..) )+import GHC.Generics+    ( Generic )+import GHC.TypeLits+    ( KnownNat, KnownSymbol, Nat, Symbol, natVal, symbolVal )++import qualified Data.List as L++--------------------------------------------------------------------------------+-- Chunk combinator+--------------------------------------------------------------------------------++newtype Chunk (n :: Nat) (s :: Symbol) a = Chunk { unChunk :: a }+    deriving (Data, Eq, Generic, Hashable, NFData, Ord)++instance (KnownNat n, KnownSymbol s, Show a) => Show (Chunk n s a) where+    show (Chunk a)+        = L.intercalate (symbolVal (Proxy @s))+        $ chunksOf (fromIntegral $ natVal $ Proxy @n)+        $ show a

@@ -0,0 +1,47 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Internal.Test.QuickCheck.Quid.Combinators.Prefix+    where++import Control.Applicative+    ( many )+import Control.DeepSeq+    ( NFData )+import Control.Monad+    ( void )+import Data.Data+    ( Data )+import Data.Hashable+    ( Hashable (..) )+import Data.Proxy+    ( Proxy (..) )+import GHC.Generics+    ( Generic )+import GHC.TypeLits+    ( KnownSymbol, Symbol, symbolVal )+import Internal.Text.Read+    ( skipChar, skipString )+import Text.Read+    ( Read (..) )++--------------------------------------------------------------------------------+-- Prefixes+--------------------------------------------------------------------------------++newtype Prefix (prefix :: Symbol) a = Prefix { unPrefix :: a }+    deriving (Data, Eq, Generic, Hashable, NFData, Ord)++instance (KnownSymbol prefix, Read a) => Read (Prefix prefix a) where+    readPrec = do+        void $ many $ skipChar ' '+        skipString $ symbolVal $ Proxy @prefix+        Prefix <$> readPrec @a++instance (KnownSymbol prefix, Show a) => Show (Prefix prefix a) where+    show (Prefix a) = symbolVal (Proxy @prefix) <> show a

@@ -0,0 +1,38 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Internal.Test.QuickCheck.Quid.Combinators.Size+    where++import Control.DeepSeq+    ( NFData )+import Data.Data+    ( Data )+import Data.Hashable+    ( Hashable (..) )+import Data.Proxy+    ( Proxy (..) )+import GHC.Generics+    ( Generic )+import GHC.TypeLits+    ( KnownNat, Nat, natVal )+import Test.QuickCheck+    ( Arbitrary (..), resize, shrinkMapBy )++--------------------------------------------------------------------------------+-- Sizes+--------------------------------------------------------------------------------++newtype Size (n :: Nat) a = Size { unSize :: a }+    deriving (Data, Eq, Generic, Hashable, NFData, Ord)+    deriving (Read, Show) via a++instance (Arbitrary a, KnownNat n) => Arbitrary (Size n a) where+    arbitrary = Size <$> resize (fromIntegral $ natVal $ Proxy @n) arbitrary+    shrink = shrinkMapBy Size unSize shrink

@@ -0,0 +1,40 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Internal.Test.QuickCheck.Quid.Representations+    where++import Data.List.NonEmpty+    ( NonEmpty )+import Data.Proxy+    ( Proxy (..) )+import Internal.Test.QuickCheck.Quid+    ( Quid (..) )+import Numeric.Natural+    ( Natural )++import qualified Data.Foldable as F+import qualified Data.List.NonEmpty as NE++nonEmptyListToQuid :: forall a. (Bounded a, Enum a) => NonEmpty a -> Quid+nonEmptyListToQuid xs = Quid $+    F.foldl' f 0 xs - 1+  where+    f !acc !x = acc * base + 1 + fromIntegral (fromEnum x)+    base = fromIntegral @Int @Natural $ boundedEnumCardinality $ Proxy @a++nonEmptyListFromQuid :: forall a. (Bounded a, Enum a) => Quid -> NonEmpty a+nonEmptyListFromQuid (Quid q) =+    NE.fromList $ go [] q+  where+    go :: [a] -> Natural -> [a]+    go !acc !n+        | n < base =+            toEnum (fromIntegral n) : acc+        | otherwise =+            go (toEnum (fromIntegral (n `mod` base)) : acc) (n `div` base - 1)+    base = fromIntegral @Int @Natural $ boundedEnumCardinality $ Proxy @a++boundedEnumCardinality :: forall a. (Bounded a, Enum a) => Proxy a -> Int+boundedEnumCardinality _ = fromEnum (maxBound @a) - fromEnum (minBound @a) + 1

@@ -0,0 +1,55 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}++module Internal.Test.QuickCheck.Quid.Representations.Decimal+    ( Decimal (..)+    )+    where++import Control.DeepSeq+    ( NFData )+import Data.Bifunctor+    ( first )+import Data.Data+    ( Data )+import Data.Hashable+    ( Hashable (..) )+import GHC.Generics+    ( Generic )+import Internal.Test.QuickCheck.Quid+    ( Quid (..) )+import Numeric+    ( showInt )+import Numeric.Natural+    ( Natural )+import Test.QuickCheck+    ( Function )+import Text.ParserCombinators.ReadP+    ( readP_to_S, skipSpaces )+import Text.Read.Lex+    ( readDecP )++--------------------------------------------------------------------------------+-- Decimal representation+--------------------------------------------------------------------------------++newtype Decimal a = Decimal { unDecimal :: a }+    deriving stock (Data, Eq, Generic, Ord)+    deriving newtype (Hashable, NFData, Num)+    deriving anyclass Function++deriving via AsDecimal Natural instance Read (Decimal Quid)+deriving via AsDecimal Natural instance Show (Decimal Quid)++newtype AsDecimal a = AsDecimal a++instance (Eq a, Num a) => Read (AsDecimal a) where+    readsPrec _ = fmap (first AsDecimal) <$> readP_to_S (skipSpaces >> readDecP)++instance (Integral a, Show a) => Show (AsDecimal a) where+    show (AsDecimal n) = showInt n ""

@@ -0,0 +1,54 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}++module Internal.Test.QuickCheck.Quid.Representations.Hexadecimal+    ( Hexadecimal (..)+    )+    where++import Control.DeepSeq+    ( NFData )+import Data.Bifunctor+    ( first )+import Data.Data+    ( Data )+import Data.Hashable+    ( Hashable (..) )+import GHC.Generics+    ( Generic )+import Internal.Test.QuickCheck.Quid+    ( Quid (..) )+import Internal.Test.QuickCheck.Quid.Combinators.Prefix+    ( Prefix (..) )+import Numeric+    ( readHex, showHex )+import Numeric.Natural+    ( Natural )+import Test.QuickCheck+    ( Function )++--------------------------------------------------------------------------------+-- Hexadecimal representation+--------------------------------------------------------------------------------++newtype Hexadecimal a = Hexadecimal { unHexadecimal :: a }+    deriving stock (Data, Eq, Generic, Ord)+    deriving newtype (Hashable, NFData, Num)+    deriving anyclass Function++deriving via Prefix "0x" (AsHex Natural) instance Read (Hexadecimal Quid)+deriving via Prefix "0x" (AsHex Natural) instance Show (Hexadecimal Quid)++newtype AsHex a = AsHex a++instance (Eq a, Num a) => Read (AsHex a) where+    readsPrec _ = fmap (first AsHex) <$> readHex++instance (Integral a, Show a) => Show (AsHex a) where+    show (AsHex n) = showHex n ""

@@ -0,0 +1,164 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Internal.Test.QuickCheck.Quid.Representations.Latin+    where++import Control.DeepSeq+    ( NFData )+import Control.Monad+    ( replicateM )+import Data.Char+    ( ord )+import Data.Data+    ( Data )+import Data.Hashable+    ( Hashable (..) )+import Data.List.NonEmpty+    ( NonEmpty (..) )+import Data.Maybe+    ( fromMaybe )+import Data.String+    ( IsString (..) )+import GHC.Generics+    ( Generic )+import Internal.Test.QuickCheck+    ( shrinkListNonEmpty )+import Internal.Test.QuickCheck.Quid+    ( Quid (..) )+import Internal.Test.QuickCheck.Quid.Representations+    ( nonEmptyListFromQuid, nonEmptyListToQuid )+import Test.QuickCheck+    ( Arbitrary (..)+    , Function+    , Gen+    , arbitraryBoundedEnum+    , shrinkMap+    , shrinkMapBy+    , sized+    )+import Text.Read+    ( Read (..), readMaybe )++import qualified Data.Foldable as F+import qualified Data.List.NonEmpty as NE++--------------------------------------------------------------------------------+-- Latin representation+--------------------------------------------------------------------------------++newtype Latin a = Latin { unLatin :: a }+    deriving stock (Data, Eq, Generic, Ord)+    deriving newtype (Hashable, NFData)+    deriving anyclass Function++instance Read (Latin Quid) where+    readPrec = fromString <$> readPrec++instance Show (Latin Quid) where+    show = show . latinStringFromQuid . unLatin++instance IsString (Latin Quid) where+    fromString = Latin . latinStringToQuid . fromString++--------------------------------------------------------------------------------+-- Latin characters+--------------------------------------------------------------------------------++data LatinChar+    = A | B | C | D | E | F | G | H | I | J | K | L | M+    | N | O | P | Q | R | S | T | U | V | W | X | Y | Z+    deriving (Bounded, Enum, Eq, Ord, Read, Show)++instance Arbitrary LatinChar where+    arbitrary = arbitraryLatinChar+    shrink = shrinkLatinChar++--------------------------------------------------------------------------------+-- Generation and shrinking of arbitrary Latin characters+--------------------------------------------------------------------------------++arbitraryLatinChar :: Gen LatinChar+arbitraryLatinChar = arbitraryBoundedEnum++shrinkLatinChar :: LatinChar -> [LatinChar]+shrinkLatinChar = shrinkMap toEnum fromEnum++--------------------------------------------------------------------------------+-- Conversion between Latin characters and ordinary characters+--------------------------------------------------------------------------------++charToLatinChar :: Char -> Maybe LatinChar+charToLatinChar c = readMaybe [c]++latinCharToChar :: LatinChar -> Char+latinCharToChar = toEnum . (+ ord 'A') . fromEnum++--------------------------------------------------------------------------------+-- Latin strings+--------------------------------------------------------------------------------++newtype LatinString = LatinString+    { unLatinString :: NonEmpty LatinChar }+    deriving stock (Eq, Ord)+    deriving newtype Semigroup++instance Arbitrary LatinString where+    arbitrary = arbitraryLatinString+    shrink = shrinkLatinString++--------------------------------------------------------------------------------+-- Conversion between Latin strings and ordinary strings+--------------------------------------------------------------------------------++instance Read LatinString where+    readPrec = fromString <$> readPrec++instance Show LatinString where+    show = show . latinStringToString++instance IsString LatinString where+    fromString = unsafeStringtoLatinString++latinStringToString :: LatinString -> String+latinStringToString (LatinString cs) = F.foldMap show cs++stringToLatinString :: String -> Maybe LatinString+stringToLatinString s =+    LatinString <$> (NE.nonEmpty =<< traverse charToLatinChar s)++unsafeStringtoLatinString :: String -> LatinString+unsafeStringtoLatinString = fromMaybe raiseError . stringToLatinString+  where+    raiseError = error $ unwords+        [ "A Latin quid string must be composed of one or more uppercase"+        , "characters in the range [A-Z]."+        ]++--------------------------------------------------------------------------------+-- Generation and shrinking of arbitrary Latin strings+--------------------------------------------------------------------------------++arbitraryLatinString :: Gen LatinString+arbitraryLatinString = sized $ \size ->+    fmap LatinString . (:|)+        <$> arbitraryLatinChar+        <*> replicateM size arbitraryLatinChar++shrinkLatinString :: LatinString -> [LatinString]+shrinkLatinString =+    shrinkMapBy LatinString unLatinString $ shrinkListNonEmpty shrinkLatinChar++--------------------------------------------------------------------------------+-- Conversion between Latin strings and quids+--------------------------------------------------------------------------------++latinStringToQuid :: LatinString -> Quid+latinStringToQuid = nonEmptyListToQuid . unLatinString++latinStringFromQuid :: Quid -> LatinString+latinStringFromQuid = LatinString . nonEmptyListFromQuid

@@ -0,0 +1,28 @@+{-# LANGUAGE LambdaCase #-}++module Internal.Text.Read where++import Control.Monad+    ( replicateM_ )+import Text.Read+    ( ReadPrec, get, look, pfail )++import qualified Data.List as L++readCharMaybe :: (Char -> Maybe a) -> ReadPrec a+readCharMaybe f = look >>= \case+    a : _ | Just c <- f a ->+        get >> pure c+    _ ->+        pfail++skipChar :: Char -> ReadPrec ()+skipChar charToSkip = readCharMaybe+    (\char -> if char == charToSkip then Just () else Nothing)++skipString :: String -> ReadPrec ()+skipString stringToSkip = do+    remainder <- look+    if stringToSkip `L.isPrefixOf` remainder+    then replicateM_ (length stringToSkip) get+    else pfail

@@ -0,0 +1,29 @@+module Test.QuickCheck.Quid+    (+    -- * The Quid type+      Quid++    -- * Combinators+    , Size (..)++    -- * Representations++    -- ** Numerical representations+    , Decimal (..)+    , Hexadecimal (..)++    -- ** String representations+    , Latin (..)+    )+    where++import Internal.Test.QuickCheck.Quid+    ( Quid (..) )+import Internal.Test.QuickCheck.Quid.Combinators.Size+    ( Size (..) )+import Internal.Test.QuickCheck.Quid.Representations.Decimal+    ( Decimal (..) )+import Internal.Test.QuickCheck.Quid.Representations.Hexadecimal+    ( Hexadecimal (..) )+import Internal.Test.QuickCheck.Quid.Representations.Latin+    ( Latin (..) )

@@ -1,34 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module Test.QuickCheck.Quid.Example where--import GHC.Generics-    ( Generic )-import Test.QuickCheck-    ( Arbitrary, CoArbitrary, Function )-import Test.QuickCheck.Quid-    ( Decimal (..), Hexadecimal (..), Latin (..), Quid, Size (..) )--newtype ExampleDecimalQuid = ExampleDecimalQuid (Decimal Quid)-    deriving stock (Eq, Generic, Ord, Read, Show)-    deriving Arbitrary via (Size 256 Quid)-    deriving CoArbitrary via Quid-    deriving anyclass Function-    deriving newtype Num--newtype ExampleHexadecimalQuid = ExampleHexadecimalQuid (Hexadecimal Quid)-    deriving stock (Eq, Generic, Ord, Read, Show)-    deriving Arbitrary via (Size 256 Quid)-    deriving CoArbitrary via Quid-    deriving anyclass Function-    deriving newtype Num--newtype ExampleLatinQuid = ExampleLatinQuid (Latin Quid)-    deriving stock (Eq, Generic, Ord, Read, Show)-    deriving Arbitrary via (Size 256 Quid)-    deriving CoArbitrary via Quid-    deriving anyclass Function

@@ -1,19 +0,0 @@-module Internal.Test.QuickCheck where--import Data.List.NonEmpty-    ( NonEmpty )-import Data.Maybe-    ( mapMaybe )-import Test.QuickCheck-    ( shrinkList )--import qualified Data.Foldable as F-import qualified Data.List.NonEmpty as NE------------------------------------------------------------------------------------- Shrinking-----------------------------------------------------------------------------------shrinkListNonEmpty :: (a -> [a]) -> NonEmpty a -> [NonEmpty a]-shrinkListNonEmpty shrinkFn =-    mapMaybe NE.nonEmpty . shrinkList shrinkFn . F.toList

@@ -1,102 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeOperators #-}--module Internal.Test.QuickCheck.Quid-    where--import Control.DeepSeq-    ( NFData )-import Data.Data-    ( Data )-import Data.Hashable-    ( Hashable (..) )-import GHC.Generics-    ( Generic )-import Numeric.Natural-    ( Natural )-import Test.QuickCheck-    ( Arbitrary (..)-    , CoArbitrary (..)-    , Function (..)-    , Gen-    , chooseInteger-    , coarbitraryShow-    , functionMap-    , shrinkMapBy-    , sized-    )-import Test.QuickCheck.Function-    ( (:->) )--import qualified Data.List as L------------------------------------------------------------------------------------- Quids-----------------------------------------------------------------------------------newtype Quid = Quid-    { unQuid :: Natural }-    deriving (Data, Eq, Generic, Ord)-    deriving newtype (Hashable, NFData, Num)--instance Arbitrary Quid where-    arbitrary = arbitraryQuid-    shrink = shrinkQuid--instance CoArbitrary Quid where-    coarbitrary = coarbitraryQuid--instance Function Quid where-    function = functionQuid------------------------------------------------------------------------------------- Generation and shrinking of arbitrary quids-----------------------------------------------------------------------------------arbitraryQuid :: Gen Quid-arbitraryQuid = sized $ \i -> chooseQuid (Quid 0, Quid $ (2 ^ max 0 i) - 1)--chooseQuid :: (Quid, Quid) -> Gen Quid-chooseQuid (Quid n1, Quid n2) = Quid <$> chooseNatural (n1, n2)--coarbitraryQuid :: Quid -> Gen a -> Gen a-coarbitraryQuid = coarbitraryShow . unQuid--functionQuid :: (Quid -> a) -> Quid :-> a-functionQuid = functionMap (show . unQuid) (Quid . read)--shrinkQuid :: Quid -> [Quid]-shrinkQuid = shrinkMapBy Quid unQuid shrinkNatural------------------------------------------------------------------------------------- Conversion between quids and natural numbers-----------------------------------------------------------------------------------naturalToQuid :: Natural -> Quid-naturalToQuid = Quid--quidToNatural :: Quid -> Natural-quidToNatural = unQuid------------------------------------------------------------------------------------- Natural number support-----------------------------------------------------------------------------------chooseNatural :: (Natural, Natural) -> Gen Natural-chooseNatural (p, q) = fromIntegral @Integer @Natural <$>-    chooseInteger (fromIntegral p, fromIntegral q)--shrinkNatural :: Natural -> [Natural]-shrinkNatural n-    | n == 0 = []-    | otherwise = L.nub $ 0 : as <> bs-  where-    as = takeWhile (<= n `div` 2) (iterate (* 2) 1)-    bs = (n -) <$> reverse as

@@ -1,40 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}--module Internal.Test.QuickCheck.Quid.Combinators.Chunk-    where--import Control.DeepSeq-    ( NFData )-import Data.Data-    ( Data )-import Data.Hashable-    ( Hashable (..) )-import Data.List.Extra-    ( chunksOf )-import Data.Proxy-    ( Proxy (..) )-import GHC.Generics-    ( Generic )-import GHC.TypeLits-    ( KnownNat, KnownSymbol, Nat, Symbol, natVal, symbolVal )--import qualified Data.List as L------------------------------------------------------------------------------------- Chunk combinator-----------------------------------------------------------------------------------newtype Chunk (n :: Nat) (s :: Symbol) a = Chunk { unChunk :: a }-    deriving (Data, Eq, Generic, Hashable, NFData, Ord)--instance (KnownNat n, KnownSymbol s, Show a) => Show (Chunk n s a) where-    show (Chunk a)-        = L.intercalate (symbolVal (Proxy @s))-        $ chunksOf (fromIntegral $ natVal $ Proxy @n)-        $ show a

@@ -1,47 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}--module Internal.Test.QuickCheck.Quid.Combinators.Prefix-    where--import Control.Applicative-    ( many )-import Control.DeepSeq-    ( NFData )-import Control.Monad-    ( void )-import Data.Data-    ( Data )-import Data.Hashable-    ( Hashable (..) )-import Data.Proxy-    ( Proxy (..) )-import GHC.Generics-    ( Generic )-import GHC.TypeLits-    ( KnownSymbol, Symbol, symbolVal )-import Internal.Text.Read-    ( skipChar, skipString )-import Text.Read-    ( Read (..) )------------------------------------------------------------------------------------- Prefixes-----------------------------------------------------------------------------------newtype Prefix (prefix :: Symbol) a = Prefix { unPrefix :: a }-    deriving (Data, Eq, Generic, Hashable, NFData, Ord)--instance (KnownSymbol prefix, Read a) => Read (Prefix prefix a) where-    readPrec = do-        void $ many $ skipChar ' '-        skipString $ symbolVal $ Proxy @prefix-        Prefix <$> readPrec @a--instance (KnownSymbol prefix, Show a) => Show (Prefix prefix a) where-    show (Prefix a) = symbolVal (Proxy @prefix) <> show a

@@ -1,38 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}--module Internal.Test.QuickCheck.Quid.Combinators.Size-    where--import Control.DeepSeq-    ( NFData )-import Data.Data-    ( Data )-import Data.Hashable-    ( Hashable (..) )-import Data.Proxy-    ( Proxy (..) )-import GHC.Generics-    ( Generic )-import GHC.TypeLits-    ( KnownNat, Nat, natVal )-import Test.QuickCheck-    ( Arbitrary (..), resize, shrinkMapBy )------------------------------------------------------------------------------------- Sizes-----------------------------------------------------------------------------------newtype Size (n :: Nat) a = Size { unSize :: a }-    deriving (Data, Eq, Generic, Hashable, NFData, Ord)-    deriving (Read, Show) via a--instance (Arbitrary a, KnownNat n) => Arbitrary (Size n a) where-    arbitrary = Size <$> resize (fromIntegral $ natVal $ Proxy @n) arbitrary-    shrink = shrinkMapBy Size unSize shrink

@@ -1,40 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}--module Internal.Test.QuickCheck.Quid.Representations-    where--import Data.List.NonEmpty-    ( NonEmpty )-import Data.Proxy-    ( Proxy (..) )-import Internal.Test.QuickCheck.Quid-    ( Quid (..) )-import Numeric.Natural-    ( Natural )--import qualified Data.Foldable as F-import qualified Data.List.NonEmpty as NE--nonEmptyListToQuid :: forall a. (Bounded a, Enum a) => NonEmpty a -> Quid-nonEmptyListToQuid xs = Quid $-    F.foldl' f 0 xs - 1-  where-    f !acc !x = acc * base + 1 + fromIntegral (fromEnum x)-    base = fromIntegral @Int @Natural $ boundedEnumCardinality $ Proxy @a--nonEmptyListFromQuid :: forall a. (Bounded a, Enum a) => Quid -> NonEmpty a-nonEmptyListFromQuid (Quid q) =-    NE.fromList $ go [] q-  where-    go :: [a] -> Natural -> [a]-    go !acc !n-        | n < base =-            toEnum (fromIntegral n) : acc-        | otherwise =-            go (toEnum (fromIntegral (n `mod` base)) : acc) (n `div` base - 1)-    base = fromIntegral @Int @Natural $ boundedEnumCardinality $ Proxy @a--boundedEnumCardinality :: forall a. (Bounded a, Enum a) => Proxy a -> Int-boundedEnumCardinality _ = fromEnum (maxBound @a) - fromEnum (minBound @a) + 1

@@ -1,55 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-}--module Internal.Test.QuickCheck.Quid.Representations.Decimal-    ( Decimal (..)-    )-    where--import Control.DeepSeq-    ( NFData )-import Data.Bifunctor-    ( first )-import Data.Data-    ( Data )-import Data.Hashable-    ( Hashable (..) )-import GHC.Generics-    ( Generic )-import Internal.Test.QuickCheck.Quid-    ( Quid (..) )-import Numeric-    ( showInt )-import Numeric.Natural-    ( Natural )-import Test.QuickCheck-    ( Function )-import Text.ParserCombinators.ReadP-    ( readP_to_S, skipSpaces )-import Text.Read.Lex-    ( readDecP )------------------------------------------------------------------------------------- Decimal representation-----------------------------------------------------------------------------------newtype Decimal a = Decimal { unDecimal :: a }-    deriving stock (Data, Eq, Generic, Ord)-    deriving newtype (Hashable, NFData, Num)-    deriving anyclass Function--deriving via AsDecimal Natural instance Read (Decimal Quid)-deriving via AsDecimal Natural instance Show (Decimal Quid)--newtype AsDecimal a = AsDecimal a--instance (Eq a, Num a) => Read (AsDecimal a) where-    readsPrec _ = fmap (first AsDecimal) <$> readP_to_S (skipSpaces >> readDecP)--instance (Integral a, Show a) => Show (AsDecimal a) where-    show (AsDecimal n) = showInt n ""

@@ -1,54 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-}--module Internal.Test.QuickCheck.Quid.Representations.Hexadecimal-    ( Hexadecimal (..)-    )-    where--import Control.DeepSeq-    ( NFData )-import Data.Bifunctor-    ( first )-import Data.Data-    ( Data )-import Data.Hashable-    ( Hashable (..) )-import GHC.Generics-    ( Generic )-import Internal.Test.QuickCheck.Quid-    ( Quid (..) )-import Internal.Test.QuickCheck.Quid.Combinators.Prefix-    ( Prefix (..) )-import Numeric-    ( readHex, showHex )-import Numeric.Natural-    ( Natural )-import Test.QuickCheck-    ( Function )------------------------------------------------------------------------------------- Hexadecimal representation-----------------------------------------------------------------------------------newtype Hexadecimal a = Hexadecimal { unHexadecimal :: a }-    deriving stock (Data, Eq, Generic, Ord)-    deriving newtype (Hashable, NFData, Num)-    deriving anyclass Function--deriving via Prefix "0x" (AsHex Natural) instance Read (Hexadecimal Quid)-deriving via Prefix "0x" (AsHex Natural) instance Show (Hexadecimal Quid)--newtype AsHex a = AsHex a--instance (Eq a, Num a) => Read (AsHex a) where-    readsPrec _ = fmap (first AsHex) <$> readHex--instance (Integral a, Show a) => Show (AsHex a) where-    show (AsHex n) = showHex n ""

@@ -1,162 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module Internal.Test.QuickCheck.Quid.Representations.Latin-    where--import Control.DeepSeq-    ( NFData )-import Control.Monad-    ( replicateM )-import Data.Data-    ( Data )-import Data.Hashable-    ( Hashable (..) )-import Data.List.NonEmpty-    ( NonEmpty (..) )-import Data.Maybe-    ( fromMaybe )-import Data.String-    ( IsString (..) )-import GHC.Generics-    ( Generic )-import Internal.Test.QuickCheck-    ( shrinkListNonEmpty )-import Internal.Test.QuickCheck.Quid-    ( Quid (..) )-import Internal.Test.QuickCheck.Quid.Representations-    ( nonEmptyListFromQuid, nonEmptyListToQuid )-import Test.QuickCheck-    ( Arbitrary (..)-    , Function-    , Gen-    , arbitraryBoundedEnum-    , shrinkMap-    , shrinkMapBy-    , sized-    )-import Text.Read-    ( Read (..), readMaybe )--import qualified Data.Foldable as F-import qualified Data.List.NonEmpty as NE------------------------------------------------------------------------------------- Latin representation-----------------------------------------------------------------------------------newtype Latin a = Latin { unLatin :: a }-    deriving stock (Data, Eq, Generic, Ord)-    deriving newtype (Hashable, NFData)-    deriving anyclass Function--instance Read (Latin Quid) where-    readPrec = fromString <$> readPrec--instance Show (Latin Quid) where-    show = show . latinStringFromQuid . unLatin--instance IsString (Latin Quid) where-    fromString = Latin . latinStringToQuid . fromString------------------------------------------------------------------------------------- Latin characters-----------------------------------------------------------------------------------data LatinChar-    = A | B | C | D | E | F | G | H | I | J | K | L | M-    | N | O | P | Q | R | S | T | U | V | W | X | Y | Z-    deriving (Bounded, Enum, Eq, Ord, Read, Show)--instance Arbitrary LatinChar where-    arbitrary = arbitraryLatinChar-    shrink = shrinkLatinChar------------------------------------------------------------------------------------- Generation and shrinking of arbitrary Latin characters-----------------------------------------------------------------------------------arbitraryLatinChar :: Gen LatinChar-arbitraryLatinChar = arbitraryBoundedEnum--shrinkLatinChar :: LatinChar -> [LatinChar]-shrinkLatinChar = shrinkMap toEnum fromEnum------------------------------------------------------------------------------------- Conversion between Latin characters and ordinary characters-----------------------------------------------------------------------------------charToLatinChar :: Char -> Maybe LatinChar-charToLatinChar c = readMaybe [c]--latinCharToChar :: LatinChar -> Char-latinCharToChar = head . show------------------------------------------------------------------------------------- Latin strings-----------------------------------------------------------------------------------newtype LatinString = LatinString-    { unLatinString :: NonEmpty LatinChar }-    deriving stock (Eq, Ord)-    deriving newtype Semigroup--instance Arbitrary LatinString where-    arbitrary = arbitraryLatinString-    shrink = shrinkLatinString------------------------------------------------------------------------------------- Conversion between Latin strings and ordinary strings-----------------------------------------------------------------------------------instance Read LatinString where-    readPrec = fromString <$> readPrec--instance Show LatinString where-    show = show . latinStringToString--instance IsString LatinString where-    fromString = unsafeStringtoLatinString--latinStringToString :: LatinString -> String-latinStringToString (LatinString cs) = F.foldMap show cs--stringToLatinString :: String -> Maybe LatinString-stringToLatinString s =-    LatinString <$> (NE.nonEmpty =<< traverse charToLatinChar s)--unsafeStringtoLatinString :: String -> LatinString-unsafeStringtoLatinString = fromMaybe raiseError . stringToLatinString-  where-    raiseError = error $ unwords-        [ "A Latin quid string must be composed of one or more uppercase"-        , "characters in the range [A-Z]."-        ]------------------------------------------------------------------------------------- Generation and shrinking of arbitrary Latin strings-----------------------------------------------------------------------------------arbitraryLatinString :: Gen LatinString-arbitraryLatinString = sized $ \size ->-    fmap LatinString . (:|)-        <$> arbitraryLatinChar-        <*> replicateM size arbitraryLatinChar--shrinkLatinString :: LatinString -> [LatinString]-shrinkLatinString =-    shrinkMapBy LatinString unLatinString $ shrinkListNonEmpty shrinkLatinChar------------------------------------------------------------------------------------- Conversion between Latin strings and quids-----------------------------------------------------------------------------------latinStringToQuid :: LatinString -> Quid-latinStringToQuid = nonEmptyListToQuid . unLatinString--latinStringFromQuid :: Quid -> LatinString-latinStringFromQuid = LatinString . nonEmptyListFromQuid

@@ -1,28 +0,0 @@-{-# LANGUAGE LambdaCase #-}--module Internal.Text.Read where--import Control.Monad-    ( replicateM_ )-import Text.Read-    ( ReadPrec, get, look, pfail )--import qualified Data.List as L--readCharMaybe :: (Char -> Maybe a) -> ReadPrec a-readCharMaybe f = look >>= \case-    a : _ | Just c <- f a ->-        get >> pure c-    _ ->-        pfail--skipChar :: Char -> ReadPrec ()-skipChar charToSkip = readCharMaybe-    (\char -> if char == charToSkip then Just () else Nothing)--skipString :: String -> ReadPrec ()-skipString stringToSkip = do-    remainder <- look-    if stringToSkip `L.isPrefixOf` remainder-    then replicateM_ (length stringToSkip) get-    else pfail

@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -1,56 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Test.Hspec.Unit where--import Control.Monad-    ( forM_ )-import Test.Hspec-    ( Spec, describe, it )-import Test.QuickCheck-    ( property, (===) )-import Text.Pretty.Simple-    ( pShow )--import qualified Data.Text.Lazy as TL------------------------------------------------------------------------------------- Unit test support-----------------------------------------------------------------------------------data UnitTestData params result = UnitTestData-    { params :: params-    , result :: result-    }-    deriving (Eq, Show)--unitTests-    :: (Eq result, Show result)-    => String-    -> (params -> result)-    -> [UnitTestData params result]-    -> Spec-unitTests title f unitTestData =-    describe title $-    forM_ (zip testNumbers unitTestData) $-        \(testNumber :: Int, test) -> do-            let subtitle = "Unit test #" <> show testNumber-            it subtitle $-                let resultExpected = result test in-                let resultActual = f (params test) in-                property $ Pretty resultExpected === Pretty resultActual-  where-    testNumbers :: [Int]-    testNumbers = [1 ..]------------------------------------------------------------------------------------- Pretty-printing------------------------------------------------------------------------------------- | A combinator that causes the output of `show` to be pretty-printed.----newtype Pretty a = Pretty { unPretty :: a }-    deriving Eq--instance Show a => Show (Pretty a) where-    show (Pretty a) = TL.unpack ("\n" <> pShow a <> "\n")

@@ -1,61 +0,0 @@-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}---- Provides testing functions to check that type class instances obey laws.----module Test.QuickCheck.Classes.Hspec-    ( testLaws-    , testLawsMany-    ) where--import Prelude--import Control.Monad-    ( forM_ )-import Data.Proxy-    ( Proxy (..) )-import Data.Typeable-    ( Typeable, typeRep )-import Test.Hspec-    ( Spec, describe, it, parallel )-import Test.QuickCheck.Classes-    ( Laws (..) )---- | Constructs a test to check that the given type class instance obeys the---   given set of laws.------ Example usage:------ >>> testLaws @Natural ordLaws--- >>> testLaws @(Map Int) functorLaws----testLaws-    :: forall a. Typeable a-    => (Proxy a -> Laws)-    -> Spec-testLaws getLaws =-    parallel $ describe description $-        forM_ (lawsProperties laws) $ uncurry it-  where-    description = mconcat-        [ "Testing "-        , lawsTypeclass laws-        , " laws for type "-        , show (typeRep $ Proxy @a)-        ]-    laws = getLaws $ Proxy @a---- | Calls `testLaws` with multiple sets of laws.------ Example usage:------ >>> testLawsMany @Natural [eqLaws, ordLaws]--- >>> testLawsMany @(Map Int) [foldableLaws, functorLaws]----testLawsMany-    :: forall a. Typeable a-    => [Proxy a -> Laws]-    -> Spec-testLawsMany getLawsMany =-    testLaws @a `mapM_` getLawsMany

@@ -1,49 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Test.QuickCheck.Quid.Combinators.PrefixSpec-    where--import Internal.Test.QuickCheck.Quid.Combinators.Prefix-    ( Prefix (..) )-import Test.Hspec-    ( Spec, describe, parallel )-import Test.QuickCheck-    ( Arbitrary (..), shrinkMapBy )-import Test.QuickCheck.Classes.Hspec-    ( testLawsMany )--import qualified Test.QuickCheck.Classes as Laws--spec :: Spec-spec = do--    parallel $ describe "Lawfulness of type class instances" $ do-        testLawsMany @(Prefix "A" Int)-            [ Laws.showLaws-            , Laws.showReadLaws-            ]-        testLawsMany @(Prefix ":" Int)-            [ Laws.showLaws-            , Laws.showReadLaws-            ]-        testLawsMany @(Prefix "1" Int)-            [ Laws.showLaws-            , Laws.showReadLaws-            ]-        testLawsMany @(Prefix "test-prefix:" Int)-            [ Laws.showLaws-            , Laws.showReadLaws-            ]------------------------------------------------------------------------------------- Arbitrary instances-----------------------------------------------------------------------------------instance Arbitrary a => Arbitrary (Prefix p a) where-    arbitrary = Prefix <$> arbitrary-    shrink = shrinkMapBy Prefix unPrefix shrink

@@ -1,91 +0,0 @@-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeApplications #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Test.QuickCheck.Quid.Representations.DecimalSpec-    where--import Internal.Test.QuickCheck.Quid-    ( Quid, naturalToQuid )-import Internal.Test.QuickCheck.Quid.Representations.Decimal-    ( Decimal (..) )-import Numeric.Natural-    ( Natural )-import Test.Hspec-    ( Spec, describe, parallel )-import Test.Hspec.Unit-    ( UnitTestData (..), unitTests )-import Test.QuickCheck-    ( Arbitrary (..) )-import Test.QuickCheck.Classes.Hspec-    ( testLawsMany )--import Prelude hiding-    ( (^) )--import qualified Prelude-import qualified Test.QuickCheck.Classes as Laws--spec :: Spec-spec = do--    parallel $ describe "Lawfulness of type class instances" $ do-        testLawsMany @(Decimal Quid)-            [ Laws.showLaws-            , Laws.showReadLaws-            ]--    parallel $ describe "Unit tests" $ do-        unitTests_show_decimal_naturalToQuid------------------------------------------------------------------------------------- Unit tests-----------------------------------------------------------------------------------unitTests_show_decimal_naturalToQuid :: Spec-unitTests_show_decimal_naturalToQuid = unitTests-    "unitTests_show_decimal_naturalToQuid"-    (show . Decimal . naturalToQuid)-    (mkTest <$> tests)-  where-    mkTest :: (Natural, String) -> UnitTestData Natural String-    mkTest (params, result) = UnitTestData {params, result}--    (^) :: Natural -> Natural -> Natural-    (^) = (Prelude.^)--    tests =-        [ (0, "0")-        , (1, "1")-        , (8, "8")-        , (9, "9")--        , (10^0, "1")-        , (10^1, "10")-        , (10^2, "100")-        , (10^3, "1000")-        , (10^4, "10000")-        , (10^5, "100000")-        , (10^6, "1000000")-        , (10^7, "10000000")--        , (10^0 - 1, "0")-        , (10^1 - 1, "9")-        , (10^2 - 1, "99")-        , (10^3 - 1, "999")-        , (10^4 - 1, "9999")-        , (10^5 - 1, "99999")-        , (10^6 - 1, "999999")-        , (10^7 - 1, "9999999")-        ]------------------------------------------------------------------------------------- Arbitrary instances-----------------------------------------------------------------------------------deriving via Quid instance Arbitrary (Decimal Quid)

@@ -1,106 +0,0 @@-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeApplications #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Test.QuickCheck.Quid.Representations.HexadecimalSpec-    where--import Internal.Test.QuickCheck.Quid-    ( Quid, naturalToQuid )-import Internal.Test.QuickCheck.Quid.Representations.Hexadecimal-    ( Hexadecimal (..) )-import Numeric.Natural-    ( Natural )-import Test.Hspec-    ( Spec, describe, parallel )-import Test.Hspec.Unit-    ( UnitTestData (..), unitTests )-import Test.QuickCheck-    ( Arbitrary (..) )-import Test.QuickCheck.Classes.Hspec-    ( testLawsMany )--import Prelude hiding-    ( (^) )--import qualified Prelude-import qualified Test.QuickCheck.Classes as Laws--spec :: Spec-spec = do--    parallel $ describe "Lawfulness of type class instances" $ do-        testLawsMany @(Hexadecimal Quid)-            [ Laws.showLaws-            , Laws.showReadLaws-            ]--    parallel $ describe "Unit tests" $ do-        unitTests_show_hexadecimal_naturalToQuid------------------------------------------------------------------------------------- Unit tests-----------------------------------------------------------------------------------unitTests_show_hexadecimal_naturalToQuid :: Spec-unitTests_show_hexadecimal_naturalToQuid = unitTests-    "unitTests_show_hexadecimal_naturalToQuid"-    (show . Hexadecimal . naturalToQuid)-    (mkTest <$> tests)-  where-    mkTest :: (Natural, String) -> UnitTestData Natural String-    mkTest (params, result) = UnitTestData {params, result}--    (^) :: Natural -> Natural -> Natural-    (^) = (Prelude.^)--    tests =-        [ ( 0, "0x0")-        , ( 1, "0x1")-        , (14, "0xe")-        , (15, "0xf")--        , (16 +  0, "0x10")-        , (16 +  1, "0x11")-        , (16 + 14, "0x1e")-        , (16 + 15, "0x1f")--        , (2 * 16 +  0, "0x20")-        , (2 * 16 +  1, "0x21")-        , (2 * 16 + 14, "0x2e")-        , (2 * 16 + 15, "0x2f")--        , (15 * 16 +  0, "0xf0")-        , (15 * 16 +  1, "0xf1")-        , (15 * 16 + 14, "0xfe")-        , (15 * 16 + 15, "0xff")--        , (16^0, "0x1")-        , (16^1, "0x10")-        , (16^2, "0x100")-        , (16^3, "0x1000")-        , (16^4, "0x10000")-        , (16^5, "0x100000")-        , (16^6, "0x1000000")-        , (16^7, "0x10000000")--        , (16^0 - 1, "0x0")-        , (16^1 - 1, "0xf")-        , (16^2 - 1, "0xff")-        , (16^3 - 1, "0xfff")-        , (16^4 - 1, "0xffff")-        , (16^5 - 1, "0xfffff")-        , (16^6 - 1, "0xffffff")-        , (16^7 - 1, "0xfffffff")-        ]------------------------------------------------------------------------------------- Arbitrary instances-----------------------------------------------------------------------------------deriving via Quid instance Arbitrary (Hexadecimal Quid)

@@ -1,121 +0,0 @@-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Test.QuickCheck.Quid.Representations.LatinSpec-    where--import Internal.Test.QuickCheck.Quid-    ( Quid, arbitraryQuid, naturalToQuid, shrinkQuid )-import Internal.Test.QuickCheck.Quid.Representations.Latin-    ( Latin (..), LatinString )-import Numeric.Natural-    ( Natural )-import Test.Hspec-    ( Spec, describe, it, parallel )-import Test.Hspec.Unit-    ( UnitTestData (..), unitTests )-import Test.QuickCheck-    ( Arbitrary (..), Property, property, shrinkMapBy, (===) )-import Test.QuickCheck.Classes.Hspec-    ( testLawsMany )--import Prelude hiding-    ( (^) )--import qualified Prelude-import qualified Test.QuickCheck.Classes as Laws--spec :: Spec-spec = do--    parallel $ describe "Lawfulness of type class instances" $ do-        testLawsMany @(Latin Quid)-            [ Laws.showLaws-            , Laws.showReadLaws-            ]--    parallel $ describe "Round-trip tests" $ do-        it "Roundtrip between Latin strings and quids" $-            property prop_roundTrip_LatinString_Quid--    parallel $ describe "Unit tests" $ do-        unitTests_show_latin_naturalToQuid------------------------------------------------------------------------------------- Properties-----------------------------------------------------------------------------------prop_roundTrip_LatinString_Quid :: LatinString -> Property-prop_roundTrip_LatinString_Quid latinString =-    show (read @(Latin Quid) expectedOutput) === expectedOutput-  where-    expectedOutput :: String-    expectedOutput = show latinString------------------------------------------------------------------------------------- Unit tests-----------------------------------------------------------------------------------unitTests_show_latin_naturalToQuid :: Spec-unitTests_show_latin_naturalToQuid = unitTests-    "unitTests_show_latin_naturalToQuid"-    (show . Latin . naturalToQuid)-    (mkTest <$> tests)-  where-    mkTest :: (Natural, String) -> UnitTestData Natural String-    mkTest (params, result) = UnitTestData {params, result = show result}--    (^) :: Natural -> Natural -> Natural-    (^) = (Prelude.^)--    tests =-        [ ( 0, "A")-        , ( 1, "B")-        , (24, "Y")-        , (25, "Z")--        , (26 +  0, "AA")-        , (26 +  1, "AB")-        , (26 + 24, "AY")-        , (26 + 25, "AZ")--        , (2 * 26 +  0, "BA")-        , (2 * 26 +  1, "BB")-        , (2 * 26 + 24, "BY")-        , (2 * 26 + 25, "BZ")--        , (26 * 26 +  0, "ZA")-        , (26 * 26 +  1, "ZB")-        , (26 * 26 + 24, "ZY")-        , (26 * 26 + 25, "ZZ")--        , (26                                          , "AA")-        , (26 + 26^2                                   , "AAA")-        , (26 + 26^2 + 26^3                            , "AAAA")-        , (26 + 26^2 + 26^3 + 26^4                     , "AAAAA")-        , (26 + 26^2 + 26^3 + 26^4 + 26^5              , "AAAAAA")-        , (26 + 26^2 + 26^3 + 26^4 + 26^5 + 26^6       , "AAAAAAA")-        , (26 + 26^2 + 26^3 + 26^4 + 26^5 + 26^6 + 26^7, "AAAAAAAA")--        , (26                                                  - 1, "Z")-        , (26 + 26^2                                           - 1, "ZZ")-        , (26 + 26^2 + 26^3                                    - 1, "ZZZ")-        , (26 + 26^2 + 26^3 + 26^4                             - 1, "ZZZZ")-        , (26 + 26^2 + 26^3 + 26^4 + 26^5                      - 1, "ZZZZZ")-        , (26 + 26^2 + 26^3 + 26^4 + 26^5 + 26^6               - 1, "ZZZZZZ")-        , (26 + 26^2 + 26^3 + 26^4 + 26^5 + 26^6 + 26^7        - 1, "ZZZZZZZ")-        , (26 + 26^2 + 26^3 + 26^4 + 26^5 + 26^6 + 26^7 + 26^8 - 1, "ZZZZZZZZ")-        ]------------------------------------------------------------------------------------- Arbitrary instances-----------------------------------------------------------------------------------instance Arbitrary (Latin Quid) where-    arbitrary = Latin <$> arbitraryQuid-    shrink = shrinkMapBy Latin unLatin shrinkQuid

@@ -1,525 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE NumericUnderscores #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}--module Test.QuickCheck.QuidSpec-    where--import Control.Arrow-    ( (&&&) )-import Control.Monad-    ( replicateM )-import Data.Functor-    ( (<&>) )-import Data.Maybe-    ( fromMaybe )-import Data.Numbers.Primes-    ( primes )-import Data.Ord-    ( Down (..) )-import Data.Set-    ( Set )-import Data.Text.Lazy.Builder-    ( Builder, fromLazyText )-import Fmt-    ( Buildable (..), indentF, padLeftF, pretty, (+|), (|+) )-import Internal.Test.QuickCheck.Quid-    ( Quid-    , arbitraryQuid-    , chooseNatural-    , naturalToQuid-    , quidToNatural-    , shrinkNatural-    )-import Internal.Test.QuickCheck.Quid.Combinators.Size-    ( Size (..) )-import Internal.Test.QuickCheck.Quid.Representations.Decimal-    ( Decimal (..) )-import Numeric.Natural-    ( Natural )-import Test.Hspec-    ( Spec, describe, it, parallel )-import Test.QuickCheck-    ( Arbitrary (..)-    , Fixed (..)-    , Gen-    , Property-    , Testable (..)-    , checkCoverage-    , conjoin-    , counterexample-    , cover-    , forAllBlind-    , label-    , liftShrink2-    , oneof-    , property-    , resize-    , shrinkMapBy-    , withMaxSuccess-    , (.&&.)-    , (===)-    )-import Test.QuickCheck.Classes.Hspec-    ( testLawsMany )-import Text.Pretty.Simple-    ( pShow )--import qualified Data.List as L-import qualified Data.Map.Strict as Map-import qualified Data.Set as Set-import qualified Test.QuickCheck.Classes as Laws--spec :: Spec-spec = do--    parallel $ describe "Lawfulness of type class instances" $ do-        testLawsMany @TestQuid-            [ Laws.eqLaws-            , Laws.ordLaws-            ]-        testLawsMany @TestQuid-            [ Laws.eqLaws-            , Laws.ordLaws-            , Laws.showLaws-            , Laws.showReadLaws-            ]--    parallel $ describe "Uniformity" $ do-        it "prop_arbitraryQuid_uniform" $-            property prop_arbitraryQuid_uniform--    parallel $ describe "Uniqueness" $ do-        it "prop_arbitraryQuid_unique" $-            property prop_arbitraryQuid_unique--    parallel $ describe "Shrinkability" $ do-        it "prop_shrinkQuid_lessThan" $-            property prop_shrinkQuid_lessThan-        it "prop_shrinkQuid_minimalElement" $-            property prop_shrinkQuid_minimalElement-        it "prop_shrinkQuid_minimalSet" $-            property prop_shrinkQuid_minimalSet-        it "prop_shrinkQuid_ordered" $-            property prop_shrinkQuid_ordered-        it "prop_shrinkQuid_unique" $-            property prop_shrinkQuid_unique------------------------------------------------------------------------------------- Powers of two-----------------------------------------------------------------------------------newtype PowerOfTwo = PowerOfTwo {powerOfTwoExponent :: Natural}-    deriving (Eq, Ord, Show)--instance Buildable PowerOfTwo where-    build (PowerOfTwo e) = "2^" <> build (show e)--evalPowerOfTwo :: PowerOfTwo -> Natural-evalPowerOfTwo = (2 ^) . powerOfTwoExponent--genPowerOfTwo :: (Natural, Natural) -> Gen PowerOfTwo-genPowerOfTwo (lo, hi) = PowerOfTwo <$> chooseNatural (lo, hi)--shrinkPowerOfTwo :: PowerOfTwo -> [PowerOfTwo]-shrinkPowerOfTwo = shrinkMapBy PowerOfTwo powerOfTwoExponent shrinkNatural------------------------------------------------------------------------------------- Prime numbers-----------------------------------------------------------------------------------newtype PrimeNumber = PrimeNumber {primeNumberIndex :: Natural}-    deriving (Eq, Ord, Show)--instance Buildable PrimeNumber where-    build = build . show . evalPrimeNumber--evalPrimeNumber :: PrimeNumber -> Natural-evalPrimeNumber = indexToPrime primes . primeNumberIndex-  where-    indexToPrime ps i-        | i == 0 = head ps-        | otherwise = indexToPrime (drop 1 ps) (i - 1)--genPrimeNumber :: (Natural, Natural) -> Gen PrimeNumber-genPrimeNumber (lo, hi) = PrimeNumber <$> chooseNatural (lo, hi)--shrinkPrimeNumber :: PrimeNumber -> [PrimeNumber]-shrinkPrimeNumber = shrinkMapBy PrimeNumber primeNumberIndex shrinkNatural------------------------------------------------------------------------------------- Partition functions-----------------------------------------------------------------------------------data PartitionFunction-    = Div PowerOfTwo-    | Mod PrimeNumber-    deriving (Eq, Ord, Show)--instance Buildable PartitionFunction where-    build = \case-        Div p -> "div " <> padLeftF 5 ' ' p-        Mod p -> "mod " <> padLeftF 5 ' ' p--evalPartitionFunction :: PartitionFunction -> (Natural -> Natural)-evalPartitionFunction = \case-    Div p -> (`div` evalPowerOfTwo  p)-    Mod p -> (`mod` evalPrimeNumber p)------------------------------------------------------------------------------------- Partition contexts-----------------------------------------------------------------------------------data PartitionContext = PartitionContext-    { sizeExponent :: PowerOfTwo-    , expectedBucketCount :: Natural-    , partitionFunction :: PartitionFunction-    }-    deriving (Eq, Ord, Show)--instance Buildable PartitionContext where-    build c = mconcat-        [ "(size = "-        , padLeftF 5 ' ' (sizeExponent c)-        , ", expected bucket count = "-        , padLeftF 3 ' ' (show $ expectedBucketCount c)-        , ", partition function = "-        , build (partitionFunction c)-        , ")"-        ]------------------------------------------------------------------------------------- Div partitions-----------------------------------------------------------------------------------data DivPartition = DivPartition-    { divArgument :: PowerOfTwo-    , scaleFactor :: PowerOfTwo-    }-    deriving (Eq, Ord, Show)--evalDivPartition :: DivPartition -> PartitionContext-evalDivPartition DivPartition {divArgument, scaleFactor} =-    PartitionContext-        { sizeExponent = PowerOfTwo-            $ powerOfTwoExponent divArgument-            + powerOfTwoExponent scaleFactor-        , expectedBucketCount = evalPowerOfTwo scaleFactor-        , partitionFunction = Div divArgument-        }--genDivPartition :: Gen DivPartition-genDivPartition = do-    divArgument <- oneof (genPowerOfTwo <$> [(0, 1), (2, 256)])-    scaleFactor <- oneof (genPowerOfTwo <$> [(0, 1), (2,   8)])-    pure DivPartition {divArgument, scaleFactor}--shrinkDivPartition :: DivPartition -> [DivPartition]-shrinkDivPartition = shrinkMapBy unTuple toTuple $-    liftShrink2 shrinkPowerOfTwo shrinkPowerOfTwo-  where-    unTuple (c, s) = (DivPartition c s)-    toTuple (DivPartition c s) = (c, s)------------------------------------------------------------------------------------- Mod partitions-----------------------------------------------------------------------------------data ModPartition = ModPartition-    { modArgument :: PrimeNumber-    , scaleFactor :: PowerOfTwo-    }-    deriving (Eq, Ord, Show)--evalModPartition :: ModPartition -> PartitionContext-evalModPartition ModPartition {modArgument, scaleFactor} =-    PartitionContext-        { sizeExponent = PowerOfTwo-            $ primeNumberIndex modArgument-            + powerOfTwoExponent scaleFactor-            + 8-        , expectedBucketCount = evalPrimeNumber modArgument-        , partitionFunction = Mod modArgument-        }--genModPartition :: Gen ModPartition-genModPartition = do-    modArgument <- oneof (genPrimeNumber <$> [(0, 1), (2,  32)])-    scaleFactor <- oneof (genPowerOfTwo  <$> [(0, 1), (2, 256)])-    pure ModPartition {modArgument, scaleFactor}--shrinkModPartition :: ModPartition -> [ModPartition]-shrinkModPartition = shrinkMapBy unTuple toTuple $-    liftShrink2 shrinkPrimeNumber shrinkPowerOfTwo-  where-    unTuple (m, s) = (ModPartition m s)-    toTuple (ModPartition m s) = (m, s)------------------------------------------------------------------------------------- Partitions-----------------------------------------------------------------------------------data Partition-    = DivPartitionOf DivPartition-    | ModPartitionOf ModPartition-    deriving (Eq, Ord, Show)--instance Arbitrary Partition where-    arbitrary = genPartition-    shrink = shrinkPartition--evalPartition :: Partition -> PartitionContext-evalPartition = \case-    DivPartitionOf p -> evalDivPartition p-    ModPartitionOf p -> evalModPartition p--genPartition :: Gen Partition-genPartition = oneof-    [ DivPartitionOf <$> genDivPartition-    , ModPartitionOf <$> genModPartition-    ]--shrinkPartition :: Partition -> [Partition]-shrinkPartition = \case-    DivPartitionOf p -> DivPartitionOf <$> shrinkDivPartition p-    ModPartitionOf p -> ModPartitionOf <$> shrinkModPartition p------------------------------------------------------------------------------------- Uniformity-----------------------------------------------------------------------------------prop_arbitraryQuid_uniform :: Partition -> Property-prop_arbitraryQuid_uniform p =-    label (pretty partitionContext) $-    forAllBlind arbitraryValues prop-  where-    partitionContext :: PartitionContext-    partitionContext@PartitionContext-        { sizeExponent-        , expectedBucketCount-        , partitionFunction-        } = evalPartition p--    valueToBucket :: Quid -> Natural-    valueToBucket = (evalPartitionFunction partitionFunction) . quidToNatural--    arbitraryValue :: Gen Quid-    arbitraryValue =-        resize (fromIntegral (powerOfTwoExponent sizeExponent)) arbitraryQuid--    arbitraryValues :: Gen [Quid]-    arbitraryValues =-        replicateM (fromIntegral arbitraryValueCount) arbitraryValue--    arbitraryValueCount :: Natural-    arbitraryValueCount = unFrequency expectedFrequency * expectedBucketCount--    expectedFrequency :: Frequency-    expectedFrequency = Frequency 1024--    minimumPermittedFrequency :: Frequency-    minimumPermittedFrequency = expectedFrequency <&> ((* 3) . (`div` 4))--    maximumPermittedFrequency :: Frequency-    maximumPermittedFrequency = expectedFrequency <&> ((* 5) . (`div` 4))--    prop :: [Quid] -> Property-    prop values = reports $ checks $ property True-      where-        reports-            = report sizeExponent-                "size exponent"-            . report arbitraryValueCount-                "arbitrary value count"-            . report expectedBucketCount-                "expected bucket count"-            . report occupiedBucketCount-                "occupied bucket count"-            . report expectedFrequency-                "expected frequency"-            . report minimumObservedFrequency-                "minimum observed frequency"-            . report minimumPermittedFrequency-                "minimum permitted frequency"-            . report maximumObservedFrequency-                "maximum observed frequency"-            . report maximumPermittedFrequency-                "maximum permitted frequency"-        checks-            = check-                (occupiedBucketCount == expectedBucketCount)-                "occupiedBucketCount == expectedBucketCount"-            . check-                (minimumObservedFrequency >= minimumPermittedFrequency)-                "minimumObservedFrequency >= minimumPermittedFrequency"-            . check-                (maximumObservedFrequency <= maximumPermittedFrequency)-                "maximumObservedFrequency <= maximumPermittedFrequency"--        occupiedBuckets :: [Natural]-        occupiedBuckets = valueToBucket <$> values--        occupiedBucketFrequencies :: [(Natural, Frequency)]-        occupiedBucketFrequencies = frequencies occupiedBuckets--        occupiedBucketCount :: Natural-        occupiedBucketCount = fromIntegral $ length occupiedBucketFrequencies--        minimumObservedFrequency :: Frequency-        minimumObservedFrequency = snd $ last occupiedBucketFrequencies--        maximumObservedFrequency :: Frequency-        maximumObservedFrequency = snd $ head occupiedBucketFrequencies------------------------------------------------------------------------------------- Uniqueness-----------------------------------------------------------------------------------prop_arbitraryQuid_unique :: Property-prop_arbitraryQuid_unique =-    withMaxSuccess 1 $-    forAllBlind arbitraryFixedSizeQuids $ \uids ->-        Set.size (Set.fromList uids) === L.length uids-  where-    arbitraryFixedSizeQuids :: Gen [TestQuid]-    arbitraryFixedSizeQuids = fmap (unSize . getFixed) <$>-        replicateM 1_000_000 (arbitrary @(Fixed (Size 256 TestQuid)))------------------------------------------------------------------------------------- Shrinkability-----------------------------------------------------------------------------------prop_shrinkQuid_lessThan :: Size 256 TestQuid -> Property-prop_shrinkQuid_lessThan (Size q) =-    property $ all (< q) (shrink q)--prop_shrinkQuid_minimalElement :: TestQuid -> Property-prop_shrinkQuid_minimalElement q =-    checkCoverage $-    cover 10 (q /= minimalQuid) "q /= minimalQuid" $-    case shrink q of-        s : _ -> s === minimalQuid-        _     -> q === minimalQuid-  where-    minimalQuid = TestQuid 0--prop_shrinkQuid_minimalSet :: [Size 256 TestQuid] -> Property-prop_shrinkQuid_minimalSet qs =-    label (show $ bucket expectedSize) $-    counterexample (show expectedSize) $-    counterexample (show minimalSet) $-    conjoin-        [ Set.toList minimalSet `L.isPrefixOf` allQuids-        , Set.size minimalSet == expectedSize-        ]-  where-    allQuids :: [TestQuid]-    allQuids = TestQuid . naturalToQuid <$> [0 ..]--    bucket :: Int -> (Int, Int)-    bucket size = (lo, hi)-      where-        lo = size `div` 10 * 10-        hi = lo + 9--    expectedSize :: Int-    expectedSize = L.length qs--    minimalSet :: Set TestQuid-    minimalSet = Set.map unSize $ fromMaybe-        (error "Cannot shrink to minimal set")-        (shrinkWhile ((>= expectedSize) . Set.size) shrink (Set.fromList qs))--prop_shrinkQuid_ordered :: Size 256 TestQuid -> Property-prop_shrinkQuid_ordered (Size q) =-    L.sort shrunkValues === shrunkValues-  where-    shrunkValues = shrink q--prop_shrinkQuid_unique :: Size 256 TestQuid -> Property-prop_shrinkQuid_unique (Size q) =-    Set.size (Set.fromList shrunkValues) === L.length shrunkValues-  where-    shrunkValues = shrink q------------------------------------------------------------------------------------- Shrinking-----------------------------------------------------------------------------------shrinkWhile :: (a -> Bool) -> (a -> [a]) -> a -> Maybe a-shrinkWhile condition shrinkFn = loop-  where-    loop a-        | condition a =-            case L.find condition (shrinkFn a) of-                Nothing -> Just a-                Just a' -> loop a'-        | otherwise =-            Nothing------------------------------------------------------------------------------------- Frequencies-----------------------------------------------------------------------------------type Frequency = FrequencyOf Natural--newtype FrequencyOf a = Frequency {unFrequency :: a}-    deriving (Eq, Functor, Ord, Show)--instance Semigroup Frequency where-    Frequency f1 <> Frequency f2 = Frequency (f1 + f2)--instance Monoid Frequency where-    mempty = Frequency 1--frequencies :: (Foldable f, Ord k) => f k -> [(k, Frequency)]-frequencies-    = L.sortOn ((Down . snd) &&& fst)-    . Map.toList-    . L.foldr (flip (Map.insertWith (<>)) mempty) Map.empty------------------------------------------------------------------------------------- Reporting------------------------------------------------------------------------------------- | Adds a named variable to the counterexample output of a property.------ On failure, uses pretty-printing to show the contents of the variable.----report :: (Show a, Testable prop) => a -> String -> prop -> Property-report a name = counterexample $-    "" +| name |+ ":\n" +| indentF 4 (pShowBuilder a) |+ ""-  where-    pShowBuilder :: Show a => a -> Builder-    pShowBuilder = fromLazyText . pShow------------------------------------------------------------------------------------- Verification------------------------------------------------------------------------------------- | Adds a named condition to a property.------ On failure, reports the name of the condition that failed.----check :: Bool -> String -> Property -> Property-check condition conditionTitle =-    (.&&.) (counterexample counterexampleText $ property condition)-  where-    counterexampleText = "Condition violated: " <> conditionTitle------------------------------------------------------------------------------------- Test types-----------------------------------------------------------------------------------newtype TestQuid = TestQuid Quid-    deriving (Read, Show) via (Decimal Quid)-    deriving Arbitrary via Quid-    deriving stock (Eq, Ord)

@@ -1,29 +0,0 @@-module Test.QuickCheck.Quid-    (-    -- * The Quid type-      Quid--    -- * Combinators-    , Size (..)--    -- * Representations--    -- ** Numerical representations-    , Decimal (..)-    , Hexadecimal (..)--    -- ** String representations-    , Latin (..)-    )-    where--import Internal.Test.QuickCheck.Quid-    ( Quid (..) )-import Internal.Test.QuickCheck.Quid.Combinators.Size-    ( Size (..) )-import Internal.Test.QuickCheck.Quid.Representations.Decimal-    ( Decimal (..) )-import Internal.Test.QuickCheck.Quid.Representations.Hexadecimal-    ( Hexadecimal (..) )-import Internal.Test.QuickCheck.Quid.Representations.Latin-    ( Latin (..) )

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Hspec.Unit where++import Control.Monad+    ( forM_ )+import Test.Hspec+    ( Spec, describe, it )+import Test.QuickCheck+    ( property, (===) )+import Text.Pretty.Simple+    ( pShow )++import qualified Data.Text.Lazy as TL++--------------------------------------------------------------------------------+-- Unit test support+--------------------------------------------------------------------------------++data UnitTestData params result = UnitTestData+    { params :: params+    , result :: result+    }+    deriving (Eq, Show)++unitTests+    :: (Eq result, Show result)+    => String+    -> (params -> result)+    -> [UnitTestData params result]+    -> Spec+unitTests title f unitTestData =+    describe title $+    forM_ (zip testNumbers unitTestData) $+        \(testNumber :: Int, test) -> do+            let subtitle = "Unit test #" <> show testNumber+            it subtitle $+                let resultExpected = result test in+                let resultActual = f (params test) in+                property $ Pretty resultExpected === Pretty resultActual+  where+    testNumbers :: [Int]+    testNumbers = [1 ..]++--------------------------------------------------------------------------------+-- Pretty-printing+--------------------------------------------------------------------------------++-- | A combinator that causes the output of `show` to be pretty-printed.+--+newtype Pretty a = Pretty { unPretty :: a }+    deriving Eq++instance Show a => Show (Pretty a) where+    show (Pretty a) = TL.unpack ("\n" <> pShow a <> "\n")

@@ -0,0 +1,61 @@+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- Provides testing functions to check that type class instances obey laws.+--+module Test.QuickCheck.Classes.Hspec+    ( testLaws+    , testLawsMany+    ) where++import Prelude++import Control.Monad+    ( forM_ )+import Data.Proxy+    ( Proxy (..) )+import Data.Typeable+    ( Typeable, typeRep )+import Test.Hspec+    ( Spec, describe, it, parallel )+import Test.QuickCheck.Classes+    ( Laws (..) )++-- | Constructs a test to check that the given type class instance obeys the+--   given set of laws.+--+-- Example usage:+--+-- >>> testLaws @Natural ordLaws+-- >>> testLaws @(Map Int) functorLaws+--+testLaws+    :: forall a. Typeable a+    => (Proxy a -> Laws)+    -> Spec+testLaws getLaws =+    parallel $ describe description $+        forM_ (lawsProperties laws) $ uncurry it+  where+    description = mconcat+        [ "Testing "+        , lawsTypeclass laws+        , " laws for type "+        , show (typeRep $ Proxy @a)+        ]+    laws = getLaws $ Proxy @a++-- | Calls `testLaws` with multiple sets of laws.+--+-- Example usage:+--+-- >>> testLawsMany @Natural [eqLaws, ordLaws]+-- >>> testLawsMany @(Map Int) [foldableLaws, functorLaws]+--+testLawsMany+    :: forall a. Typeable a+    => [Proxy a -> Laws]+    -> Spec+testLawsMany getLawsMany =+    testLaws @a `mapM_` getLawsMany

@@ -0,0 +1,49 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Test.QuickCheck.Quid.Combinators.PrefixSpec+    where++import Internal.Test.QuickCheck.Quid.Combinators.Prefix+    ( Prefix (..) )+import Test.Hspec+    ( Spec, describe, parallel )+import Test.QuickCheck+    ( Arbitrary (..), shrinkMapBy )+import Test.QuickCheck.Classes.Hspec+    ( testLawsMany )++import qualified Test.QuickCheck.Classes as Laws++spec :: Spec+spec = do++    parallel $ describe "Lawfulness of type class instances" $ do+        testLawsMany @(Prefix "A" Int)+            [ Laws.showLaws+            , Laws.showReadLaws+            ]+        testLawsMany @(Prefix ":" Int)+            [ Laws.showLaws+            , Laws.showReadLaws+            ]+        testLawsMany @(Prefix "1" Int)+            [ Laws.showLaws+            , Laws.showReadLaws+            ]+        testLawsMany @(Prefix "test-prefix:" Int)+            [ Laws.showLaws+            , Laws.showReadLaws+            ]++--------------------------------------------------------------------------------+-- Arbitrary instances+--------------------------------------------------------------------------------++instance Arbitrary a => Arbitrary (Prefix p a) where+    arbitrary = Prefix <$> arbitrary+    shrink = shrinkMapBy Prefix unPrefix shrink

@@ -0,0 +1,91 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Test.QuickCheck.Quid.Representations.DecimalSpec+    where++import Internal.Test.QuickCheck.Quid+    ( Quid, naturalToQuid )+import Internal.Test.QuickCheck.Quid.Representations.Decimal+    ( Decimal (..) )+import Numeric.Natural+    ( Natural )+import Test.Hspec+    ( Spec, describe, parallel )+import Test.Hspec.Unit+    ( UnitTestData (..), unitTests )+import Test.QuickCheck+    ( Arbitrary (..) )+import Test.QuickCheck.Classes.Hspec+    ( testLawsMany )++import Prelude hiding+    ( (^) )++import qualified Prelude+import qualified Test.QuickCheck.Classes as Laws++spec :: Spec+spec = do++    parallel $ describe "Lawfulness of type class instances" $ do+        testLawsMany @(Decimal Quid)+            [ Laws.showLaws+            , Laws.showReadLaws+            ]++    parallel $ describe "Unit tests" $ do+        unitTests_show_decimal_naturalToQuid++--------------------------------------------------------------------------------+-- Unit tests+--------------------------------------------------------------------------------++unitTests_show_decimal_naturalToQuid :: Spec+unitTests_show_decimal_naturalToQuid = unitTests+    "unitTests_show_decimal_naturalToQuid"+    (show . Decimal . naturalToQuid)+    (mkTest <$> tests)+  where+    mkTest :: (Natural, String) -> UnitTestData Natural String+    mkTest (params, result) = UnitTestData {params, result}++    (^) :: Natural -> Natural -> Natural+    (^) = (Prelude.^)++    tests =+        [ (0, "0")+        , (1, "1")+        , (8, "8")+        , (9, "9")++        , (10^0, "1")+        , (10^1, "10")+        , (10^2, "100")+        , (10^3, "1000")+        , (10^4, "10000")+        , (10^5, "100000")+        , (10^6, "1000000")+        , (10^7, "10000000")++        , (10^0 - 1, "0")+        , (10^1 - 1, "9")+        , (10^2 - 1, "99")+        , (10^3 - 1, "999")+        , (10^4 - 1, "9999")+        , (10^5 - 1, "99999")+        , (10^6 - 1, "999999")+        , (10^7 - 1, "9999999")+        ]++--------------------------------------------------------------------------------+-- Arbitrary instances+--------------------------------------------------------------------------------++deriving via Quid instance Arbitrary (Decimal Quid)

@@ -0,0 +1,106 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Test.QuickCheck.Quid.Representations.HexadecimalSpec+    where++import Internal.Test.QuickCheck.Quid+    ( Quid, naturalToQuid )+import Internal.Test.QuickCheck.Quid.Representations.Hexadecimal+    ( Hexadecimal (..) )+import Numeric.Natural+    ( Natural )+import Test.Hspec+    ( Spec, describe, parallel )+import Test.Hspec.Unit+    ( UnitTestData (..), unitTests )+import Test.QuickCheck+    ( Arbitrary (..) )+import Test.QuickCheck.Classes.Hspec+    ( testLawsMany )++import Prelude hiding+    ( (^) )++import qualified Prelude+import qualified Test.QuickCheck.Classes as Laws++spec :: Spec+spec = do++    parallel $ describe "Lawfulness of type class instances" $ do+        testLawsMany @(Hexadecimal Quid)+            [ Laws.showLaws+            , Laws.showReadLaws+            ]++    parallel $ describe "Unit tests" $ do+        unitTests_show_hexadecimal_naturalToQuid++--------------------------------------------------------------------------------+-- Unit tests+--------------------------------------------------------------------------------++unitTests_show_hexadecimal_naturalToQuid :: Spec+unitTests_show_hexadecimal_naturalToQuid = unitTests+    "unitTests_show_hexadecimal_naturalToQuid"+    (show . Hexadecimal . naturalToQuid)+    (mkTest <$> tests)+  where+    mkTest :: (Natural, String) -> UnitTestData Natural String+    mkTest (params, result) = UnitTestData {params, result}++    (^) :: Natural -> Natural -> Natural+    (^) = (Prelude.^)++    tests =+        [ ( 0, "0x0")+        , ( 1, "0x1")+        , (14, "0xe")+        , (15, "0xf")++        , (16 +  0, "0x10")+        , (16 +  1, "0x11")+        , (16 + 14, "0x1e")+        , (16 + 15, "0x1f")++        , (2 * 16 +  0, "0x20")+        , (2 * 16 +  1, "0x21")+        , (2 * 16 + 14, "0x2e")+        , (2 * 16 + 15, "0x2f")++        , (15 * 16 +  0, "0xf0")+        , (15 * 16 +  1, "0xf1")+        , (15 * 16 + 14, "0xfe")+        , (15 * 16 + 15, "0xff")++        , (16^0, "0x1")+        , (16^1, "0x10")+        , (16^2, "0x100")+        , (16^3, "0x1000")+        , (16^4, "0x10000")+        , (16^5, "0x100000")+        , (16^6, "0x1000000")+        , (16^7, "0x10000000")++        , (16^0 - 1, "0x0")+        , (16^1 - 1, "0xf")+        , (16^2 - 1, "0xff")+        , (16^3 - 1, "0xfff")+        , (16^4 - 1, "0xffff")+        , (16^5 - 1, "0xfffff")+        , (16^6 - 1, "0xffffff")+        , (16^7 - 1, "0xfffffff")+        ]++--------------------------------------------------------------------------------+-- Arbitrary instances+--------------------------------------------------------------------------------++deriving via Quid instance Arbitrary (Hexadecimal Quid)

@@ -0,0 +1,145 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Test.QuickCheck.Quid.Representations.LatinSpec+    where++import Data.Function+    ( (&) )+import Data.List+    ( uncons )+import Internal.Test.QuickCheck.Quid+    ( Quid, arbitraryQuid, naturalToQuid, shrinkQuid )+import Internal.Test.QuickCheck.Quid.Representations.Latin+    ( Latin (..)+    , LatinChar (..)+    , LatinString+    , charToLatinChar+    , latinCharToChar+    )+import Numeric.Natural+    ( Natural )+import Test.Hspec+    ( Spec, describe, it, parallel )+import Test.Hspec.Unit+    ( UnitTestData (..), unitTests )+import Test.QuickCheck+    ( Arbitrary (..), Property, property, shrinkMapBy, (===) )+import Test.QuickCheck.Classes.Hspec+    ( testLawsMany )++import Prelude hiding+    ( (^) )++import qualified Prelude+import qualified Test.QuickCheck.Classes as Laws++spec :: Spec+spec = do++    parallel $ describe "Lawfulness of type class instances" $ do+        testLawsMany @(Latin Quid)+            [ Laws.showLaws+            , Laws.showReadLaws+            ]++    parallel $ describe "Properties" $ do+        it "prop_latinCharToChar_uncons_show" $+            prop_latinCharToChar_uncons_show+                & property+        it "prop_roundTrip_LatinChar_Char" $+            prop_roundTrip_LatinChar_Char+                & property+        it "prop_roundTrip_LatinString_Quid" $+            prop_roundTrip_LatinString_Quid+                & property++    parallel $ describe "Unit tests" $ do+        unitTests_show_latin_naturalToQuid++--------------------------------------------------------------------------------+-- Properties+--------------------------------------------------------------------------------++prop_latinCharToChar_uncons_show :: LatinChar -> Property+prop_latinCharToChar_uncons_show c =+    Just (latinCharToChar c) === fmap fst (uncons (show c))++prop_roundTrip_LatinChar_Char :: LatinChar -> Property+prop_roundTrip_LatinChar_Char c =+    charToLatinChar (latinCharToChar c) === Just c++prop_roundTrip_LatinString_Quid :: LatinString -> Property+prop_roundTrip_LatinString_Quid latinString =+    show (read @(Latin Quid) expectedOutput) === expectedOutput+  where+    expectedOutput :: String+    expectedOutput = show latinString++--------------------------------------------------------------------------------+-- Unit tests+--------------------------------------------------------------------------------++unitTests_show_latin_naturalToQuid :: Spec+unitTests_show_latin_naturalToQuid = unitTests+    "unitTests_show_latin_naturalToQuid"+    (show . Latin . naturalToQuid)+    (mkTest <$> tests)+  where+    mkTest :: (Natural, String) -> UnitTestData Natural String+    mkTest (params, result) = UnitTestData {params, result = show result}++    (^) :: Natural -> Natural -> Natural+    (^) = (Prelude.^)++    tests =+        [ ( 0, "A")+        , ( 1, "B")+        , (24, "Y")+        , (25, "Z")++        , (26 +  0, "AA")+        , (26 +  1, "AB")+        , (26 + 24, "AY")+        , (26 + 25, "AZ")++        , (2 * 26 +  0, "BA")+        , (2 * 26 +  1, "BB")+        , (2 * 26 + 24, "BY")+        , (2 * 26 + 25, "BZ")++        , (26 * 26 +  0, "ZA")+        , (26 * 26 +  1, "ZB")+        , (26 * 26 + 24, "ZY")+        , (26 * 26 + 25, "ZZ")++        , (26                                          , "AA")+        , (26 + 26^2                                   , "AAA")+        , (26 + 26^2 + 26^3                            , "AAAA")+        , (26 + 26^2 + 26^3 + 26^4                     , "AAAAA")+        , (26 + 26^2 + 26^3 + 26^4 + 26^5              , "AAAAAA")+        , (26 + 26^2 + 26^3 + 26^4 + 26^5 + 26^6       , "AAAAAAA")+        , (26 + 26^2 + 26^3 + 26^4 + 26^5 + 26^6 + 26^7, "AAAAAAAA")++        , (26                                                  - 1, "Z")+        , (26 + 26^2                                           - 1, "ZZ")+        , (26 + 26^2 + 26^3                                    - 1, "ZZZ")+        , (26 + 26^2 + 26^3 + 26^4                             - 1, "ZZZZ")+        , (26 + 26^2 + 26^3 + 26^4 + 26^5                      - 1, "ZZZZZ")+        , (26 + 26^2 + 26^3 + 26^4 + 26^5 + 26^6               - 1, "ZZZZZZ")+        , (26 + 26^2 + 26^3 + 26^4 + 26^5 + 26^6 + 26^7        - 1, "ZZZZZZZ")+        , (26 + 26^2 + 26^3 + 26^4 + 26^5 + 26^6 + 26^7 + 26^8 - 1, "ZZZZZZZZ")+        ]++--------------------------------------------------------------------------------+-- Arbitrary instances+--------------------------------------------------------------------------------++instance Arbitrary (Latin Quid) where+    arbitrary = Latin <$> arbitraryQuid+    shrink = shrinkMapBy Latin unLatin shrinkQuid

@@ -0,0 +1,550 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Test.QuickCheck.QuidSpec+    where++import Control.Arrow+    ( (&&&) )+import Control.Monad+    ( replicateM )+import Data.Functor+    ( (<&>) )+import Data.Maybe+    ( fromMaybe )+import Data.Numbers.Primes+    ( primes )+import Data.Ord+    ( Down (..) )+import Data.Set+    ( Set )+import Data.Text.Lazy.Builder+    ( Builder, fromLazyText )+import Fmt+    ( Buildable (..), indentF, padLeftF, pretty, (+|), (|+) )+import Internal.Test.QuickCheck.Quid+    ( Quid+    , arbitraryQuid+    , chooseNatural+    , naturalToQuid+    , quidToNatural+    , shrinkNatural+    )+import Internal.Test.QuickCheck.Quid.Combinators.Size+    ( Size (..) )+import Internal.Test.QuickCheck.Quid.Representations.Decimal+    ( Decimal (..) )+import Numeric.Natural+    ( Natural )+import Test.Hspec+    ( Spec, describe, it, parallel )+import Test.QuickCheck+    ( Arbitrary (..)+    , Fixed (..)+    , Gen+    , Property+    , Testable (..)+    , checkCoverage+    , conjoin+    , counterexample+    , cover+    , forAllBlind+    , label+    , liftShrink2+    , oneof+    , property+    , resize+    , shrinkMapBy+    , withMaxSuccess+    , (.&&.)+    , (===)+    )+import Test.QuickCheck.Classes.Hspec+    ( testLawsMany )+import Text.Pretty.Simple+    ( pShow )++import qualified Data.List as L+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import qualified Test.QuickCheck.Classes as Laws++spec :: Spec+spec = do++    parallel $ describe "Lawfulness of type class instances" $ do+        testLawsMany @TestQuid+            [ Laws.eqLaws+            , Laws.ordLaws+            ]+        testLawsMany @TestQuid+            [ Laws.eqLaws+            , Laws.ordLaws+            , Laws.showLaws+            , Laws.showReadLaws+            ]++    parallel $ describe "Uniformity" $ do+        it "prop_arbitraryQuid_uniform" $+            property prop_arbitraryQuid_uniform++    parallel $ describe "Uniqueness" $ do+        it "prop_arbitraryQuid_unique" $+            property prop_arbitraryQuid_unique++    parallel $ describe "Shrinkability" $ do+        it "prop_shrinkQuid_lessThan" $+            property prop_shrinkQuid_lessThan+        it "prop_shrinkQuid_minimalElement" $+            property prop_shrinkQuid_minimalElement+        it "prop_shrinkQuid_minimalSet" $+            property prop_shrinkQuid_minimalSet+        it "prop_shrinkQuid_ordered" $+            property prop_shrinkQuid_ordered+        it "prop_shrinkQuid_unique" $+            property prop_shrinkQuid_unique++--------------------------------------------------------------------------------+-- Powers of two+--------------------------------------------------------------------------------++newtype PowerOfTwo = PowerOfTwo {powerOfTwoExponent :: Natural}+    deriving (Eq, Ord, Show)++instance Buildable PowerOfTwo where+    build (PowerOfTwo e) = "2^" <> build (show e)++evalPowerOfTwo :: PowerOfTwo -> Natural+evalPowerOfTwo = (2 ^) . powerOfTwoExponent++genPowerOfTwo :: (Natural, Natural) -> Gen PowerOfTwo+genPowerOfTwo (lo, hi) = PowerOfTwo <$> chooseNatural (lo, hi)++shrinkPowerOfTwo :: PowerOfTwo -> [PowerOfTwo]+shrinkPowerOfTwo = shrinkMapBy PowerOfTwo powerOfTwoExponent shrinkNatural++--------------------------------------------------------------------------------+-- Prime numbers+--------------------------------------------------------------------------------++newtype PrimeNumber = PrimeNumber {primeNumberIndex :: Natural}+    deriving (Eq, Ord, Show)++instance Buildable PrimeNumber where+    build = build . show . evalPrimeNumber++evalPrimeNumber :: PrimeNumber -> Natural+evalPrimeNumber = indexToPrime primes . primeNumberIndex+  where+    indexToPrime (p : ps) i+        | i == 0 = p+        | otherwise = indexToPrime ps (i - 1)+    indexToPrime [] _ =+        error "evalPrimeNumber: Unexpected empty list of prime numbers."++genPrimeNumber :: (Natural, Natural) -> Gen PrimeNumber+genPrimeNumber (lo, hi) = PrimeNumber <$> chooseNatural (lo, hi)++shrinkPrimeNumber :: PrimeNumber -> [PrimeNumber]+shrinkPrimeNumber = shrinkMapBy PrimeNumber primeNumberIndex shrinkNatural++--------------------------------------------------------------------------------+-- Partition functions+--------------------------------------------------------------------------------++data PartitionFunction+    = Div PowerOfTwo+    | Mod PrimeNumber+    deriving (Eq, Ord, Show)++instance Buildable PartitionFunction where+    build = \case+        Div p -> "div " <> padLeftF 5 ' ' p+        Mod p -> "mod " <> padLeftF 5 ' ' p++evalPartitionFunction :: PartitionFunction -> (Natural -> Natural)+evalPartitionFunction = \case+    Div p -> (`div` evalPowerOfTwo  p)+    Mod p -> (`mod` evalPrimeNumber p)++--------------------------------------------------------------------------------+-- Partition contexts+--------------------------------------------------------------------------------++data PartitionContext = PartitionContext+    { sizeExponent :: PowerOfTwo+    , expectedBucketCount :: Natural+    , partitionFunction :: PartitionFunction+    }+    deriving (Eq, Ord, Show)++instance Buildable PartitionContext where+    build c = mconcat+        [ "(size = "+        , padLeftF 5 ' ' (sizeExponent c)+        , ", expected bucket count = "+        , padLeftF 3 ' ' (show $ expectedBucketCount c)+        , ", partition function = "+        , build (partitionFunction c)+        , ")"+        ]++--------------------------------------------------------------------------------+-- Div partitions+--------------------------------------------------------------------------------++data DivPartition = DivPartition+    { divArgument :: PowerOfTwo+    , scaleFactor :: PowerOfTwo+    }+    deriving (Eq, Ord, Show)++evalDivPartition :: DivPartition -> PartitionContext+evalDivPartition DivPartition {divArgument, scaleFactor} =+    PartitionContext+        { sizeExponent = PowerOfTwo+            $ powerOfTwoExponent divArgument+            + powerOfTwoExponent scaleFactor+        , expectedBucketCount = evalPowerOfTwo scaleFactor+        , partitionFunction = Div divArgument+        }++genDivPartition :: Gen DivPartition+genDivPartition = do+    divArgument <- oneof (genPowerOfTwo <$> [(0, 1), (2, 256)])+    scaleFactor <- oneof (genPowerOfTwo <$> [(0, 1), (2,   8)])+    pure DivPartition {divArgument, scaleFactor}++shrinkDivPartition :: DivPartition -> [DivPartition]+shrinkDivPartition = shrinkMapBy unTuple toTuple $+    liftShrink2 shrinkPowerOfTwo shrinkPowerOfTwo+  where+    unTuple (c, s) = (DivPartition c s)+    toTuple (DivPartition c s) = (c, s)++--------------------------------------------------------------------------------+-- Mod partitions+--------------------------------------------------------------------------------++data ModPartition = ModPartition+    { modArgument :: PrimeNumber+    , scaleFactor :: PowerOfTwo+    }+    deriving (Eq, Ord, Show)++evalModPartition :: ModPartition -> PartitionContext+evalModPartition ModPartition {modArgument, scaleFactor} =+    PartitionContext+        { sizeExponent = PowerOfTwo+            $ primeNumberIndex modArgument+            + powerOfTwoExponent scaleFactor+            + 8+        , expectedBucketCount = evalPrimeNumber modArgument+        , partitionFunction = Mod modArgument+        }++genModPartition :: Gen ModPartition+genModPartition = do+    modArgument <- oneof (genPrimeNumber <$> [(0, 1), (2,  32)])+    scaleFactor <- oneof (genPowerOfTwo  <$> [(0, 1), (2, 256)])+    pure ModPartition {modArgument, scaleFactor}++shrinkModPartition :: ModPartition -> [ModPartition]+shrinkModPartition = shrinkMapBy unTuple toTuple $+    liftShrink2 shrinkPrimeNumber shrinkPowerOfTwo+  where+    unTuple (m, s) = (ModPartition m s)+    toTuple (ModPartition m s) = (m, s)++--------------------------------------------------------------------------------+-- Partitions+--------------------------------------------------------------------------------++data Partition+    = DivPartitionOf DivPartition+    | ModPartitionOf ModPartition+    deriving (Eq, Ord, Show)++instance Arbitrary Partition where+    arbitrary = genPartition+    shrink = shrinkPartition++evalPartition :: Partition -> PartitionContext+evalPartition = \case+    DivPartitionOf p -> evalDivPartition p+    ModPartitionOf p -> evalModPartition p++genPartition :: Gen Partition+genPartition = oneof+    [ DivPartitionOf <$> genDivPartition+    , ModPartitionOf <$> genModPartition+    ]++shrinkPartition :: Partition -> [Partition]+shrinkPartition = \case+    DivPartitionOf p -> DivPartitionOf <$> shrinkDivPartition p+    ModPartitionOf p -> ModPartitionOf <$> shrinkModPartition p++--------------------------------------------------------------------------------+-- Uniformity+--------------------------------------------------------------------------------++prop_arbitraryQuid_uniform :: Partition -> Property+prop_arbitraryQuid_uniform p =+    label (pretty partitionContext) $+    forAllBlind arbitraryValues prop+  where+    partitionContext :: PartitionContext+    partitionContext@PartitionContext+        { sizeExponent+        , expectedBucketCount+        , partitionFunction+        } = evalPartition p++    valueToBucket :: Quid -> Natural+    valueToBucket = (evalPartitionFunction partitionFunction) . quidToNatural++    arbitraryValue :: Gen Quid+    arbitraryValue =+        resize (fromIntegral (powerOfTwoExponent sizeExponent)) arbitraryQuid++    arbitraryValues :: Gen [Quid]+    arbitraryValues =+        replicateM (fromIntegral arbitraryValueCount) arbitraryValue++    arbitraryValueCount :: Natural+    arbitraryValueCount = unFrequency expectedFrequency * expectedBucketCount++    expectedFrequency :: Frequency+    expectedFrequency = Frequency 1024++    minimumPermittedFrequency :: Frequency+    minimumPermittedFrequency = expectedFrequency <&> ((* 3) . (`div` 4))++    maximumPermittedFrequency :: Frequency+    maximumPermittedFrequency = expectedFrequency <&> ((* 5) . (`div` 4))++    prop :: [Quid] -> Property+    prop values = reports $ checks $ property True+      where+        reports+            = report sizeExponent+                "size exponent"+            . report arbitraryValueCount+                "arbitrary value count"+            . report expectedBucketCount+                "expected bucket count"+            . report occupiedBucketCount+                "occupied bucket count"+            . report expectedFrequency+                "expected frequency"+            . report minimumObservedFrequency+                "minimum observed frequency"+            . report minimumPermittedFrequency+                "minimum permitted frequency"+            . report maximumObservedFrequency+                "maximum observed frequency"+            . report maximumPermittedFrequency+                "maximum permitted frequency"+        checks+            = check+                (occupiedBucketCount == expectedBucketCount)+                "occupiedBucketCount == expectedBucketCount"+            . check+                (minimumObservedFrequency >= minimumPermittedFrequency)+                "minimumObservedFrequency >= minimumPermittedFrequency"+            . check+                (maximumObservedFrequency <= maximumPermittedFrequency)+                "maximumObservedFrequency <= maximumPermittedFrequency"++        occupiedBuckets :: [Natural]+        occupiedBuckets = valueToBucket <$> values++        occupiedBucketFrequencies :: [(Natural, Frequency)]+        occupiedBucketFrequencies = frequencies occupiedBuckets++        occupiedBucketCount :: Natural+        occupiedBucketCount = fromIntegral $ length occupiedBucketFrequencies++        minimumObservedFrequency :: Frequency+        minimumObservedFrequency =+            snd $ lastNote note occupiedBucketFrequencies+          where+            note = "minimumObservedFrequency: unexpected empty list"++        maximumObservedFrequency :: Frequency+        maximumObservedFrequency =+            snd $ headNote note occupiedBucketFrequencies+          where+            note = "maximumObservedFrequency: unexpected empty list"++--------------------------------------------------------------------------------+-- Uniqueness+--------------------------------------------------------------------------------++prop_arbitraryQuid_unique :: Property+prop_arbitraryQuid_unique =+    withMaxSuccess 1 $+    forAllBlind arbitraryFixedSizeQuids $ \uids ->+        Set.size (Set.fromList uids) === L.length uids+  where+    arbitraryFixedSizeQuids :: Gen [TestQuid]+    arbitraryFixedSizeQuids = fmap (unSize . getFixed) <$>+        replicateM 1_000_000 (arbitrary @(Fixed (Size 256 TestQuid)))++--------------------------------------------------------------------------------+-- Shrinkability+--------------------------------------------------------------------------------++prop_shrinkQuid_lessThan :: Size 256 TestQuid -> Property+prop_shrinkQuid_lessThan (Size q) =+    property $ all (< q) (shrink q)++prop_shrinkQuid_minimalElement :: TestQuid -> Property+prop_shrinkQuid_minimalElement q =+    checkCoverage $+    cover 10 (q /= minimalQuid) "q /= minimalQuid" $+    case shrink q of+        s : _ -> s === minimalQuid+        _     -> q === minimalQuid+  where+    minimalQuid = TestQuid 0++prop_shrinkQuid_minimalSet :: [Size 256 TestQuid] -> Property+prop_shrinkQuid_minimalSet qs =+    label (show $ bucket expectedSize) $+    counterexample (show expectedSize) $+    counterexample (show minimalSet) $+    conjoin+        [ Set.toList minimalSet `L.isPrefixOf` allQuids+        , Set.size minimalSet == expectedSize+        ]+  where+    allQuids :: [TestQuid]+    allQuids = TestQuid . naturalToQuid <$> [0 ..]++    bucket :: Int -> (Int, Int)+    bucket size = (lo, hi)+      where+        lo = size `div` 10 * 10+        hi = lo + 9++    expectedSize :: Int+    expectedSize = L.length qs++    minimalSet :: Set TestQuid+    minimalSet = Set.map unSize $ fromMaybe+        (error "Cannot shrink to minimal set")+        (shrinkWhile ((>= expectedSize) . Set.size) shrink (Set.fromList qs))++prop_shrinkQuid_ordered :: Size 256 TestQuid -> Property+prop_shrinkQuid_ordered (Size q) =+    L.sort shrunkValues === shrunkValues+  where+    shrunkValues = shrink q++prop_shrinkQuid_unique :: Size 256 TestQuid -> Property+prop_shrinkQuid_unique (Size q) =+    Set.size (Set.fromList shrunkValues) === L.length shrunkValues+  where+    shrunkValues = shrink q++--------------------------------------------------------------------------------+-- Shrinking+--------------------------------------------------------------------------------++shrinkWhile :: (a -> Bool) -> (a -> [a]) -> a -> Maybe a+shrinkWhile condition shrinkFn = loop+  where+    loop a+        | condition a =+            case L.find condition (shrinkFn a) of+                Nothing -> Just a+                Just a' -> loop a'+        | otherwise =+            Nothing++--------------------------------------------------------------------------------+-- Frequencies+--------------------------------------------------------------------------------++type Frequency = FrequencyOf Natural++newtype FrequencyOf a = Frequency {unFrequency :: a}+    deriving (Eq, Functor, Ord, Show)++instance Semigroup Frequency where+    Frequency f1 <> Frequency f2 = Frequency (f1 + f2)++instance Monoid Frequency where+    mempty = Frequency 1++frequencies :: (Foldable f, Ord k) => f k -> [(k, Frequency)]+frequencies+    = L.sortOn ((Down . snd) &&& fst)+    . Map.toList+    . L.foldr (flip (Map.insertWith (<>)) mempty) Map.empty++--------------------------------------------------------------------------------+-- Reporting+--------------------------------------------------------------------------------++-- | Adds a named variable to the counterexample output of a property.+--+-- On failure, uses pretty-printing to show the contents of the variable.+--+report :: (Show a, Testable prop) => a -> String -> prop -> Property+report a name = counterexample $+    "" +| name |+ ":\n" +| indentF 4 (pShowBuilder a) |+ ""+  where+    pShowBuilder :: Show a => a -> Builder+    pShowBuilder = fromLazyText . pShow++--------------------------------------------------------------------------------+-- Verification+--------------------------------------------------------------------------------++-- | Adds a named condition to a property.+--+-- On failure, reports the name of the condition that failed.+--+check :: Bool -> String -> Property -> Property+check condition conditionTitle =+    (.&&.) (counterexample counterexampleText $ property condition)+  where+    counterexampleText = "Condition violated: " <> conditionTitle++--------------------------------------------------------------------------------+-- Utilities+--------------------------------------------------------------------------------++headNote :: String -> [a] -> a+headNote note = g+  where+    g [] = error note+    g (a : _) = a++lastNote :: String -> [a] -> a+lastNote note = g+  where+    g [] = error note+    g [a] = a+    g (_ : as) = g as++--------------------------------------------------------------------------------+-- Test types+--------------------------------------------------------------------------------++newtype TestQuid = TestQuid Quid+    deriving (Read, Show) via (Decimal Quid)+    deriving Arbitrary via Quid+    deriving stock (Eq, Ord)