-- editorconfig-checker-disable-file
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}

-- | UPLC property tests (pretty-printing\/parsing and binary encoding\/decoding).
module Generators.Spec where

import PlutusPrelude (display, fold, void, (&&&))

import Control.Lens (view)
import Data.Text (Text)
import Data.Text qualified as T
import Flat (flat, unflat)
import Generators.Lib (TextualProgram (..), genProgram)
import Hedgehog (annotate, annotateShow, failure, property, tripping, (===))
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified as Range
import PlutusCore (Name)
import PlutusCore.Annotation (SrcSpan (..))
import PlutusCore.Default (DefaultFun, DefaultUni)
import PlutusCore.Error (ParserErrorBundle)
import PlutusCore.Generators.Hedgehog (forAllPretty)
import PlutusCore.Generators.Hedgehog.AST (runAstGen)
import PlutusCore.Parser (defaultUni, parseGen)
import PlutusCore.Pretty (displayPlc)
import PlutusCore.Quote (runQuoteT)
import PlutusCore.Test (isSerialisable)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.Hedgehog (testPropertyNamed)
import Test.Tasty.HUnit (testCase, (@?=))
import UntypedPlutusCore (Program)
import UntypedPlutusCore qualified as UPLC
import UntypedPlutusCore.Core.Type (progTerm, termAnn)
import UntypedPlutusCore.Generators.Hedgehog (discardIfAnyConstant)
import UntypedPlutusCore.Parser (parseProgram, parseTerm)

propFlat :: TestTree
propFlat :: TestTree
propFlat = [Char] -> PropertyName -> Property -> TestTree
testPropertyNamed [Char]
"Flat" PropertyName
"Flat" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
    Program Name DefaultUni DefaultFun ()
prog <- Gen (Program Name DefaultUni DefaultFun ())
-> PropertyT IO (Program Name DefaultUni DefaultFun ())
forall (m :: * -> *) a.
(Monad m, Pretty a) =>
Gen a -> PropertyT m a
forAllPretty (Gen (Program Name DefaultUni DefaultFun ())
 -> PropertyT IO (Program Name DefaultUni DefaultFun ()))
-> (AstGen (Program Name DefaultUni DefaultFun ())
    -> Gen (Program Name DefaultUni DefaultFun ()))
-> AstGen (Program Name DefaultUni DefaultFun ())
-> PropertyT IO (Program Name DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AstGen (Program Name DefaultUni DefaultFun ())
-> Gen (Program Name DefaultUni DefaultFun ())
forall (m :: * -> *) a. MonadGen m => AstGen a -> m a
runAstGen (AstGen (Program Name DefaultUni DefaultFun ())
 -> PropertyT IO (Program Name DefaultUni DefaultFun ()))
-> AstGen (Program Name DefaultUni DefaultFun ())
-> PropertyT IO (Program Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$
        (Some (ValueOf DefaultUni) -> Bool)
-> AstGen (Program Name DefaultUni DefaultFun ())
-> AstGen (Program Name DefaultUni DefaultFun ())
forall (m :: * -> *) (uni :: * -> *) name fun ann.
MonadGen m =>
(Some (ValueOf uni) -> Bool)
-> m (Program name uni fun ann) -> m (Program name uni fun ann)
discardIfAnyConstant (Bool -> Bool
not (Bool -> Bool)
-> (Some (ValueOf DefaultUni) -> Bool)
-> Some (ValueOf DefaultUni)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Some (ValueOf DefaultUni) -> Bool
isSerialisable) (AstGen (Program Name DefaultUni DefaultFun ())
 -> AstGen (Program Name DefaultUni DefaultFun ()))
-> AstGen (Program Name DefaultUni DefaultFun ())
-> AstGen (Program Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ forall fun.
(Bounded fun, Enum fun) =>
AstGen (Program Name DefaultUni fun ())
genProgram @DefaultFun
    Program Name DefaultUni DefaultFun ()
-> (Program Name DefaultUni DefaultFun () -> ByteString)
-> (ByteString
    -> Either DecodeException (Program Name DefaultUni DefaultFun ()))
-> PropertyT IO ()
forall (m :: * -> *) (f :: * -> *) b a.
(MonadTest m, Applicative f, Show b, Show (f a), Eq (f a),
 HasCallStack) =>
a -> (a -> b) -> (b -> f a) -> m ()
tripping Program Name DefaultUni DefaultFun ()
prog (UnrestrictedProgram Name DefaultUni DefaultFun () -> ByteString
forall a. Flat a => a -> ByteString
flat (UnrestrictedProgram Name DefaultUni DefaultFun () -> ByteString)
-> (Program Name DefaultUni DefaultFun ()
    -> UnrestrictedProgram Name DefaultUni DefaultFun ())
-> Program Name DefaultUni DefaultFun ()
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program Name DefaultUni DefaultFun ()
-> UnrestrictedProgram Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
Program name uni fun ann -> UnrestrictedProgram name uni fun ann
UPLC.UnrestrictedProgram) ((UnrestrictedProgram Name DefaultUni DefaultFun ()
 -> Program Name DefaultUni DefaultFun ())
-> Either
     DecodeException (UnrestrictedProgram Name DefaultUni DefaultFun ())
-> Either DecodeException (Program Name DefaultUni DefaultFun ())
forall a b.
(a -> b) -> Either DecodeException a -> Either DecodeException b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnrestrictedProgram Name DefaultUni DefaultFun ()
-> Program Name DefaultUni DefaultFun ()
forall name (uni :: * -> *) fun ann.
UnrestrictedProgram name uni fun ann -> Program name uni fun ann
UPLC.unUnrestrictedProgram (Either
   DecodeException (UnrestrictedProgram Name DefaultUni DefaultFun ())
 -> Either DecodeException (Program Name DefaultUni DefaultFun ()))
-> (ByteString
    -> Either
         DecodeException
         (UnrestrictedProgram Name DefaultUni DefaultFun ()))
-> ByteString
-> Either DecodeException (Program Name DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Either
     DecodeException (UnrestrictedProgram Name DefaultUni DefaultFun ())
forall a b. (Flat a, AsByteString b) => b -> Decoded a
unflat)

propParser :: TestTree
propParser :: TestTree
propParser = [Char] -> PropertyName -> Property -> TestTree
testPropertyNamed [Char]
"Parser" PropertyName
"parser" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
    TextualProgram ()
prog <- Program Name DefaultUni DefaultFun () -> TextualProgram ()
forall a. Program Name DefaultUni DefaultFun a -> TextualProgram a
TextualProgram (Program Name DefaultUni DefaultFun () -> TextualProgram ())
-> PropertyT IO (Program Name DefaultUni DefaultFun ())
-> PropertyT IO (TextualProgram ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Gen (Program Name DefaultUni DefaultFun ())
-> PropertyT IO (Program Name DefaultUni DefaultFun ())
forall (m :: * -> *) a.
(Monad m, Pretty a) =>
Gen a -> PropertyT m a
forAllPretty (AstGen (Program Name DefaultUni DefaultFun ())
-> Gen (Program Name DefaultUni DefaultFun ())
forall (m :: * -> *) a. MonadGen m => AstGen a -> m a
runAstGen (AstGen (Program Name DefaultUni DefaultFun ())
 -> Gen (Program Name DefaultUni DefaultFun ()))
-> AstGen (Program Name DefaultUni DefaultFun ())
-> Gen (Program Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ (Some (ValueOf DefaultUni) -> Bool)
-> AstGen (Program Name DefaultUni DefaultFun ())
-> AstGen (Program Name DefaultUni DefaultFun ())
forall (m :: * -> *) (uni :: * -> *) name fun ann.
MonadGen m =>
(Some (ValueOf uni) -> Bool)
-> m (Program name uni fun ann) -> m (Program name uni fun ann)
discardIfAnyConstant (Bool -> Bool
not (Bool -> Bool)
-> (Some (ValueOf DefaultUni) -> Bool)
-> Some (ValueOf DefaultUni)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Some (ValueOf DefaultUni) -> Bool
isSerialisable) AstGen (Program Name DefaultUni DefaultFun ())
forall fun.
(Bounded fun, Enum fun) =>
AstGen (Program Name DefaultUni fun ())
genProgram)
    TextualProgram ()
-> (TextualProgram () -> Text)
-> (Text -> Either ParserErrorBundle (TextualProgram ()))
-> PropertyT IO ()
forall (m :: * -> *) (f :: * -> *) b a.
(MonadTest m, Applicative f, Show b, Show (f a), Eq (f a),
 HasCallStack) =>
a -> (a -> b) -> (b -> f a) -> m ()
tripping TextualProgram ()
prog (Program Name DefaultUni DefaultFun () -> Text
forall a str. (PrettyPlc a, Render str) => a -> str
displayPlc (Program Name DefaultUni DefaultFun () -> Text)
-> (TextualProgram () -> Program Name DefaultUni DefaultFun ())
-> TextualProgram ()
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextualProgram () -> Program Name DefaultUni DefaultFun ()
forall a. TextualProgram a -> Program Name DefaultUni DefaultFun a
unTextualProgram)
                (\Text
p -> (Program Name DefaultUni DefaultFun SrcSpan -> TextualProgram ())
-> Either
     ParserErrorBundle (Program Name DefaultUni DefaultFun SrcSpan)
-> Either ParserErrorBundle (TextualProgram ())
forall a b.
(a -> b)
-> Either ParserErrorBundle a -> Either ParserErrorBundle b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Program Name DefaultUni DefaultFun () -> TextualProgram ()
forall a. Program Name DefaultUni DefaultFun a -> TextualProgram a
TextualProgram (Program Name DefaultUni DefaultFun () -> TextualProgram ())
-> (Program Name DefaultUni DefaultFun SrcSpan
    -> Program Name DefaultUni DefaultFun ())
-> Program Name DefaultUni DefaultFun SrcSpan
-> TextualProgram ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program Name DefaultUni DefaultFun SrcSpan
-> Program Name DefaultUni DefaultFun ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void) (Text
-> Either
     ParserErrorBundle (Program Name DefaultUni DefaultFun SrcSpan)
parseProg Text
p))
    where
        parseProg
            :: T.Text -> Either ParserErrorBundle (Program Name DefaultUni DefaultFun SrcSpan)
        parseProg :: Text
-> Either
     ParserErrorBundle (Program Name DefaultUni DefaultFun SrcSpan)
parseProg = QuoteT
  (Either ParserErrorBundle)
  (Program Name DefaultUni DefaultFun SrcSpan)
-> Either
     ParserErrorBundle (Program Name DefaultUni DefaultFun SrcSpan)
forall (m :: * -> *) a. Monad m => QuoteT m a -> m a
runQuoteT (QuoteT
   (Either ParserErrorBundle)
   (Program Name DefaultUni DefaultFun SrcSpan)
 -> Either
      ParserErrorBundle (Program Name DefaultUni DefaultFun SrcSpan))
-> (Text
    -> QuoteT
         (Either ParserErrorBundle)
         (Program Name DefaultUni DefaultFun SrcSpan))
-> Text
-> Either
     ParserErrorBundle (Program Name DefaultUni DefaultFun SrcSpan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> QuoteT
     (Either ParserErrorBundle)
     (Program Name DefaultUni DefaultFun SrcSpan)
forall (m :: * -> *).
(MonadError ParserErrorBundle m, MonadQuote m) =>
Text -> m (Program Name DefaultUni DefaultFun SrcSpan)
parseProgram

-- | The `SrcSpan` of a parsed `Term` should not including trailing whitespaces.
propTermSrcSpan :: TestTree
propTermSrcSpan :: TestTree
propTermSrcSpan = [Char] -> PropertyName -> Property -> TestTree
testPropertyNamed
    [Char]
"parser captures ending positions correctly"
    PropertyName
"propTermSrcSpan"
    (Property -> TestTree)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property
    (PropertyT IO () -> TestTree) -> PropertyT IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        Text
code <- Term Name DefaultUni DefaultFun () -> Text
forall str a. (Pretty a, Render str) => a -> str
display (Term Name DefaultUni DefaultFun () -> Text)
-> PropertyT IO (Term Name DefaultUni DefaultFun ())
-> PropertyT IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Gen (Term Name DefaultUni DefaultFun ())
-> PropertyT IO (Term Name DefaultUni DefaultFun ())
forall (m :: * -> *) a.
(Monad m, Pretty a) =>
Gen a -> PropertyT m a
forAllPretty (Getting
  (Term Name DefaultUni DefaultFun ())
  (Program Name DefaultUni DefaultFun ())
  (Term Name DefaultUni DefaultFun ())
-> Program Name DefaultUni DefaultFun ()
-> Term Name DefaultUni DefaultFun ()
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Term Name DefaultUni DefaultFun ())
  (Program Name DefaultUni DefaultFun ())
  (Term Name DefaultUni DefaultFun ())
forall name1 (uni1 :: * -> *) fun1 ann name2 (uni2 :: * -> *) fun2
       (f :: * -> *).
Functor f =>
(Term name1 uni1 fun1 ann -> f (Term name2 uni2 fun2 ann))
-> Program name1 uni1 fun1 ann -> f (Program name2 uni2 fun2 ann)
progTerm (Program Name DefaultUni DefaultFun ()
 -> Term Name DefaultUni DefaultFun ())
-> Gen (Program Name DefaultUni DefaultFun ())
-> Gen (Term Name DefaultUni DefaultFun ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                AstGen (Program Name DefaultUni DefaultFun ())
-> Gen (Program Name DefaultUni DefaultFun ())
forall (m :: * -> *) a. MonadGen m => AstGen a -> m a
runAstGen ((Some (ValueOf DefaultUni) -> Bool)
-> AstGen (Program Name DefaultUni DefaultFun ())
-> AstGen (Program Name DefaultUni DefaultFun ())
forall (m :: * -> *) (uni :: * -> *) name fun ann.
MonadGen m =>
(Some (ValueOf uni) -> Bool)
-> m (Program name uni fun ann) -> m (Program name uni fun ann)
discardIfAnyConstant (Bool -> Bool
not (Bool -> Bool)
-> (Some (ValueOf DefaultUni) -> Bool)
-> Some (ValueOf DefaultUni)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Some (ValueOf DefaultUni) -> Bool
isSerialisable)
                    (forall fun.
(Bounded fun, Enum fun) =>
AstGen (Program Name DefaultUni fun ())
genProgram @DefaultFun)))
        Text -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Show a, HasCallStack) =>
a -> m ()
annotateShow Text
code
        let (Int
endingLine, Int
endingCol) = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> ([Text] -> Int) -> [Text] -> (Int, Int)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Text -> Int
T.length (Text -> Int) -> ([Text] -> Text) -> [Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. HasCallStack => [a] -> a
last ([Text] -> (Int, Int)) -> [Text] -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
code
        Text
trailingSpaces <- Gen Text -> PropertyT IO Text
forall (m :: * -> *) a.
(Monad m, Pretty a) =>
Gen a -> PropertyT m a
forAllPretty (Gen Text -> PropertyT IO Text) -> Gen Text -> PropertyT IO Text
forall a b. (a -> b) -> a -> b
$ Range Int -> GenT Identity Char -> Gen 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) ([Char] -> GenT Identity Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadGen m) =>
f a -> m a
Gen.element [Char
' ', Char
'\n'])
        case QuoteT (Either ParserErrorBundle) PTerm
-> Either ParserErrorBundle PTerm
forall (m :: * -> *) a. Monad m => QuoteT m a -> m a
runQuoteT (QuoteT (Either ParserErrorBundle) PTerm
 -> Either ParserErrorBundle PTerm)
-> (Text -> QuoteT (Either ParserErrorBundle) PTerm)
-> Text
-> Either ParserErrorBundle PTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> QuoteT (Either ParserErrorBundle) PTerm
forall (m :: * -> *).
(MonadError ParserErrorBundle m, MonadQuote m) =>
Text -> m PTerm
parseTerm (Text -> Either ParserErrorBundle PTerm)
-> Text -> Either ParserErrorBundle PTerm
forall a b. (a -> b) -> a -> b
$ Text
code Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
trailingSpaces of
            Right PTerm
parsed ->
                let sp :: SrcSpan
sp = PTerm -> SrcSpan
forall name (uni :: * -> *) fun ann. Term name uni fun ann -> ann
termAnn PTerm
parsed
                 in (SrcSpan -> Int
srcSpanELine SrcSpan
sp, SrcSpan -> Int
srcSpanECol SrcSpan
sp) (Int, Int) -> (Int, Int) -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== (Int
endingLine, Int
endingCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            Left ParserErrorBundle
err -> [Char] -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => [Char] -> m ()
annotate (ParserErrorBundle -> [Char]
forall str a. (Pretty a, Render str) => a -> str
display ParserErrorBundle
err) PropertyT IO () -> PropertyT IO () -> PropertyT IO ()
forall a b. PropertyT IO a -> PropertyT IO b -> PropertyT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PropertyT IO ()
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a
failure

propUnit :: TestTree
propUnit :: TestTree
propUnit = [Char] -> Assertion -> TestTree
testCase [Char]
"Unit" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ [Assertion] -> Assertion
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ [Char] -> Text
pTerm [Char]
"(con bool True)"
        Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"(con bool True)"
    , [Char] -> Text
pTerm [Char]
"(con (list bool) [True, False])"
        Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"(con (list bool) [True,False])"
    , [Char] -> Text
pTerm [Char]
"(con (pair unit (list integer)) ((),[1,2,3]))"
        Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"(con (pair unit (list integer)) ((), [1,2,3]))"
    , [Char] -> Text
pTerm [Char]
"(con (list (pair string bool)) [(\"abc\", True), (\"def\", False)])"
        Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"(con (list (pair string bool)) [(\"abc\", True), (\"def\", False)])"
    , [Char] -> Text
pTerm [Char]
"(con string \"abc\")"
        Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"(con string \"abc\")"
    ]
    where
        pTerm :: String -> Text
        pTerm :: [Char] -> Text
pTerm
            = (ParserErrorBundle -> Text)
-> (PTerm -> Text) -> Either ParserErrorBundle PTerm -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text)
-> (ParserErrorBundle -> [Char]) -> ParserErrorBundle -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserErrorBundle -> [Char]
forall str a. (Pretty a, Render str) => a -> str
display) PTerm -> Text
forall str a. (Pretty a, Render str) => a -> str
display
            (Either ParserErrorBundle PTerm -> Text)
-> ([Char] -> Either ParserErrorBundle PTerm) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuoteT (Either ParserErrorBundle) PTerm
-> Either ParserErrorBundle PTerm
forall (m :: * -> *) a. Monad m => QuoteT m a -> m a
runQuoteT
            (QuoteT (Either ParserErrorBundle) PTerm
 -> Either ParserErrorBundle PTerm)
-> ([Char] -> QuoteT (Either ParserErrorBundle) PTerm)
-> [Char]
-> Either ParserErrorBundle PTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> QuoteT (Either ParserErrorBundle) PTerm
forall (m :: * -> *).
(MonadError ParserErrorBundle m, MonadQuote m) =>
Text -> m PTerm
parseTerm
            (Text -> QuoteT (Either ParserErrorBundle) PTerm)
-> ([Char] -> Text)
-> [Char]
-> QuoteT (Either ParserErrorBundle) PTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

propDefaultUni :: TestTree
propDefaultUni :: TestTree
propDefaultUni = [Char] -> Assertion -> TestTree
testCase [Char]
"DefaultUni" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ [Assertion] -> Assertion
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ [Char] -> Text
pDefaultUni [Char]
"bool" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"bool"
    , [Char] -> Text
pDefaultUni [Char]
"list" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"list"
    , [Char] -> Text
pDefaultUni [Char]
"(list integer)" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"(list integer)"
    , [Char] -> Text
pDefaultUni [Char]
"(pair (list bool))" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"(pair (list bool))"
    , [Char] -> Text
pDefaultUni [Char]
"(pair (list unit) integer)" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"(pair (list unit) integer)"
    , [Char] -> Text
pDefaultUni [Char]
"(list (pair unit integer))" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"(list (pair unit integer))"
    , [Char] -> Text
pDefaultUni [Char]
"(pair unit (pair bool integer))" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"(pair unit (pair bool integer))"
    ]
    where
        pDefaultUni :: String -> Text
        pDefaultUni :: [Char] -> Text
pDefaultUni
            = (ParserErrorBundle -> Text)
-> (SomeTypeIn (Kinded DefaultUni) -> Text)
-> Either ParserErrorBundle (SomeTypeIn (Kinded DefaultUni))
-> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text)
-> (ParserErrorBundle -> [Char]) -> ParserErrorBundle -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserErrorBundle -> [Char]
forall str a. (Pretty a, Render str) => a -> str
display) SomeTypeIn (Kinded DefaultUni) -> Text
forall str a. (Pretty a, Render str) => a -> str
display
            (Either ParserErrorBundle (SomeTypeIn (Kinded DefaultUni)) -> Text)
-> ([Char]
    -> Either ParserErrorBundle (SomeTypeIn (Kinded DefaultUni)))
-> [Char]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuoteT (Either ParserErrorBundle) (SomeTypeIn (Kinded DefaultUni))
-> Either ParserErrorBundle (SomeTypeIn (Kinded DefaultUni))
forall (m :: * -> *) a. Monad m => QuoteT m a -> m a
runQuoteT
            (QuoteT (Either ParserErrorBundle) (SomeTypeIn (Kinded DefaultUni))
 -> Either ParserErrorBundle (SomeTypeIn (Kinded DefaultUni)))
-> ([Char]
    -> QuoteT
         (Either ParserErrorBundle) (SomeTypeIn (Kinded DefaultUni)))
-> [Char]
-> Either ParserErrorBundle (SomeTypeIn (Kinded DefaultUni))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (SomeTypeIn (Kinded DefaultUni))
-> Text
-> QuoteT
     (Either ParserErrorBundle) (SomeTypeIn (Kinded DefaultUni))
forall (m :: * -> *) a.
(MonadError ParserErrorBundle m, MonadQuote m) =>
Parser a -> Text -> m a
parseGen Parser (SomeTypeIn (Kinded DefaultUni))
defaultUni
            (Text
 -> QuoteT
      (Either ParserErrorBundle) (SomeTypeIn (Kinded DefaultUni)))
-> ([Char] -> Text)
-> [Char]
-> QuoteT
     (Either ParserErrorBundle) (SomeTypeIn (Kinded DefaultUni))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

test_parsing :: TestTree
test_parsing :: TestTree
test_parsing = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Parsing"
               [ TestTree
propFlat
               , TestTree
propParser
               , TestTree
propTermSrcSpan
               , TestTree
propUnit
               , TestTree
propDefaultUni
               ]