Michelson.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

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


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

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

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

genLetName :: MonadGen m => m LetName
genLetName = LetName <$> Gen.text (Range.linear 0 3) Gen.unicodeAll

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

genPos :: MonadGen m => m Pos
genPos = Pos <$> Gen.word Range.linearBounded

genMText :: MonadGen m => m MText
genMText =
  unsafeMkMText <$> Gen.text
    (Range.linear 0 100)
    (Gen.enum (toEnum @Char minBoundMChar) (toEnum @Char maxBoundMChar))