{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Ledger.Huddle.Gen (
  -- * MonadGen
  module GenT,

  -- * CBORGen
  module CBORGen,

  -- * Term generators
  Term (..),
  WrappedTerm (..),
  genRule,
  genArrayTerm,
  genBytesTerm,
  genStringTerm,
  genMapTerm,

  -- * Lifted generators
  arbitrary,
  scale,
  shuffle,

  -- * Antigen
  module AntiGen,
) where

import Cardano.Ledger.Binary (Term (..))
import Cardano.Ledger.Huddle (HuddleRule ())
import Codec.CBOR.Cuddle.CBOR.Gen (generateFromName)
import Codec.CBOR.Cuddle.CDDL (Name (..))
import Codec.CBOR.Cuddle.CDDL.CBORGenerator as CBORGen
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LBS
import Data.Proxy (Proxy (..))
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import GHC.TypeLits (symbolVal)
import Test.AntiGen as AntiGen
import qualified Test.QuickCheck as QC
import Test.QuickCheck.GenT as GenT

-- | A function for generating a term from a rule. The @HuddleRule@ constraint
-- ensures that the rule is actually defined in that era.
genRule :: forall rule era. HuddleRule rule era => CBORGen Term
genRule :: forall (rule :: Symbol) era. HuddleRule rule era => CBORGen Term
genRule = HasCallStack => Name -> CBORGen Term
Name -> CBORGen Term
generateFromName (Text -> Name
Name (Text -> Name) -> (Proxy rule -> Text) -> Proxy rule -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Proxy rule -> String) -> Proxy rule -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy rule -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy rule -> Name) -> Proxy rule -> Name
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @rule)

-- Lifted Gen functions

arbitrary :: forall a m. (MonadGen m, QC.Arbitrary a) => m a
arbitrary :: forall a (m :: * -> *). (MonadGen m, Arbitrary a) => m a
arbitrary = Gen a -> m a
forall a. Gen a -> m a
forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen Gen a
forall a. Arbitrary a => Gen a
QC.arbitrary

scale :: MonadGen m => (Int -> Int) -> m a -> m a
scale :: forall (m :: * -> *) a. MonadGen m => (Int -> Int) -> m a -> m a
scale Int -> Int
f m a
m = (Int -> m a) -> m a
forall a. (Int -> m a) -> m a
forall (g :: * -> *) a. MonadGen g => (Int -> g a) -> g a
sized ((Int -> m a) -> m a) -> (Int -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Int
sz -> Int -> m a -> m a
forall a. Int -> m a -> m a
forall (g :: * -> *) a. MonadGen g => Int -> g a -> g a
resize (Int -> Int
f Int
sz) m a
m

shuffle :: MonadGen m => [a] -> m [a]
shuffle :: forall (m :: * -> *) a. MonadGen m => [a] -> m [a]
shuffle = Gen [a] -> m [a]
forall a. Gen a -> m a
forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen (Gen [a] -> m [a]) -> ([a] -> Gen [a]) -> [a] -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Gen [a]
forall a. [a] -> Gen [a]
QC.shuffle

-- Term generators

genArrayTerm :: MonadGen m => [Term] -> m Term
genArrayTerm :: forall (m :: * -> *). MonadGen m => [Term] -> m Term
genArrayTerm [Term]
es = [Term] -> m Term
forall (m :: * -> *) a. MonadGen m => [a] -> m a
GenT.elements [[Term] -> Term
TList [Term]
es, [Term] -> Term
TListI [Term]
es]

genBytesTerm :: MonadGen m => ByteString -> m Term
genBytesTerm :: forall (m :: * -> *). MonadGen m => ByteString -> m Term
genBytesTerm ByteString
bs = [Term] -> m Term
forall (m :: * -> *) a. MonadGen m => [a] -> m a
GenT.elements [ByteString -> Term
TBytes ByteString
bs, ByteString -> Term
TBytesI (ByteString -> Term) -> ByteString -> Term
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.fromStrict ByteString
bs]

genStringTerm :: MonadGen m => T.Text -> m Term
genStringTerm :: forall (m :: * -> *). MonadGen m => Text -> m Term
genStringTerm Text
t = [Term] -> m Term
forall (m :: * -> *) a. MonadGen m => [a] -> m a
GenT.elements [Text -> Term
TString Text
t, Text -> Term
TStringI (Text -> Term) -> Text -> Term
forall a b. (a -> b) -> a -> b
$ Text -> Text
LT.fromStrict Text
t]

genMapTerm :: MonadGen m => [(Term, Term)] -> m Term
genMapTerm :: forall (m :: * -> *). MonadGen m => [(Term, Term)] -> m Term
genMapTerm [(Term, Term)]
m = [Term] -> m Term
forall (m :: * -> *) a. MonadGen m => [a] -> m a
GenT.elements [[(Term, Term)] -> Term
TMap [(Term, Term)]
m, [(Term, Term)] -> Term
TMapI [(Term, Term)]
m]