{-# 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 (..)
  -- , StaticBytes (..)
  -- , StaticSeq (..)
  , 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
  -- Picked so bound**2 fits in int
  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 LengthBounds (D p) => GenDefault (D p) (StaticBytes n) where
--   genDefault = genListLike (StaticBytes . BSS.pack)

-- instance (LengthBounds (D p), GenDefault (D p) a) => GenDefault (D p) (StaticSeq n a) where
--   genDefault = genListLike (StaticSeq . Seq.fromList)

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 ())