{-# 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 (FooId -> FooId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FooId -> FooId -> Bool
$c/= :: FooId -> FooId -> Bool
== :: FooId -> FooId -> Bool
$c== :: FooId -> FooId -> Bool
Eq, forall x. Rep FooId x -> FooId
forall x. FooId -> Rep FooId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FooId x -> FooId
$cfrom :: forall x. FooId -> Rep FooId x
Generic, Eq FooId
FooId -> FooId -> Bool
FooId -> FooId -> Ordering
FooId -> FooId -> FooId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FooId -> FooId -> FooId
$cmin :: FooId -> FooId -> FooId
max :: FooId -> FooId -> FooId
$cmax :: FooId -> FooId -> FooId
>= :: FooId -> FooId -> Bool
$c>= :: FooId -> FooId -> Bool
> :: FooId -> FooId -> Bool
$c> :: FooId -> FooId -> Bool
<= :: FooId -> FooId -> Bool
$c<= :: FooId -> FooId -> Bool
< :: FooId -> FooId -> Bool
$c< :: FooId -> FooId -> Bool
compare :: FooId -> FooId -> Ordering
$ccompare :: FooId -> FooId -> Ordering
Ord, ReadPrec [FooId]
ReadPrec FooId
Int -> ReadS FooId
ReadS [FooId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FooId]
$creadListPrec :: ReadPrec [FooId]
readPrec :: ReadPrec FooId
$creadPrec :: ReadPrec FooId
readList :: ReadS [FooId]
$creadList :: ReadS [FooId]
readsPrec :: Int -> ReadS FooId
$creadsPrec :: Int -> ReadS FooId
Read, Int -> FooId -> ShowS
[FooId] -> ShowS
FooId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FooId] -> ShowS
$cshowList :: [FooId] -> ShowS
show :: FooId -> String
$cshow :: FooId -> String
showsPrec :: Int -> FooId -> ShowS
$cshowsPrec :: Int -> FooId -> ShowS
Show)
    deriving Gen FooId
FooId -> [FooId]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
shrink :: FooId -> [FooId]
$cshrink :: FooId -> [FooId]
arbitrary :: Gen FooId
$carbitrary :: Gen FooId
Arbitrary via Size 256 Quid
    deriving forall b. FooId -> Gen b -> Gen b
forall a. (forall b. a -> Gen b -> Gen b) -> CoArbitrary a
coarbitrary :: forall b. FooId -> Gen b -> Gen b
$ccoarbitrary :: forall b. FooId -> Gen b -> Gen b
CoArbitrary via Quid
    deriving anyclass forall b. (FooId -> b) -> FooId :-> b
forall a. (forall b. (a -> b) -> a :-> b) -> Function a
function :: forall b. (FooId -> b) -> FooId :-> b
$cfunction :: forall b. (FooId -> b) -> FooId :-> b
Function
    deriving newtype Integer -> FooId
FooId -> FooId
FooId -> FooId -> FooId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> FooId
$cfromInteger :: Integer -> FooId
signum :: FooId -> FooId
$csignum :: FooId -> FooId
abs :: FooId -> FooId
$cabs :: FooId -> FooId
negate :: FooId -> FooId
$cnegate :: FooId -> FooId
* :: FooId -> FooId -> FooId
$c* :: FooId -> FooId -> FooId
- :: FooId -> FooId -> FooId
$c- :: FooId -> FooId -> FooId
+ :: FooId -> FooId -> FooId
$c+ :: FooId -> FooId -> FooId
Num

newtype BarId = BarId (Hexadecimal Quid)
    deriving stock (BarId -> BarId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BarId -> BarId -> Bool
$c/= :: BarId -> BarId -> Bool
== :: BarId -> BarId -> Bool
$c== :: BarId -> BarId -> Bool
Eq, forall x. Rep BarId x -> BarId
forall x. BarId -> Rep BarId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BarId x -> BarId
$cfrom :: forall x. BarId -> Rep BarId x
Generic, Eq BarId
BarId -> BarId -> Bool
BarId -> BarId -> Ordering
BarId -> BarId -> BarId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BarId -> BarId -> BarId
$cmin :: BarId -> BarId -> BarId
max :: BarId -> BarId -> BarId
$cmax :: BarId -> BarId -> BarId
>= :: BarId -> BarId -> Bool
$c>= :: BarId -> BarId -> Bool
> :: BarId -> BarId -> Bool
$c> :: BarId -> BarId -> Bool
<= :: BarId -> BarId -> Bool
$c<= :: BarId -> BarId -> Bool
< :: BarId -> BarId -> Bool
$c< :: BarId -> BarId -> Bool
compare :: BarId -> BarId -> Ordering
$ccompare :: BarId -> BarId -> Ordering
Ord, ReadPrec [BarId]
ReadPrec BarId
Int -> ReadS BarId
ReadS [BarId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BarId]
$creadListPrec :: ReadPrec [BarId]
readPrec :: ReadPrec BarId
$creadPrec :: ReadPrec BarId
readList :: ReadS [BarId]
$creadList :: ReadS [BarId]
readsPrec :: Int -> ReadS BarId
$creadsPrec :: Int -> ReadS BarId
Read, Int -> BarId -> ShowS
[BarId] -> ShowS
BarId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BarId] -> ShowS
$cshowList :: [BarId] -> ShowS
show :: BarId -> String
$cshow :: BarId -> String
showsPrec :: Int -> BarId -> ShowS
$cshowsPrec :: Int -> BarId -> ShowS
Show)
    deriving Gen BarId
BarId -> [BarId]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
shrink :: BarId -> [BarId]
$cshrink :: BarId -> [BarId]
arbitrary :: Gen BarId
$carbitrary :: Gen BarId
Arbitrary via Size 256 Quid
    deriving forall b. BarId -> Gen b -> Gen b
forall a. (forall b. a -> Gen b -> Gen b) -> CoArbitrary a
coarbitrary :: forall b. BarId -> Gen b -> Gen b
$ccoarbitrary :: forall b. BarId -> Gen b -> Gen b
CoArbitrary via Quid
    deriving anyclass forall b. (BarId -> b) -> BarId :-> b
forall a. (forall b. (a -> b) -> a :-> b) -> Function a
function :: forall b. (BarId -> b) -> BarId :-> b
$cfunction :: forall b. (BarId -> b) -> BarId :-> b
Function
    deriving newtype Integer -> BarId
BarId -> BarId
BarId -> BarId -> BarId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> BarId
$cfromInteger :: Integer -> BarId
signum :: BarId -> BarId
$csignum :: BarId -> BarId
abs :: BarId -> BarId
$cabs :: BarId -> BarId
negate :: BarId -> BarId
$cnegate :: BarId -> BarId
* :: BarId -> BarId -> BarId
$c* :: BarId -> BarId -> BarId
- :: BarId -> BarId -> BarId
$c- :: BarId -> BarId -> BarId
+ :: BarId -> BarId -> BarId
$c+ :: BarId -> BarId -> BarId
Num

newtype BazId = BazId (Latin Quid)
    deriving stock (BazId -> BazId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BazId -> BazId -> Bool
$c/= :: BazId -> BazId -> Bool
== :: BazId -> BazId -> Bool
$c== :: BazId -> BazId -> Bool
Eq, forall x. Rep BazId x -> BazId
forall x. BazId -> Rep BazId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BazId x -> BazId
$cfrom :: forall x. BazId -> Rep BazId x
Generic, Eq BazId
BazId -> BazId -> Bool
BazId -> BazId -> Ordering
BazId -> BazId -> BazId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BazId -> BazId -> BazId
$cmin :: BazId -> BazId -> BazId
max :: BazId -> BazId -> BazId
$cmax :: BazId -> BazId -> BazId
>= :: BazId -> BazId -> Bool
$c>= :: BazId -> BazId -> Bool
> :: BazId -> BazId -> Bool
$c> :: BazId -> BazId -> Bool
<= :: BazId -> BazId -> Bool
$c<= :: BazId -> BazId -> Bool
< :: BazId -> BazId -> Bool
$c< :: BazId -> BazId -> Bool
compare :: BazId -> BazId -> Ordering
$ccompare :: BazId -> BazId -> Ordering
Ord, ReadPrec [BazId]
ReadPrec BazId
Int -> ReadS BazId
ReadS [BazId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BazId]
$creadListPrec :: ReadPrec [BazId]
readPrec :: ReadPrec BazId
$creadPrec :: ReadPrec BazId
readList :: ReadS [BazId]
$creadList :: ReadS [BazId]
readsPrec :: Int -> ReadS BazId
$creadsPrec :: Int -> ReadS BazId
Read, Int -> BazId -> ShowS
[BazId] -> ShowS
BazId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BazId] -> ShowS
$cshowList :: [BazId] -> ShowS
show :: BazId -> String
$cshow :: BazId -> String
showsPrec :: Int -> BazId -> ShowS
$cshowsPrec :: Int -> BazId -> ShowS
Show)
    deriving Gen BazId
BazId -> [BazId]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
shrink :: BazId -> [BazId]
$cshrink :: BazId -> [BazId]
arbitrary :: Gen BazId
$carbitrary :: Gen BazId
Arbitrary via Size 256 Quid
    deriving forall b. BazId -> Gen b -> Gen b
forall a. (forall b. a -> Gen b -> Gen b) -> CoArbitrary a
coarbitrary :: forall b. BazId -> Gen b -> Gen b
$ccoarbitrary :: forall b. BazId -> Gen b -> Gen b
CoArbitrary via Quid
    deriving anyclass forall b. (BazId -> b) -> BazId :-> b
forall a. (forall b. (a -> b) -> a :-> b) -> Function a
function :: forall b. (BazId -> b) -> BazId :-> b
$cfunction :: forall b. (BazId -> b) -> BazId :-> b
Function