Michelson.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

module Hedgehog.Gen.Michelson
  ( genInstrCallStack
  , genLetName
  , genSrcPos
  , genPos
  , genMText
  ) where

import Hedgehog (MonadGen)
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range (Range)
import Hedgehog.Range qualified as Range

import Morley.Michelson.ErrorPos (InstrCallStack(..), LetName(..), Pos(..), SrcPos(..))
import Morley.Michelson.Text (MText, maxBoundMChar, minBoundMChar, mkMText)

import Hedgehog.Range.Defaults

genInstrCallStack :: MonadGen m => m InstrCallStack
genInstrCallStack = InstrCallStack <$> genLetCallStack <*> genSrcPos
  where
    genLetCallStack = Gen.frequency
      [ (80, pure [])
      , (18, Gen.list (Range.singleton 1) $ genLetName def)
      , (2, Gen.list (Range.singleton 2) $ genLetName def)
      ]

genLetName :: MonadGen m => Range TinyLength -> m LetName
genLetName lenRange =
  LetName <$> Gen.text (unTinyLength <$> lenRange) Gen.unicodeAll

genSrcPos :: MonadGen m => m SrcPos
genSrcPos = SrcPos <$> genPos def <*> genPos def

genPos :: MonadGen m => Range.Range Pos -> m Pos
genPos range = Pos <$> Gen.word (unPos <$> range)

genMText :: MonadGen m => Range.Range Length -> m MText
genMText lenRange =
  unsafe . mkMText <$> Gen.text
    (unLength <$> lenRange)
    (Gen.enum (toEnum @Char minBoundMChar) (toEnum @Char maxBoundMChar))