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

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

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

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

import Hedgehog.Range.Defaults

genErrorSrcPos :: MonadGen m => m ErrorSrcPos
genErrorSrcPos :: forall (m :: * -> *). MonadGen m => m ErrorSrcPos
genErrorSrcPos = SrcPos -> ErrorSrcPos
ErrorSrcPos (SrcPos -> ErrorSrcPos) -> m SrcPos -> m ErrorSrcPos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SrcPos
forall (m :: * -> *). MonadGen m => m SrcPos
genSrcPos

genSrcPos :: MonadGen m => m SrcPos
genSrcPos :: forall (m :: * -> *). MonadGen m => m SrcPos
genSrcPos = Pos -> Pos -> SrcPos
SrcPos (Pos -> Pos -> SrcPos) -> m Pos -> m (Pos -> SrcPos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Pos -> m Pos
forall (m :: * -> *). MonadGen m => Range Pos -> m Pos
genPos Range Pos
forall a. Default a => a
def m (Pos -> SrcPos) -> m Pos -> m SrcPos
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Pos -> m Pos
forall (m :: * -> *). MonadGen m => Range Pos -> m Pos
genPos Range Pos
forall a. Default a => a
def

genPos :: MonadGen m => Range.Range Pos -> m Pos
genPos :: forall (m :: * -> *). MonadGen m => Range Pos -> m Pos
genPos Range Pos
range = Word -> Pos
Pos (Word -> Pos) -> m Word -> m Pos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word -> m Word
forall (m :: * -> *). MonadGen m => Range Word -> m Word
Gen.word (Pos -> Word
unPos (Pos -> Word) -> Range Pos -> Range Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Pos
range)

genMText :: MonadGen m => Range.Range Length -> m MText
genMText :: forall (m :: * -> *). MonadGen m => Range Length -> m MText
genMText Range Length
lenRange =
  Either Text MText -> MText
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text MText -> MText)
-> (Text -> Either Text MText) -> Text -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> MText) -> m Text -> m MText
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
    (Length -> Int
unLength (Length -> Int) -> Range Length -> Range Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Length
lenRange)
    (Char -> Char -> m Char
forall (m :: * -> *) a. (MonadGen m, Enum a) => a -> a -> m a
Gen.enum (forall a. Enum a => Int -> a
toEnum @Char Int
minBoundMChar) (forall a. Enum a => Int -> a
toEnum @Char Int
maxBoundMChar))