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

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

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

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

genExpression :: forall m. (MonadGen m, GenBase m ~ Identity) => m Expression
genExpression :: m Expression
genExpression = ([m Expression] -> m Expression)
-> [m Expression] -> [m Expression] -> m Expression
forall (m :: * -> *) a.
MonadGen m =>
([m a] -> m a) -> [m a] -> [m a] -> m a
Gen.recursive [m Expression] -> m Expression
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
  [m Expression
genExpressionInt, m Expression
genExpressionString, m Expression
genExpressionBytes]
  [m Expression
genSeq, m Expression
genExpressionPrim]
  where
    genExpressionInt :: m Expression
genExpressionInt = Integer -> Expression
ExpressionInt (Integer -> Expression) -> m Integer -> m Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Range Integer -> m Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Integer -> Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> a -> Range a
Range.linearFrom Integer
0 Integer
-1000 Integer
1000))
    genExpressionString :: m Expression
genExpressionString = Text -> Expression
ExpressionString (Text -> Expression) -> m Text -> m Expression
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
10) m Char
forall (m :: * -> *). MonadGen m => m Char
Gen.unicodeAll)
    genExpressionBytes :: m Expression
genExpressionBytes = ByteString -> Expression
ExpressionBytes (ByteString -> Expression) -> m ByteString -> m Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Range Int -> m ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
100))
    genSeq :: m Expression
genSeq = [Expression] -> Expression
ExpressionSeq ([Expression] -> Expression) -> m [Expression] -> m Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Expression]
forall (m :: * -> *).
(MonadGen m, GenBase m ~ Identity) =>
m [Expression]
genExpressionSeq
    genExpressionPrim :: m Expression
genExpressionPrim = MichelinePrimAp -> Expression
ExpressionPrim (MichelinePrimAp -> Expression)
-> m MichelinePrimAp -> m Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m MichelinePrimAp
forall (m :: * -> *).
(MonadGen m, GenBase m ~ Identity) =>
m MichelinePrimAp
genMichelinePrimAp

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

genMichelinePrimAp :: forall m. (MonadGen m, GenBase m ~ Identity) => m MichelinePrimAp
genMichelinePrimAp :: m MichelinePrimAp
genMichelinePrimAp = MichelinePrimitive
-> [Expression] -> [Annotation] -> MichelinePrimAp
MichelinePrimAp (MichelinePrimitive
 -> [Expression] -> [Annotation] -> MichelinePrimAp)
-> m MichelinePrimitive
-> m ([Expression] -> [Annotation] -> MichelinePrimAp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m MichelinePrimitive
genMichelinePrimitive m ([Expression] -> [Annotation] -> MichelinePrimAp)
-> m [Expression] -> m ([Annotation] -> MichelinePrimAp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [Expression]
forall (m :: * -> *).
(MonadGen m, GenBase m ~ Identity) =>
m [Expression]
genExpressionSeq m ([Annotation] -> MichelinePrimAp)
-> m [Annotation] -> m MichelinePrimAp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [Annotation]
genAnnots
  where
    genMichelinePrimitive :: m MichelinePrimitive
genMichelinePrimitive = Text -> MichelinePrimitive
MichelinePrimitive (Text -> MichelinePrimitive) -> m Text -> m MichelinePrimitive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text] -> m Text
forall (m :: * -> *) a. MonadGen m => [a] -> m a
Gen.element ([Text] -> m Text) -> [Text] -> m Text
forall a b. (a -> b) -> a -> b
$ Seq Text -> [Element (Seq Text)]
forall t. Container t => t -> [Element t]
toList Seq Text
michelsonPrimitive)

    genAnnots :: m [Annotation]
    genAnnots :: m [Annotation]
genAnnots = Range Int -> m Annotation -> m [Annotation]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
10) m Annotation
forall (m :: * -> *).
(MonadGen m, GenBase m ~ Identity) =>
m Annotation
genExprAnnotation

genExprAnnotation :: forall m. (MonadGen m, GenBase m ~ Identity) => m Annotation
genExprAnnotation :: m Annotation
genExprAnnotation =  [m Annotation] -> m Annotation
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
  [m Annotation
genAnnotationType, m Annotation
genAnnotationVariable, m Annotation
genAnnotationField]
  where
    genAnnotationType :: m Annotation
genAnnotationType = TypeAnn -> Annotation
AnnotationType (TypeAnn -> Annotation) -> m TypeAnn -> m Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m TypeAnn
forall k (m :: * -> *) (a :: k).
(MonadGen m, GenBase m ~ Identity) =>
m (Annotation a)
genAnnotation
    genAnnotationVariable :: m Annotation
genAnnotationVariable = VarAnn -> Annotation
AnnotationVariable (VarAnn -> Annotation) -> m VarAnn -> m Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m VarAnn
forall k (m :: * -> *) (a :: k).
(MonadGen m, GenBase m ~ Identity) =>
m (Annotation a)
genAnnotation
    genAnnotationField :: m Annotation
genAnnotationField = FieldAnn -> Annotation
AnnotationField (FieldAnn -> Annotation) -> m FieldAnn -> m Annotation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m FieldAnn
forall k (m :: * -> *) (a :: k).
(MonadGen m, GenBase m ~ Identity) =>
m (Annotation a)
genAnnotation