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

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

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