Micheline.hs

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

module Hedgehog.Gen.Morley.Micheline
  ( genExpression
  , genExpressionSeq
  , genMichelinePrimAp
  , genExprAnnotation
  ) where

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

import Hedgehog.Gen.Michelson.Untyped (genAnnotation)
import Morley.Micheline.Expression

genExpression :: forall m. (MonadGen m, GenBase m ~ Identity) => m Expression
genExpression = Gen.recursive Gen.choice
  [genExpressionInt, genExpressionString, genExpressionBytes]
  [genSeq, genExpressionPrim]
  where
    genExpressionInt = ExpressionInt <$> (Gen.integral (Range.linearFrom 0 -1000 1000))
    genExpressionString = ExpressionString <$> (Gen.text (Range.linear 0 10) Gen.unicodeAll)
    genExpressionBytes = ExpressionBytes <$> (Gen.bytes (Range.linear 0 100))
    genSeq = ExpressionSeq <$> genExpressionSeq
    genExpressionPrim = ExpressionPrim <$> genMichelinePrimAp

genExpressionSeq :: forall m. (MonadGen m, GenBase m ~ Identity) => m [Expression]
genExpressionSeq = (Gen.list (Range.linear 0 10) genExpression)

genMichelinePrimAp :: forall m. (MonadGen m, GenBase m ~ Identity) => m MichelinePrimAp
genMichelinePrimAp = MichelinePrimAp <$> genMichelinePrimitive <*> genExpressionSeq <*> genAnnots
  where
    genMichelinePrimitive = MichelinePrimitive <$> (Gen.element $ toList michelsonPrimitive)

    genAnnots :: m [Annotation]
    genAnnots = Gen.list (Range.linear 0 10) genExprAnnotation

genExprAnnotation :: forall m. (MonadGen m, GenBase m ~ Identity) => m Annotation
genExprAnnotation =  Gen.choice
  [genAnnotationType, genAnnotationVariable, genAnnotationField]
  where
    genAnnotationType = AnnotationType <$> genAnnotation
    genAnnotationVariable = AnnotationVariable <$> genAnnotation
    genAnnotationField = AnnotationField <$> genAnnotation