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

module Hedgehog.Gen.Morley.Micheline
  ( genExpression
  , genExpressionInt
  , genExpressionString
  , genExpressionBytes
  , genExpressionSeq
  , genExpressionPrim
  , genMichelinePrimAp
  , genExprAnnotation
  ) where

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

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

import Hedgehog.Range.Defaults

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 [m Expression] -> m Expression
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
  [Range ExpressionInt -> m Expression
forall (f :: * -> *).
MonadGen f =>
Range ExpressionInt -> f Expression
genExpressionInt Range ExpressionInt
forall a. Default a => a
def, Range SmallLength -> m Expression
forall (f :: * -> *).
MonadGen f =>
Range SmallLength -> f Expression
genExpressionString Range SmallLength
forall a. Default a => a
def, Range Length -> m Expression
forall (f :: * -> *). MonadGen f => Range Length -> f Expression
genExpressionBytes Range Length
forall a. Default a => a
def]
  [Range SmallLength -> m Expression
forall (m :: * -> *).
(MonadGen m, GenBase m ~ Identity) =>
Range SmallLength -> m Expression
genExpressionSeq Range SmallLength
forall a. Default a => a
def, m Expression
forall (m :: * -> *).
(MonadGen m, GenBase m ~ Identity) =>
m Expression
genExpressionPrim]

genExpressionInt :: MonadGen f => Range ExpressionInt -> f Expression
genExpressionInt :: Range ExpressionInt -> f Expression
genExpressionInt Range ExpressionInt
range = Integer -> Expression
ExpressionInt (Integer -> Expression) -> f Integer -> f Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Integer -> f Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (ExpressionInt -> Integer
unExpressionInt (ExpressionInt -> Integer) -> Range ExpressionInt -> Range Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range ExpressionInt
range)

genExpressionString :: MonadGen f => Range SmallLength -> f Expression
genExpressionString :: Range SmallLength -> f Expression
genExpressionString Range SmallLength
rangeLen =
  Text -> Expression
ExpressionString (Text -> Expression) -> f Text -> f Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Range Int -> f Char -> f Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (SmallLength -> Int
unSmallLength (SmallLength -> Int) -> Range SmallLength -> Range Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range SmallLength
rangeLen) f Char
forall (m :: * -> *). MonadGen m => m Char
Gen.unicodeAll)

genExpressionBytes :: MonadGen f => Range Length -> f Expression
genExpressionBytes :: Range Length -> f Expression
genExpressionBytes Range Length
rangeLen = ByteString -> Expression
ExpressionBytes (ByteString -> Expression) -> f ByteString -> f Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> f ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (Length -> Int
unLength (Length -> Int) -> Range Length -> Range Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Length
rangeLen)

genExpressionSeq :: (MonadGen m, GenBase m ~ Identity) => Range SmallLength -> m Expression
genExpressionSeq :: Range SmallLength -> m Expression
genExpressionSeq = ([Expression] -> Expression) -> m [Expression] -> m Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Expression] -> Expression
ExpressionSeq (m [Expression] -> m Expression)
-> (Range SmallLength -> m [Expression])
-> Range SmallLength
-> m Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range SmallLength -> m [Expression]
forall (m :: * -> *).
(MonadGen m, GenBase m ~ Identity) =>
Range SmallLength -> m [Expression]
genSeq

genSeq :: (MonadGen m, GenBase m ~ Identity) => Range SmallLength -> m [Expression]
genSeq :: Range SmallLength -> m [Expression]
genSeq Range SmallLength
rangeLen = Range Int -> m Expression -> m [Expression]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (SmallLength -> Int
unSmallLength (SmallLength -> Int) -> Range SmallLength -> Range Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range SmallLength
rangeLen) m Expression
forall (m :: * -> *).
(MonadGen m, GenBase m ~ Identity) =>
m Expression
genExpression

genExpressionPrim :: (MonadGen m, GenBase m ~ Identity) => m Expression
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

genMichelinePrimAp :: (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
<*> Range SmallLength -> m [Expression]
forall (m :: * -> *).
(MonadGen m, GenBase m ~ Identity) =>
Range SmallLength -> m [Expression]
genSeq Range SmallLength
forall a. Default a => a
def 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 = Range Int -> m Annotation -> m [Annotation]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (SmallLength -> Int
unSmallLength (SmallLength -> Int) -> Range SmallLength -> Range Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range SmallLength
forall a. Default a => a
def) m Annotation
forall (m :: * -> *).
(MonadGen m, GenBase m ~ Identity) =>
m Annotation
genExprAnnotation

genExprAnnotation :: (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