{-# OPTIONS_GHC -fno-warn-orphans #-}

module Language.Futhark.SyntaxTests (tests) where

import Control.Applicative hiding (many, some)
import Data.Bifunctor
import Data.Char (isAlpha)
import Data.Functor
import Data.Map qualified as M
import Data.String
import Data.Text qualified as T
import Data.Void
import Language.Futhark
import Language.Futhark.Parser (SyntaxError (syntaxErrorMsg), parseExp, parseType)
import Language.Futhark.Primitive.Parse (constituent, keyword, lexeme)
import Language.Futhark.PrimitiveTests ()
import Test.QuickCheck
import Test.Tasty
import Text.Megaparsec
import Text.Megaparsec.Char.Lexer qualified as L
import Prelude

tests :: TestTree
tests :: TestTree
tests = TestName -> [TestTree] -> TestTree
testGroup TestName
"Source SyntaxTests" []

instance Arbitrary BinOp where
  arbitrary :: Gen BinOp
arbitrary = [BinOp] -> Gen BinOp
forall a. HasCallStack => [a] -> Gen a
elements [BinOp
forall a. Bounded a => a
minBound .. BinOp
forall a. Bounded a => a
maxBound]

instance Arbitrary Uniqueness where
  arbitrary :: Gen Uniqueness
arbitrary = [Uniqueness] -> Gen Uniqueness
forall a. HasCallStack => [a] -> Gen a
elements [Uniqueness
Unique, Uniqueness
Nonunique]

instance Arbitrary PrimType where
  arbitrary :: Gen PrimType
arbitrary =
    [Gen PrimType] -> Gen PrimType
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ IntType -> PrimType
Signed (IntType -> PrimType) -> Gen IntType -> Gen PrimType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen IntType
forall a. Arbitrary a => Gen a
arbitrary,
        IntType -> PrimType
Unsigned (IntType -> PrimType) -> Gen IntType -> Gen PrimType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen IntType
forall a. Arbitrary a => Gen a
arbitrary,
        FloatType -> PrimType
FloatType (FloatType -> PrimType) -> Gen FloatType -> Gen PrimType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen FloatType
forall a. Arbitrary a => Gen a
arbitrary,
        PrimType -> Gen PrimType
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimType
Bool
      ]

instance Arbitrary PrimValue where
  arbitrary :: Gen PrimValue
arbitrary =
    [Gen PrimValue] -> Gen PrimValue
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ IntValue -> PrimValue
SignedValue (IntValue -> PrimValue) -> Gen IntValue -> Gen PrimValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen IntValue
forall a. Arbitrary a => Gen a
arbitrary,
        IntValue -> PrimValue
UnsignedValue (IntValue -> PrimValue) -> Gen IntValue -> Gen PrimValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen IntValue
forall a. Arbitrary a => Gen a
arbitrary,
        FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> Gen FloatValue -> Gen PrimValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen FloatValue
forall a. Arbitrary a => Gen a
arbitrary,
        Bool -> PrimValue
BoolValue (Bool -> PrimValue) -> Gen Bool -> Gen PrimValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
      ]

-- The following dirty instances make it slightly nicer to write unit tests.

instance IsString VName where
  fromString :: TestName -> VName
fromString TestName
s =
    let (TestName
s', Char
'_' : TestName
tag) = (Char -> Bool) -> TestName -> (TestName, TestName)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_') TestName
s
     in Name -> Int -> VName
VName (TestName -> Name
forall a. IsString a => TestName -> a
fromString TestName
s') (TestName -> Int
forall a. Read a => TestName -> a
read TestName
tag)

instance (IsString v) => IsString (QualName v) where
  fromString :: TestName -> QualName v
fromString = [v] -> v -> QualName v
forall vn. [vn] -> vn -> QualName vn
QualName [] (v -> QualName v) -> (TestName -> v) -> TestName -> QualName v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> v
forall a. IsString a => TestName -> a
fromString

instance IsString UncheckedTypeExp where
  fromString :: TestName -> UncheckedTypeExp
fromString =
    (SyntaxError -> UncheckedTypeExp)
-> (UncheckedTypeExp -> UncheckedTypeExp)
-> Either SyntaxError UncheckedTypeExp
-> UncheckedTypeExp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TestName -> UncheckedTypeExp
forall a. HasCallStack => TestName -> a
error (TestName -> UncheckedTypeExp)
-> (SyntaxError -> TestName) -> SyntaxError -> UncheckedTypeExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TestName
T.unpack (Text -> TestName)
-> (SyntaxError -> Text) -> SyntaxError -> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SyntaxError -> Text
syntaxErrorMsg) UncheckedTypeExp -> UncheckedTypeExp
forall a. a -> a
id
      (Either SyntaxError UncheckedTypeExp -> UncheckedTypeExp)
-> (TestName -> Either SyntaxError UncheckedTypeExp)
-> TestName
-> UncheckedTypeExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Text -> Either SyntaxError UncheckedTypeExp
parseType TestName
"IsString UncheckedTypeExp"
      (Text -> Either SyntaxError UncheckedTypeExp)
-> (TestName -> Text)
-> TestName
-> Either SyntaxError UncheckedTypeExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Text
forall a. IsString a => TestName -> a
fromString

type Parser = Parsec Void T.Text

braces, brackets, parens :: Parser a -> Parser a
braces :: forall a. Parser a -> Parser a
braces = Parsec Void Text Text
-> Parsec Void Text Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Parsec Void Text Text -> Parsec Void Text Text
forall a. Parser a -> Parser a
lexeme Parsec Void Text Text
"{") (Parsec Void Text Text -> Parsec Void Text Text
forall a. Parser a -> Parser a
lexeme Parsec Void Text Text
"}")
brackets :: forall a. Parser a -> Parser a
brackets = Parsec Void Text Text
-> Parsec Void Text Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Parsec Void Text Text -> Parsec Void Text Text
forall a. Parser a -> Parser a
lexeme Parsec Void Text Text
"[") (Parsec Void Text Text -> Parsec Void Text Text
forall a. Parser a -> Parser a
lexeme Parsec Void Text Text
"]")
parens :: forall a. Parser a -> Parser a
parens = Parsec Void Text Text
-> Parsec Void Text Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Parsec Void Text Text -> Parsec Void Text Text
forall a. Parser a -> Parser a
lexeme Parsec Void Text Text
"(") (Parsec Void Text Text -> Parsec Void Text Text
forall a. Parser a -> Parser a
lexeme Parsec Void Text Text
")")

pName :: Parser Name
pName :: Parser Name
pName =
  Parser Name -> Parser Name
forall a. Parser a -> Parser a
lexeme (Parser Name -> Parser Name)
-> (ParsecT Void Text Identity TestName -> Parser Name)
-> ParsecT Void Text Identity TestName
-> Parser Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestName -> Name)
-> ParsecT Void Text Identity TestName -> Parser Name
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TestName -> Name
nameFromString (ParsecT Void Text Identity TestName -> Parser Name)
-> ParsecT Void Text Identity TestName -> Parser Name
forall a b. (a -> b) -> a -> b
$
    (:) (Char -> TestName -> TestName)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (TestName -> TestName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAlpha ParsecT Void Text Identity (TestName -> TestName)
-> ParsecT Void Text Identity TestName
-> ParsecT Void Text Identity TestName
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity TestName
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
constituent)

pVName :: Parser VName
pVName :: Parser VName
pVName = Parser VName -> Parser VName
forall a. Parser a -> Parser a
lexeme (Parser VName -> Parser VName) -> Parser VName -> Parser VName
forall a b. (a -> b) -> a -> b
$ do
  (TestName
s, Int
tag) <-
    (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
constituent
      ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Int
-> ParsecT Void Text Identity (TestName, Int)
forall (m :: * -> *) a end.
MonadPlus m =>
m a -> m end -> m ([a], end)
`manyTill_` ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Int
pTag
      ParsecT Void Text Identity (TestName, Int)
-> TestName -> ParsecT Void Text Identity (TestName, Int)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> TestName -> m a
<?> TestName
"variable name"
  VName -> Parser VName
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VName -> Parser VName) -> VName -> Parser VName
forall a b. (a -> b) -> a -> b
$ Name -> Int -> VName
VName (TestName -> Name
nameFromString TestName
s) Int
tag
  where
    pTag :: ParsecT Void Text Identity Int
pTag =
      Parsec Void Text Text
"_" Parsec Void Text Text
-> ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal ParsecT Void Text Identity Int
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity Int
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
constituent)

pQualName :: Parser (QualName VName)
pQualName :: Parser (QualName VName)
pQualName = [VName] -> VName -> QualName VName
forall vn. [vn] -> vn -> QualName vn
QualName [] (VName -> QualName VName)
-> Parser VName -> Parser (QualName VName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName
pVName

pPrimType :: Parser PrimType
pPrimType :: Parser PrimType
pPrimType =
  [Parser PrimType] -> Parser PrimType
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser PrimType] -> Parser PrimType)
-> [Parser PrimType] -> Parser PrimType
forall a b. (a -> b) -> a -> b
$
    (PrimType -> Parser PrimType) -> [PrimType] -> [Parser PrimType]
forall a b. (a -> b) -> [a] -> [b]
map
      PrimType -> Parser PrimType
forall {b}. Pretty b => b -> ParsecT Void Text Identity b
f
      [ PrimType
Bool,
        IntType -> PrimType
Signed IntType
Int8,
        IntType -> PrimType
Signed IntType
Int16,
        IntType -> PrimType
Signed IntType
Int32,
        IntType -> PrimType
Signed IntType
Int64,
        IntType -> PrimType
Unsigned IntType
Int8,
        IntType -> PrimType
Unsigned IntType
Int16,
        IntType -> PrimType
Unsigned IntType
Int32,
        IntType -> PrimType
Unsigned IntType
Int64,
        FloatType -> PrimType
FloatType FloatType
Float32,
        FloatType -> PrimType
FloatType FloatType
Float64
      ]
  where
    f :: b -> ParsecT Void Text Identity b
f b
t = Text -> ParsecT Void Text Identity ()
keyword (b -> Text
forall a. Pretty a => a -> Text
prettyText b
t) ParsecT Void Text Identity () -> b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
t

pUniqueness :: Parser Uniqueness
pUniqueness :: Parser Uniqueness
pUniqueness = [Parser Uniqueness] -> Parser Uniqueness
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Parsec Void Text Text -> Parsec Void Text Text
forall a. Parser a -> Parser a
lexeme Parsec Void Text Text
"*" Parsec Void Text Text -> Uniqueness -> Parser Uniqueness
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Uniqueness
Unique, Uniqueness -> Parser Uniqueness
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Uniqueness
Nonunique]

pSize :: Parser Size
pSize :: Parser Size
pSize =
  Parser Size -> Parser Size
forall a. Parser a -> Parser a
brackets (Parser Size -> Parser Size) -> Parser Size -> Parser Size
forall a b. (a -> b) -> a -> b
$
    [Parser Size] -> Parser Size
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ (Integer -> SrcLoc -> Size) -> SrcLoc -> Integer -> Size
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> SrcLoc -> Size
sizeFromInteger SrcLoc
forall a. Monoid a => a
mempty (Integer -> Size)
-> ParsecT Void Text Identity Integer -> Parser Size
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Integer
-> ParsecT Void Text Identity Integer
forall a. Parser a -> Parser a
lexeme ParsecT Void Text Identity Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal,
        (QualName VName -> SrcLoc -> Size)
-> SrcLoc -> QualName VName -> Size
forall a b c. (a -> b -> c) -> b -> a -> c
flip QualName VName -> SrcLoc -> Size
sizeFromName SrcLoc
forall a. Monoid a => a
mempty (QualName VName -> Size) -> Parser (QualName VName) -> Parser Size
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (QualName VName)
pQualName
      ]

pScalarNonFun :: Parser (ScalarTypeBase Size Uniqueness)
pScalarNonFun :: Parser (ScalarTypeBase Size Uniqueness)
pScalarNonFun =
  [Parser (ScalarTypeBase Size Uniqueness)]
-> Parser (ScalarTypeBase Size Uniqueness)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ PrimType -> ScalarTypeBase Size Uniqueness
forall dim u. PrimType -> ScalarTypeBase dim u
Prim (PrimType -> ScalarTypeBase Size Uniqueness)
-> Parser PrimType -> Parser (ScalarTypeBase Size Uniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PrimType
pPrimType,
      Parser (ScalarTypeBase Size Uniqueness)
pTypeVar,
      [TypeBase Size Uniqueness] -> ScalarTypeBase Size Uniqueness
forall dim as. [TypeBase dim as] -> ScalarTypeBase dim as
tupleRecord ([TypeBase Size Uniqueness] -> ScalarTypeBase Size Uniqueness)
-> ParsecT Void Text Identity [TypeBase Size Uniqueness]
-> Parser (ScalarTypeBase Size Uniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [TypeBase Size Uniqueness]
-> ParsecT Void Text Identity [TypeBase Size Uniqueness]
forall a. Parser a -> Parser a
parens (Parser (TypeBase Size Uniqueness)
pType Parser (TypeBase Size Uniqueness)
-> Parsec Void Text Text
-> ParsecT Void Text Identity [TypeBase Size Uniqueness]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Parsec Void Text Text -> Parsec Void Text Text
forall a. Parser a -> Parser a
lexeme Parsec Void Text Text
","),
      Map Name (TypeBase Size Uniqueness)
-> ScalarTypeBase Size Uniqueness
forall dim u. Map Name (TypeBase dim u) -> ScalarTypeBase dim u
Record (Map Name (TypeBase Size Uniqueness)
 -> ScalarTypeBase Size Uniqueness)
-> ([(Name, TypeBase Size Uniqueness)]
    -> Map Name (TypeBase Size Uniqueness))
-> [(Name, TypeBase Size Uniqueness)]
-> ScalarTypeBase Size Uniqueness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, TypeBase Size Uniqueness)]
-> Map Name (TypeBase Size Uniqueness)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, TypeBase Size Uniqueness)]
 -> ScalarTypeBase Size Uniqueness)
-> ParsecT Void Text Identity [(Name, TypeBase Size Uniqueness)]
-> Parser (ScalarTypeBase Size Uniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [(Name, TypeBase Size Uniqueness)]
-> ParsecT Void Text Identity [(Name, TypeBase Size Uniqueness)]
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity (Name, TypeBase Size Uniqueness)
pField ParsecT Void Text Identity (Name, TypeBase Size Uniqueness)
-> Parsec Void Text Text
-> ParsecT Void Text Identity [(Name, TypeBase Size Uniqueness)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` Parsec Void Text Text -> Parsec Void Text Text
forall a. Parser a -> Parser a
lexeme Parsec Void Text Text
",")
    ]
  where
    pField :: ParsecT Void Text Identity (Name, TypeBase Size Uniqueness)
pField = (,) (Name
 -> TypeBase Size Uniqueness -> (Name, TypeBase Size Uniqueness))
-> Parser Name
-> ParsecT
     Void
     Text
     Identity
     (TypeBase Size Uniqueness -> (Name, TypeBase Size Uniqueness))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Name
pName ParsecT
  Void
  Text
  Identity
  (TypeBase Size Uniqueness -> (Name, TypeBase Size Uniqueness))
-> Parsec Void Text Text
-> ParsecT
     Void
     Text
     Identity
     (TypeBase Size Uniqueness -> (Name, TypeBase Size Uniqueness))
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text Text -> Parsec Void Text Text
forall a. Parser a -> Parser a
lexeme Parsec Void Text Text
":" ParsecT
  Void
  Text
  Identity
  (TypeBase Size Uniqueness -> (Name, TypeBase Size Uniqueness))
-> Parser (TypeBase Size Uniqueness)
-> ParsecT Void Text Identity (Name, TypeBase Size Uniqueness)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (TypeBase Size Uniqueness)
pType
    pTypeVar :: Parser (ScalarTypeBase Size Uniqueness)
pTypeVar = Uniqueness
-> QualName VName
-> [TypeArg Size]
-> ScalarTypeBase Size Uniqueness
forall dim u.
u -> QualName VName -> [TypeArg dim] -> ScalarTypeBase dim u
TypeVar (Uniqueness
 -> QualName VName
 -> [TypeArg Size]
 -> ScalarTypeBase Size Uniqueness)
-> Parser Uniqueness
-> ParsecT
     Void
     Text
     Identity
     (QualName VName
      -> [TypeArg Size] -> ScalarTypeBase Size Uniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Uniqueness
pUniqueness ParsecT
  Void
  Text
  Identity
  (QualName VName
   -> [TypeArg Size] -> ScalarTypeBase Size Uniqueness)
-> Parser (QualName VName)
-> ParsecT
     Void
     Text
     Identity
     ([TypeArg Size] -> ScalarTypeBase Size Uniqueness)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (QualName VName)
pQualName ParsecT
  Void
  Text
  Identity
  ([TypeArg Size] -> ScalarTypeBase Size Uniqueness)
-> ParsecT Void Text Identity [TypeArg Size]
-> Parser (ScalarTypeBase Size Uniqueness)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (TypeArg Size)
-> ParsecT Void Text Identity [TypeArg Size]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity (TypeArg Size)
pTypeArg
    pTypeArg :: ParsecT Void Text Identity (TypeArg Size)
pTypeArg =
      [ParsecT Void Text Identity (TypeArg Size)]
-> ParsecT Void Text Identity (TypeArg Size)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Size -> TypeArg Size
forall dim. dim -> TypeArg dim
TypeArgDim (Size -> TypeArg Size)
-> Parser Size -> ParsecT Void Text Identity (TypeArg Size)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Size
pSize,
          TypeBase Size NoUniqueness -> TypeArg Size
forall dim. TypeBase dim NoUniqueness -> TypeArg dim
TypeArgType (TypeBase Size NoUniqueness -> TypeArg Size)
-> (TypeBase Size Uniqueness -> TypeBase Size NoUniqueness)
-> TypeBase Size Uniqueness
-> TypeArg Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uniqueness -> NoUniqueness)
-> TypeBase Size Uniqueness -> TypeBase Size NoUniqueness
forall b c a. (b -> c) -> TypeBase a b -> TypeBase a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (NoUniqueness -> Uniqueness -> NoUniqueness
forall a b. a -> b -> a
const NoUniqueness
NoUniqueness) (TypeBase Size Uniqueness -> TypeArg Size)
-> Parser (TypeBase Size Uniqueness)
-> ParsecT Void Text Identity (TypeArg Size)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (TypeBase Size Uniqueness)
pTypeArgType
        ]
    pTypeArgType :: Parser (TypeBase Size Uniqueness)
pTypeArgType =
      [Parser (TypeBase Size Uniqueness)]
-> Parser (TypeBase Size Uniqueness)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ ScalarTypeBase Size Uniqueness -> TypeBase Size Uniqueness
forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (ScalarTypeBase Size Uniqueness -> TypeBase Size Uniqueness)
-> (PrimType -> ScalarTypeBase Size Uniqueness)
-> PrimType
-> TypeBase Size Uniqueness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimType -> ScalarTypeBase Size Uniqueness
forall dim u. PrimType -> ScalarTypeBase dim u
Prim (PrimType -> TypeBase Size Uniqueness)
-> Parser PrimType -> Parser (TypeBase Size Uniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PrimType
pPrimType,
          Parser (TypeBase Size Uniqueness)
-> Parser (TypeBase Size Uniqueness)
forall a. Parser a -> Parser a
parens Parser (TypeBase Size Uniqueness)
pType
        ]

pArrayType :: Parser ResType
pArrayType :: Parser (TypeBase Size Uniqueness)
pArrayType =
  Uniqueness
-> Shape Size
-> ScalarTypeBase Size NoUniqueness
-> TypeBase Size Uniqueness
forall dim u.
u -> Shape dim -> ScalarTypeBase dim NoUniqueness -> TypeBase dim u
Array
    (Uniqueness
 -> Shape Size
 -> ScalarTypeBase Size NoUniqueness
 -> TypeBase Size Uniqueness)
-> Parser Uniqueness
-> ParsecT
     Void
     Text
     Identity
     (Shape Size
      -> ScalarTypeBase Size NoUniqueness -> TypeBase Size Uniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Uniqueness
pUniqueness
    ParsecT
  Void
  Text
  Identity
  (Shape Size
   -> ScalarTypeBase Size NoUniqueness -> TypeBase Size Uniqueness)
-> ParsecT Void Text Identity (Shape Size)
-> ParsecT
     Void
     Text
     Identity
     (ScalarTypeBase Size NoUniqueness -> TypeBase Size Uniqueness)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Size] -> Shape Size
forall dim. [dim] -> Shape dim
Shape ([Size] -> Shape Size)
-> ParsecT Void Text Identity [Size]
-> ParsecT Void Text Identity (Shape Size)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Size -> ParsecT Void Text Identity [Size]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some Parser Size
pSize)
    ParsecT
  Void
  Text
  Identity
  (ScalarTypeBase Size NoUniqueness -> TypeBase Size Uniqueness)
-> ParsecT Void Text Identity (ScalarTypeBase Size NoUniqueness)
-> Parser (TypeBase Size Uniqueness)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Uniqueness -> NoUniqueness)
-> ScalarTypeBase Size Uniqueness
-> ScalarTypeBase Size NoUniqueness
forall b c a. (b -> c) -> ScalarTypeBase a b -> ScalarTypeBase a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (NoUniqueness -> Uniqueness -> NoUniqueness
forall a b. a -> b -> a
const NoUniqueness
NoUniqueness) (ScalarTypeBase Size Uniqueness
 -> ScalarTypeBase Size NoUniqueness)
-> Parser (ScalarTypeBase Size Uniqueness)
-> ParsecT Void Text Identity (ScalarTypeBase Size NoUniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (ScalarTypeBase Size Uniqueness)
pScalarNonFun)

pNonFunType :: Parser ResType
pNonFunType :: Parser (TypeBase Size Uniqueness)
pNonFunType =
  [Parser (TypeBase Size Uniqueness)]
-> Parser (TypeBase Size Uniqueness)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parser (TypeBase Size Uniqueness)
-> Parser (TypeBase Size Uniqueness)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (TypeBase Size Uniqueness)
pArrayType,
      Parser (TypeBase Size Uniqueness)
-> Parser (TypeBase Size Uniqueness)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser (TypeBase Size Uniqueness)
 -> Parser (TypeBase Size Uniqueness))
-> Parser (TypeBase Size Uniqueness)
-> Parser (TypeBase Size Uniqueness)
forall a b. (a -> b) -> a -> b
$ Parser (TypeBase Size Uniqueness)
-> Parser (TypeBase Size Uniqueness)
forall a. Parser a -> Parser a
parens Parser (TypeBase Size Uniqueness)
pType,
      ScalarTypeBase Size Uniqueness -> TypeBase Size Uniqueness
forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (ScalarTypeBase Size Uniqueness -> TypeBase Size Uniqueness)
-> Parser (ScalarTypeBase Size Uniqueness)
-> Parser (TypeBase Size Uniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (ScalarTypeBase Size Uniqueness)
pScalarNonFun
    ]

pScalarType :: Parser (ScalarTypeBase Size Uniqueness)
pScalarType :: Parser (ScalarTypeBase Size Uniqueness)
pScalarType = [Parser (ScalarTypeBase Size Uniqueness)]
-> Parser (ScalarTypeBase Size Uniqueness)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Parser (ScalarTypeBase Size Uniqueness)
-> Parser (ScalarTypeBase Size Uniqueness)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (ScalarTypeBase Size Uniqueness)
pFun, Parser (ScalarTypeBase Size Uniqueness)
pScalarNonFun]
  where
    pFun :: Parser (ScalarTypeBase Size Uniqueness)
pFun =
      ParsecT
  Void
  Text
  Identity
  (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
pParam ParsecT
  Void
  Text
  Identity
  (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
-> Parsec Void Text Text
-> ParsecT
     Void
     Text
     Identity
     (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text Text -> Parsec Void Text Text
forall a. Parser a -> Parser a
lexeme Parsec Void Text Text
"->" ParsecT
  Void
  Text
  Identity
  (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
-> ParsecT Void Text Identity (RetTypeBase Size Uniqueness)
-> Parser (ScalarTypeBase Size Uniqueness)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (RetTypeBase Size Uniqueness)
pRetType
    pParam :: ParsecT
  Void
  Text
  Identity
  (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
pParam =
      [ParsecT
   Void
   Text
   Identity
   (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)]
-> ParsecT
     Void
     Text
     Identity
     (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ ParsecT
  Void
  Text
  Identity
  (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
-> ParsecT
     Void
     Text
     Identity
     (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT
  Void
  Text
  Identity
  (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
pNamedParam,
          do
            TypeBase Size Uniqueness
t <- Parser (TypeBase Size Uniqueness)
pNonFunType
            (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
-> ParsecT
     Void
     Text
     Identity
     (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
 -> ParsecT
      Void
      Text
      Identity
      (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness))
-> (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
-> ParsecT
     Void
     Text
     Identity
     (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
forall a b. (a -> b) -> a -> b
$ Uniqueness
-> PName
-> Diet
-> TypeBase Size NoUniqueness
-> RetTypeBase Size Uniqueness
-> ScalarTypeBase Size Uniqueness
forall dim u.
u
-> PName
-> Diet
-> TypeBase dim NoUniqueness
-> RetTypeBase dim Uniqueness
-> ScalarTypeBase dim u
Arrow Uniqueness
Nonunique PName
Unnamed (TypeBase Size Diet -> Diet
forall shape. TypeBase shape Diet -> Diet
diet (TypeBase Size Diet -> Diet) -> TypeBase Size Diet -> Diet
forall a b. (a -> b) -> a -> b
$ TypeBase Size Uniqueness -> TypeBase Size Diet
resToParam TypeBase Size Uniqueness
t) (TypeBase Size Uniqueness -> TypeBase Size NoUniqueness
forall dim u. TypeBase dim u -> TypeBase dim NoUniqueness
toStruct TypeBase Size Uniqueness
t)
        ]
    pNamedParam :: ParsecT
  Void
  Text
  Identity
  (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
pNamedParam = ParsecT
  Void
  Text
  Identity
  (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
-> ParsecT
     Void
     Text
     Identity
     (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
forall a. Parser a -> Parser a
parens (ParsecT
   Void
   Text
   Identity
   (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
 -> ParsecT
      Void
      Text
      Identity
      (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness))
-> ParsecT
     Void
     Text
     Identity
     (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
-> ParsecT
     Void
     Text
     Identity
     (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
forall a b. (a -> b) -> a -> b
$ do
      VName
v <- Parser VName
pVName Parser VName -> Parsec Void Text Text -> Parser VName
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text Text -> Parsec Void Text Text
forall a. Parser a -> Parser a
lexeme Parsec Void Text Text
":"
      TypeBase Size Uniqueness
t <- Parser (TypeBase Size Uniqueness)
pType
      (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
-> ParsecT
     Void
     Text
     Identity
     (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
 -> ParsecT
      Void
      Text
      Identity
      (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness))
-> (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
-> ParsecT
     Void
     Text
     Identity
     (RetTypeBase Size Uniqueness -> ScalarTypeBase Size Uniqueness)
forall a b. (a -> b) -> a -> b
$ Uniqueness
-> PName
-> Diet
-> TypeBase Size NoUniqueness
-> RetTypeBase Size Uniqueness
-> ScalarTypeBase Size Uniqueness
forall dim u.
u
-> PName
-> Diet
-> TypeBase dim NoUniqueness
-> RetTypeBase dim Uniqueness
-> ScalarTypeBase dim u
Arrow Uniqueness
Nonunique (VName -> PName
Named VName
v) (TypeBase Size Diet -> Diet
forall shape. TypeBase shape Diet -> Diet
diet (TypeBase Size Diet -> Diet) -> TypeBase Size Diet -> Diet
forall a b. (a -> b) -> a -> b
$ TypeBase Size Uniqueness -> TypeBase Size Diet
resToParam TypeBase Size Uniqueness
t) (TypeBase Size Uniqueness -> TypeBase Size NoUniqueness
forall dim u. TypeBase dim u -> TypeBase dim NoUniqueness
toStruct TypeBase Size Uniqueness
t)

pRetType :: Parser ResRetType
pRetType :: ParsecT Void Text Identity (RetTypeBase Size Uniqueness)
pRetType =
  [ParsecT Void Text Identity (RetTypeBase Size Uniqueness)]
-> ParsecT Void Text Identity (RetTypeBase Size Uniqueness)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parsec Void Text Text -> Parsec Void Text Text
forall a. Parser a -> Parser a
lexeme Parsec Void Text Text
"?" Parsec Void Text Text
-> ParsecT Void Text Identity (RetTypeBase Size Uniqueness)
-> ParsecT Void Text Identity (RetTypeBase Size Uniqueness)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([VName] -> TypeBase Size Uniqueness -> RetTypeBase Size Uniqueness
forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType ([VName]
 -> TypeBase Size Uniqueness -> RetTypeBase Size Uniqueness)
-> ParsecT Void Text Identity [VName]
-> ParsecT
     Void
     Text
     Identity
     (TypeBase Size Uniqueness -> RetTypeBase Size Uniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VName -> ParsecT Void Text Identity [VName]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Parser VName -> Parser VName
forall a. Parser a -> Parser a
brackets Parser VName
pVName) ParsecT
  Void
  Text
  Identity
  (TypeBase Size Uniqueness -> RetTypeBase Size Uniqueness)
-> Parsec Void Text Text
-> ParsecT
     Void
     Text
     Identity
     (TypeBase Size Uniqueness -> RetTypeBase Size Uniqueness)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text Text -> Parsec Void Text Text
forall a. Parser a -> Parser a
lexeme Parsec Void Text Text
"." ParsecT
  Void
  Text
  Identity
  (TypeBase Size Uniqueness -> RetTypeBase Size Uniqueness)
-> Parser (TypeBase Size Uniqueness)
-> ParsecT Void Text Identity (RetTypeBase Size Uniqueness)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (TypeBase Size Uniqueness)
pType),
      [VName] -> TypeBase Size Uniqueness -> RetTypeBase Size Uniqueness
forall dim as. [VName] -> TypeBase dim as -> RetTypeBase dim as
RetType [] (TypeBase Size Uniqueness -> RetTypeBase Size Uniqueness)
-> Parser (TypeBase Size Uniqueness)
-> ParsecT Void Text Identity (RetTypeBase Size Uniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (TypeBase Size Uniqueness)
pType
    ]

pType :: Parser ResType
pType :: Parser (TypeBase Size Uniqueness)
pType =
  [Parser (TypeBase Size Uniqueness)]
-> Parser (TypeBase Size Uniqueness)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Parser (TypeBase Size Uniqueness)
-> Parser (TypeBase Size Uniqueness)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser (TypeBase Size Uniqueness)
 -> Parser (TypeBase Size Uniqueness))
-> Parser (TypeBase Size Uniqueness)
-> Parser (TypeBase Size Uniqueness)
forall a b. (a -> b) -> a -> b
$ ScalarTypeBase Size Uniqueness -> TypeBase Size Uniqueness
forall dim u. ScalarTypeBase dim u -> TypeBase dim u
Scalar (ScalarTypeBase Size Uniqueness -> TypeBase Size Uniqueness)
-> Parser (ScalarTypeBase Size Uniqueness)
-> Parser (TypeBase Size Uniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (ScalarTypeBase Size Uniqueness)
pScalarType, Parser (TypeBase Size Uniqueness)
pArrayType, Parser (TypeBase Size Uniqueness)
-> Parser (TypeBase Size Uniqueness)
forall a. Parser a -> Parser a
parens Parser (TypeBase Size Uniqueness)
pType]

fromStringParse :: Parser a -> String -> String -> a
fromStringParse :: forall a. Parser a -> TestName -> TestName -> a
fromStringParse Parser a
p TestName
what TestName
s =
  (ParseErrorBundle Text Void -> a)
-> (a -> a) -> Either (ParseErrorBundle Text Void) a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseErrorBundle Text Void -> a
forall {s} {e} {a}.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> a
onError a -> a
forall a. a -> a
id (Either (ParseErrorBundle Text Void) a -> a)
-> Either (ParseErrorBundle Text Void) a -> a
forall a b. (a -> b) -> a -> b
$ Parser a
-> TestName -> Text -> Either (ParseErrorBundle Text Void) a
forall e s a.
Parsec e s a -> TestName -> s -> Either (ParseErrorBundle s e) a
parse (Parser a
p Parser a -> ParsecT Void Text Identity () -> Parser a
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) TestName
"" (TestName -> Text
T.pack TestName
s)
  where
    onError :: ParseErrorBundle s e -> a
onError ParseErrorBundle s e
e =
      TestName -> a
forall a. HasCallStack => TestName -> a
error (TestName -> a) -> TestName -> a
forall a b. (a -> b) -> a -> b
$ TestName
"not a " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
what TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
": " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
s TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
"\n" TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> ParseErrorBundle s e -> TestName
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> TestName
errorBundlePretty ParseErrorBundle s e
e

instance IsString (ScalarTypeBase Size NoUniqueness) where
  fromString :: TestName -> ScalarTypeBase Size NoUniqueness
fromString =
    ParsecT Void Text Identity (ScalarTypeBase Size NoUniqueness)
-> TestName -> TestName -> ScalarTypeBase Size NoUniqueness
forall a. Parser a -> TestName -> TestName -> a
fromStringParse ((Uniqueness -> NoUniqueness)
-> ScalarTypeBase Size Uniqueness
-> ScalarTypeBase Size NoUniqueness
forall b c a. (b -> c) -> ScalarTypeBase a b -> ScalarTypeBase a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (NoUniqueness -> Uniqueness -> NoUniqueness
forall a b. a -> b -> a
const NoUniqueness
NoUniqueness) (ScalarTypeBase Size Uniqueness
 -> ScalarTypeBase Size NoUniqueness)
-> Parser (ScalarTypeBase Size Uniqueness)
-> ParsecT Void Text Identity (ScalarTypeBase Size NoUniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (ScalarTypeBase Size Uniqueness)
pScalarType) TestName
"ScalarType"

instance IsString StructType where
  fromString :: TestName -> TypeBase Size NoUniqueness
fromString =
    Parser (TypeBase Size NoUniqueness)
-> TestName -> TestName -> TypeBase Size NoUniqueness
forall a. Parser a -> TestName -> TestName -> a
fromStringParse ((Uniqueness -> NoUniqueness)
-> TypeBase Size Uniqueness -> TypeBase Size NoUniqueness
forall b c a. (b -> c) -> TypeBase a b -> TypeBase a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (NoUniqueness -> Uniqueness -> NoUniqueness
forall a b. a -> b -> a
const NoUniqueness
NoUniqueness) (TypeBase Size Uniqueness -> TypeBase Size NoUniqueness)
-> Parser (TypeBase Size Uniqueness)
-> Parser (TypeBase Size NoUniqueness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (TypeBase Size Uniqueness)
pType) TestName
"StructType"

instance IsString StructRetType where
  fromString :: TestName -> StructRetType
fromString =
    Parser StructRetType -> TestName -> TestName -> StructRetType
forall a. Parser a -> TestName -> TestName -> a
fromStringParse ((Uniqueness -> NoUniqueness)
-> RetTypeBase Size Uniqueness -> StructRetType
forall b c a. (b -> c) -> RetTypeBase a b -> RetTypeBase a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (NoUniqueness -> Uniqueness -> NoUniqueness
forall a. a -> Uniqueness -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoUniqueness
NoUniqueness) (RetTypeBase Size Uniqueness -> StructRetType)
-> ParsecT Void Text Identity (RetTypeBase Size Uniqueness)
-> Parser StructRetType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (RetTypeBase Size Uniqueness)
pRetType) TestName
"StructRetType"

instance IsString ResRetType where
  fromString :: TestName -> RetTypeBase Size Uniqueness
fromString = ParsecT Void Text Identity (RetTypeBase Size Uniqueness)
-> TestName -> TestName -> RetTypeBase Size Uniqueness
forall a. Parser a -> TestName -> TestName -> a
fromStringParse ParsecT Void Text Identity (RetTypeBase Size Uniqueness)
pRetType TestName
"ResRetType"

instance IsString UncheckedExp where
  fromString :: TestName -> UncheckedExp
fromString = (SyntaxError -> UncheckedExp)
-> (UncheckedExp -> UncheckedExp)
-> Either SyntaxError UncheckedExp
-> UncheckedExp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TestName -> UncheckedExp
forall a. HasCallStack => TestName -> a
error (TestName -> UncheckedExp)
-> (SyntaxError -> TestName) -> SyntaxError -> UncheckedExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TestName
T.unpack (Text -> TestName)
-> (SyntaxError -> Text) -> SyntaxError -> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SyntaxError -> Text
syntaxErrorMsg) UncheckedExp -> UncheckedExp
forall a. a -> a
id (Either SyntaxError UncheckedExp -> UncheckedExp)
-> (TestName -> Either SyntaxError UncheckedExp)
-> TestName
-> UncheckedExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Text -> Either SyntaxError UncheckedExp
parseExp TestName
"string literal" (Text -> Either SyntaxError UncheckedExp)
-> (TestName -> Text)
-> TestName
-> Either SyntaxError UncheckedExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Text
T.pack