{-# LANGUAGE UndecidableInstances #-}
module Test.Dahdit.GenDefault
( genSigned
, genUnsigned
, genFractional
, genEnum
, genSum
, genList
, genSeq
, genString
, genSBS
, genText
, ViaSigned (..)
, ViaUnsigned (..)
, ViaFractional (..)
, LengthBounds (..)
, DahditTag
)
where
import Dahdit
( BoolByte (..)
, DoubleBE (..)
, DoubleLE (..)
, ExactBytes (..)
, FloatBE (..)
, FloatLE (..)
, Int16BE (..)
, Int16LE (..)
, Int32BE (..)
, Int32LE (..)
, Int64BE (..)
, Int64LE (..)
, TermBytes16 (..)
, TermBytes8 (..)
, Word16BE (..)
, Word16LE (..)
, Word32BE (..)
, Word32LE (..)
, Word64BE (..)
, Word64LE (..)
)
import Data.Bits (FiniteBits (..))
import Data.ByteString.Internal (w2c)
import Data.ByteString.Short (ShortByteString)
import Data.ByteString.Short qualified as BSS
import Data.Int (Int16, Int32, Int64, Int8)
import Data.IntMap (IntMap)
import Data.IntMap qualified as IntMap
import Data.IntSet (IntSet)
import Data.IntSet qualified as IntSet
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Proxy (Proxy (..))
import Data.Ratio ((%))
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as T
import Data.Word (Word16, Word32, Word64, Word8)
import Test.Falsify.GenDefault (GenDefault (..), ViaGeneric (..))
import Test.Falsify.Generator (Gen)
import Test.Falsify.Generator qualified as FG
import Test.Falsify.Range qualified as FR
genPrintableChar :: Gen Char
genPrintableChar :: Gen Char
genPrintableChar = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Char
w2c (forall a. Range a -> Gen a
FG.inRange (forall a. (Integral a, FiniteBits a) => (a, a) -> Range a
FR.between (Word8
32, Word8
126)))
genSigned :: (Integral a, FiniteBits a, Bounded a) => Gen a
genSigned :: forall a. (Integral a, FiniteBits a, Bounded a) => Gen a
genSigned = forall a. Range a -> Gen a
FG.inRange (forall a. (Integral a, FiniteBits a) => (a, a) -> a -> Range a
FR.withOrigin (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound) a
0)
genUnsigned :: (Integral a, FiniteBits a, Bounded a) => Gen a
genUnsigned :: forall a. (Integral a, FiniteBits a, Bounded a) => Gen a
genUnsigned = forall a. Range a -> Gen a
FG.inRange (forall a. (Integral a, FiniteBits a) => (a, a) -> Range a
FR.between (a
0, forall a. Bounded a => a
maxBound))
genFractional :: (Fractional a) => Gen a
genFractional :: forall a. Fractional a => Gen a
genFractional = do
let bound :: Int
bound = Int
3037000499 :: Int
Int
n <- forall a. Range a -> Gen a
FG.inRange (forall a. (Integral a, FiniteBits a) => (a, a) -> Range a
FR.between (Int
0, Int
bound))
Int
b <- forall a. Range a -> Gen a
FG.inRange (forall a. (Integral a, FiniteBits a) => (a, a) -> Range a
FR.between (Int
1, Int
bound))
Int
a <- forall a. Range a -> Gen a
FG.inRange (forall a. (Integral a, FiniteBits a) => (a, a) -> a -> Range a
FR.withOrigin ((-Int
n) forall a. Num a => a -> a -> a
* Int
b, Int
n forall a. Num a => a -> a -> a
* Int
b) Int
0)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Fractional a => Rational -> a
fromRational (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b))
genEnum :: (Enum a, Bounded a) => Gen a
genEnum :: forall a. (Enum a, Bounded a) => Gen a
genEnum = let b :: a
b = forall a. Bounded a => a
minBound in forall a. NonEmpty a -> Gen a
FG.elem (a
b forall a. a -> [a] -> NonEmpty a
:| forall a. Int -> [a] -> [a]
drop Int
1 [a
b .. forall a. Bounded a => a
maxBound])
genSum :: NonEmpty (Gen a) -> Gen a
genSum :: forall a. NonEmpty (Gen a) -> Gen a
genSum (Gen a
g :| [Gen a]
gs) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Gen a -> Gen a -> Gen a
FG.choose Gen a
g [Gen a]
gs
genList :: Word -> Word -> Gen a -> Gen [a]
genList :: forall a. Word -> Word -> Gen a -> Gen [a]
genList Word
mn Word
mx = forall a. Range Word -> Gen a -> Gen [a]
FG.list (forall a. (Integral a, FiniteBits a) => (a, a) -> Range a
FR.between (Word
mn, Word
mx))
genSeq :: Word -> Word -> Gen a -> Gen (Seq a)
genSeq :: forall a. Word -> Word -> Gen a -> Gen (Seq a)
genSeq Word
mn Word
mx = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> Seq a
Seq.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Word -> Word -> Gen a -> Gen [a]
genList Word
mn Word
mx
genString :: Word -> Word -> Gen String
genString :: Word -> Word -> Gen String
genString Word
mn Word
mx = forall a. Word -> Word -> Gen a -> Gen [a]
genList Word
mn Word
mx Gen Char
genPrintableChar
genSBS :: Word -> Word -> Gen ShortByteString
genSBS :: Word -> Word -> Gen ShortByteString
genSBS Word
mn Word
mx = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ShortByteString
BSS.pack (forall a. Word -> Word -> Gen a -> Gen [a]
genList Word
mn Word
mx forall a. (Integral a, FiniteBits a, Bounded a) => Gen a
genUnsigned)
genText :: Word -> Word -> Gen Text
genText :: Word -> Word -> Gen Text
genText Word
mn Word
mx = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Word -> Word -> Gen String
genString Word
mn Word
mx)
newtype ViaSigned a = ViaSigned {forall a. ViaSigned a -> a
unViaSigned :: a}
instance (Integral a, FiniteBits a, Bounded a) => GenDefault p (ViaSigned a) where
genDefault :: Proxy p -> Gen (ViaSigned a)
genDefault Proxy p
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> ViaSigned a
ViaSigned forall a. (Integral a, FiniteBits a, Bounded a) => Gen a
genSigned
newtype ViaUnsigned a = ViaUnsigned {forall a. ViaUnsigned a -> a
unViaUnsigned :: a}
instance (Integral a, FiniteBits a, Bounded a) => GenDefault p (ViaUnsigned a) where
genDefault :: Proxy p -> Gen (ViaUnsigned a)
genDefault Proxy p
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> ViaUnsigned a
ViaUnsigned forall a. (Integral a, FiniteBits a, Bounded a) => Gen a
genUnsigned
newtype ViaFractional a = ViaFractional {forall a. ViaFractional a -> a
unViaFractional :: a}
instance (Fractional a) => GenDefault p (ViaFractional a) where
genDefault :: Proxy p -> Gen (ViaFractional a)
genDefault Proxy p
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> ViaFractional a
ViaFractional forall a. Fractional a => Gen a
genFractional
class LengthBounds p a where
lengthBounds :: Proxy p -> Proxy a -> (Word, Word)
proxyForRange :: (x -> b) -> Proxy b
proxyForRange :: forall x b. (x -> b) -> Proxy b
proxyForRange x -> b
_ = forall {k} (t :: k). Proxy t
Proxy
genListLike :: (LengthBounds p b, GenDefault p a) => ([a] -> b) -> Proxy p -> Gen b
genListLike :: forall p b a.
(LengthBounds p b, GenDefault p a) =>
([a] -> b) -> Proxy p -> Gen b
genListLike [a] -> b
f Proxy p
p =
let (Word
mn, Word
mx) = forall {k} {k} (p :: k) (a :: k).
LengthBounds p a =>
Proxy p -> Proxy a -> (Word, Word)
lengthBounds Proxy p
p (forall x b. (x -> b) -> Proxy b
proxyForRange [a] -> b
f)
in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> b
f (forall a. Word -> Word -> Gen a -> Gen [a]
genList Word
mn Word
mx (forall tag a. GenDefault tag a => Proxy tag -> Gen a
genDefault Proxy p
p))
data DahditTag p
type D = DahditTag
deriving via (ViaUnsigned Word8) instance GenDefault (D p) Word8
deriving via (ViaSigned Int8) instance GenDefault (D p) Int8
deriving via (ViaUnsigned Word16) instance GenDefault (D p) Word16
deriving via (ViaSigned Int16) instance GenDefault (D p) Int16
deriving via (ViaUnsigned Word32) instance GenDefault (D p) Word32
deriving via (ViaSigned Int32) instance GenDefault (D p) Int32
deriving via (ViaUnsigned Word64) instance GenDefault (D p) Word64
deriving via (ViaSigned Int64) instance GenDefault (D p) Int64
deriving via (ViaFractional Float) instance GenDefault (D p) Float
deriving via (ViaFractional Double) instance GenDefault (D p) Double
deriving via (ViaSigned Int) instance GenDefault (D p) Int
deriving newtype instance GenDefault (D p) Word16LE
deriving newtype instance GenDefault (D p) Int16LE
deriving newtype instance GenDefault (D p) Word32LE
deriving newtype instance GenDefault (D p) Int32LE
deriving newtype instance GenDefault (D p) Word64LE
deriving newtype instance GenDefault (D p) Int64LE
deriving newtype instance GenDefault (D p) FloatLE
deriving newtype instance GenDefault (D p) DoubleLE
deriving newtype instance GenDefault (D p) Word16BE
deriving newtype instance GenDefault (D p) Int16BE
deriving newtype instance GenDefault (D p) Word32BE
deriving newtype instance GenDefault (D p) Int32BE
deriving newtype instance GenDefault (D p) Word64BE
deriving newtype instance GenDefault (D p) Int64BE
deriving newtype instance GenDefault (D p) FloatBE
deriving newtype instance GenDefault (D p) DoubleBE
instance GenDefault (D p) Char where
genDefault :: Proxy (D p) -> Gen Char
genDefault = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Char
w2c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall tag a. GenDefault tag a => Proxy tag -> Gen a
genDefault
deriving via (ViaGeneric (D p) ()) instance GenDefault (D p) ()
deriving via
(ViaGeneric (D p) Bool)
instance
GenDefault (D p) Bool
deriving via
(ViaGeneric (D p) (Maybe a))
instance
(GenDefault (D p) a) => GenDefault (D p) (Maybe a)
deriving via
(ViaGeneric (D p) (Either a b))
instance
(GenDefault (D p) a, GenDefault (D p) b) => GenDefault (D p) (Either a b)
deriving via
(ViaGeneric (D p) (a, b))
instance
(GenDefault (D p) a, GenDefault (D p) b) => GenDefault (D p) (a, b)
deriving via
(ViaGeneric (D p) (a, b, c))
instance
(GenDefault (D p) a, GenDefault (D p) b, GenDefault (D p) c) => GenDefault (D p) (a, b, c)
deriving via
(ViaGeneric (D p) (a, b, c, d))
instance
(GenDefault (D p) a, GenDefault (D p) b, GenDefault (D p) c, GenDefault (D p) d) => GenDefault (D p) (a, b, c, d)
deriving via
(ViaGeneric (D p) (a, b, c, d, e))
instance
(GenDefault (D p) a, GenDefault (D p) b, GenDefault (D p) c, GenDefault (D p) d, GenDefault (D p) e)
=> GenDefault (D p) (a, b, c, d, e)
instance (LengthBounds (D p) [a], GenDefault (D p) a) => GenDefault (D p) [a] where
genDefault :: Proxy (D p) -> Gen [a]
genDefault = forall p b a.
(LengthBounds p b, GenDefault p a) =>
([a] -> b) -> Proxy p -> Gen b
genListLike forall a. a -> a
id
instance (LengthBounds (D p) (Seq a), GenDefault (D p) a) => GenDefault (D p) (Seq a) where
genDefault :: Proxy (D p) -> Gen (Seq a)
genDefault = forall p b a.
(LengthBounds p b, GenDefault p a) =>
([a] -> b) -> Proxy p -> Gen b
genListLike forall a. [a] -> Seq a
Seq.fromList
instance (LengthBounds (D p) (Map a b), GenDefault (D p) a, GenDefault (D p) b, Ord a) => GenDefault (D p) (Map a b) where
genDefault :: Proxy (D p) -> Gen (Map a b)
genDefault = forall p b a.
(LengthBounds p b, GenDefault p a) =>
([a] -> b) -> Proxy p -> Gen b
genListLike forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
instance (LengthBounds (D p) (Set a), GenDefault (D p) a, Ord a) => GenDefault (D p) (Set a) where
genDefault :: Proxy (D p) -> Gen (Set a)
genDefault = forall p b a.
(LengthBounds p b, GenDefault p a) =>
([a] -> b) -> Proxy p -> Gen b
genListLike forall a. Ord a => [a] -> Set a
Set.fromList
instance (LengthBounds (D p) IntSet) => GenDefault (D p) IntSet where
genDefault :: Proxy (D p) -> Gen IntSet
genDefault = forall p b a.
(LengthBounds p b, GenDefault p a) =>
([a] -> b) -> Proxy p -> Gen b
genListLike [Int] -> IntSet
IntSet.fromList
instance (LengthBounds (D p) (IntMap a), GenDefault (D p) a) => GenDefault (D p) (IntMap a) where
genDefault :: Proxy (D p) -> Gen (IntMap a)
genDefault = forall p b a.
(LengthBounds p b, GenDefault p a) =>
([a] -> b) -> Proxy p -> Gen b
genListLike forall a. [(Int, a)] -> IntMap a
IntMap.fromList
instance (LengthBounds (D p) TermBytes8) => GenDefault (D p) TermBytes8 where
genDefault :: Proxy (D p) -> Gen TermBytes8
genDefault = forall p b a.
(LengthBounds p b, GenDefault p a) =>
([a] -> b) -> Proxy p -> Gen b
genListLike (ShortByteString -> TermBytes8
TermBytes8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ShortByteString
BSS.pack)
instance (LengthBounds (D p) TermBytes16) => GenDefault (D p) TermBytes16 where
genDefault :: Proxy (D p) -> Gen TermBytes16
genDefault = forall p b a.
(LengthBounds p b, GenDefault p a) =>
([a] -> b) -> Proxy p -> Gen b
genListLike (ShortByteString -> TermBytes16
TermBytes16 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ShortByteString
BSS.pack)
instance GenDefault (D p) BoolByte where
genDefault :: Proxy (D p) -> Gen BoolByte
genDefault = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> BoolByte
BoolByte forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall tag a. GenDefault tag a => Proxy tag -> Gen a
genDefault
instance GenDefault (D p) (ExactBytes n s) where
genDefault :: Proxy (D p) -> Gen (ExactBytes n s)
genDefault Proxy (D p)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (n :: Nat) (s :: Symbol). () -> ExactBytes n s
ExactBytes ())