module Hedgehog.Gen.Michelson
( genInstrCallStack
, genLetName
, genSrcPos
, genPos
, genMText
) where
import Hedgehog (MonadGen)
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified as Range
import Morley.Michelson.ErrorPos (InstrCallStack(..), LetName(..), Pos(..), SrcPos(..))
import Morley.Michelson.Text (MText, maxBoundMChar, minBoundMChar, mkMText)
genInstrCallStack :: MonadGen m => m InstrCallStack
genInstrCallStack :: m InstrCallStack
genInstrCallStack = LetCallStack -> SrcPos -> InstrCallStack
InstrCallStack (LetCallStack -> SrcPos -> InstrCallStack)
-> m LetCallStack -> m (SrcPos -> InstrCallStack)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m LetCallStack
genLetCallStack m (SrcPos -> InstrCallStack) -> m SrcPos -> m InstrCallStack
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m SrcPos
forall (m :: * -> *). MonadGen m => m SrcPos
genSrcPos
where
genLetCallStack :: m LetCallStack
genLetCallStack = [(Int, m LetCallStack)] -> m LetCallStack
forall (m :: * -> *) a. MonadGen m => [(Int, m a)] -> m a
Gen.frequency
[ (Int
80, LetCallStack -> m LetCallStack
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
, (Int
18, Range Int -> m LetName -> m LetCallStack
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Range Int
forall a. a -> Range a
Range.singleton Int
1) m LetName
forall (m :: * -> *). MonadGen m => m LetName
genLetName)
, (Int
2, Range Int -> m LetName -> m LetCallStack
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Range Int
forall a. a -> Range a
Range.singleton Int
2) m LetName
forall (m :: * -> *). MonadGen m => m LetName
genLetName)
]
genLetName :: MonadGen m => m LetName
genLetName :: m LetName
genLetName = Text -> LetName
LetName (Text -> LetName) -> m Text -> m LetName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> m Char -> m Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
3) m Char
forall (m :: * -> *). MonadGen m => m Char
Gen.unicodeAll
genSrcPos :: MonadGen m => m SrcPos
genSrcPos :: m SrcPos
genSrcPos = Pos -> Pos -> SrcPos
SrcPos (Pos -> Pos -> SrcPos) -> m Pos -> m (Pos -> SrcPos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Pos
forall (m :: * -> *). MonadGen m => m Pos
genPos m (Pos -> SrcPos) -> m Pos -> m SrcPos
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Pos
forall (m :: * -> *). MonadGen m => m Pos
genPos
genPos :: MonadGen m => m Pos
genPos :: m Pos
genPos = Word -> Pos
Pos (Word -> Pos) -> m Word -> m Pos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word -> m Word
forall (m :: * -> *). MonadGen m => Range Word -> m Word
Gen.word Range Word
forall a. (Bounded a, Integral a) => Range a
Range.linearBounded
genMText :: MonadGen m => m MText
genMText :: m MText
genMText =
Either Text MText -> MText
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text MText -> MText)
-> (Text -> Either Text MText) -> Text -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> MText) -> m Text -> m MText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> m Char -> m Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text
(Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
100)
(Char -> Char -> m Char
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
Gen.enum (Int -> Char
forall a. Enum a => Int -> a
toEnum @Char Int
minBoundMChar) (Int -> Char
forall a. Enum a => Int -> a
toEnum @Char Int
maxBoundMChar))