packages feed

inferno-core-0.1.0.0: test/Parse/Spec.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Parse.Spec where

import Data.Functor.Foldable (ana, project)
import qualified Data.IntMap as IntMap (elems, toList)
import qualified Data.List.NonEmpty as NEList
import Data.Text (Text, pack, unpack)
import qualified Data.Text as Text
import Data.Text.Lazy (toStrict)
-- import Inferno.Module.Prelude (baseOpsTable, builtinModulesOpsTable)
import Inferno.Parse (parseExpr, prettyError)
import Inferno.Types.Syntax
  ( BlockUtils (removeComments),
    Comment (..),
    Expr (..),
    ExtIdent (..),
    Fixity (..),
    IStr (..),
    Ident (Ident),
    ImplExpl (..),
    Import (..),
    InfixFixity (..),
    Lit (..),
    ModuleName (..),
    Pat (..),
    Scoped (..),
    SomeIStr (..),
    TList (..),
    arbitraryName,
    tListFromList,
  )
import Inferno.Utils.Prettyprinter (renderPretty)
import Test.Hspec (Spec, describe, expectationFailure, it, shouldBe)
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck
  ( Arbitrary (..),
    Gen,
    PrintableString (getPrintableString),
    Property,
    Testable (property),
    choose,
    counterexample,
    genericShrink,
    oneof,
    recursivelyShrink,
    shrinkNothing,
    sized,
    suchThat,
    (===),
  )
import Text.Pretty.Simple (pShow)
import Utils (baseOpsTable, builtinModulesOpsTable)

instance Arbitrary a => Arbitrary (Scoped a) where
  arbitrary = oneof $ [pure LocalScope, Scope <$> arbitrary]
  shrink = shrinkNothing

instance Arbitrary InfixFixity where
  arbitrary = oneof $ map pure [NoFix, LeftFix, RightFix]
  shrink = shrinkNothing

instance Arbitrary Lit where
  arbitrary =
    oneof
      [ LInt <$> arbitrary,
        LDouble <$> arbitrary,
        (LText . pack . getPrintableString) <$> arbitrary,
        LHex <$> arbitrary
      ]

instance Arbitrary ImplExpl where
  shrink = shrinkNothing
  arbitrary =
    oneof
      [ Impl <$> arbitrary,
        Expl <$> arbitrary
      ]

instance Arbitrary (Import ()) where
  shrink = shrinkNothing
  arbitrary =
    oneof
      [ IVar () <$> arbitrary,
        IOpVar () <$> arbitrary,
        IEnum () () <$> arbitrary
      ]

instance Arbitrary (Comment ()) where
  shrink = shrinkNothing
  arbitrary =
    oneof
      [ (\x -> LineComment () x ()) <$> (pack . getPrintableString <$> arbitrary) `suchThat` (Text.all $ \c -> c /= '\n' && c /= '\r'),
        (\x -> BlockComment () x ()) <$> (pack . getPrintableString <$> arbitrary) `suchThat` (Text.all $ \c -> c /= '*') -- prevent having a '*/'
      ]

instance Arbitrary a => Arbitrary (SomeIStr a) where
  arbitrary = sized $ \n -> do
    k <- choose (0, n)
    oneof [SomeIStr <$> goT k, SomeIStr <$> goF k]
    where
      goT :: Int -> Gen (IStr 'True a)
      goT = \case
        0 -> pure ISEmpty
        n -> oneof [ISExpr <$> arbitrary <*> goT (n -1), ISExpr <$> arbitrary <*> goF (n -1)]

      goF :: Int -> Gen (IStr 'False a)
      goF = \case
        0 -> ISStr <$> arbitrary <*> pure ISEmpty
        n -> ISStr <$> arbitrary <*> goT (n -1)

  shrink (SomeIStr ISEmpty) = []
  shrink (SomeIStr (ISStr s xs)) =
    -- shrink to subterms
    [SomeIStr xs]
      ++
      -- recursively shrink subterms
      [ case xs' of
          SomeIStr (ISStr _ _) -> xs'
          SomeIStr r@(ISExpr _ _) -> SomeIStr $ ISStr s r
          SomeIStr r@ISEmpty -> SomeIStr $ ISStr s r
        | xs' <- shrink (SomeIStr xs)
      ]
  shrink (SomeIStr (ISExpr e xs)) =
    [SomeIStr xs]
      ++ [SomeIStr (ISExpr e' xs) | e' <- shrink e]
      ++
      -- recursively shrink subterms
      [SomeIStr (ISExpr e' xs') | (e', SomeIStr xs') <- shrink (e, SomeIStr xs)]

instance Arbitrary (Pat () ()) where
  arbitrary = sized arbitrarySizedPat
  shrink = recursivelyShrink

arbitrarySizedPat :: Int -> Gen (Pat () ())
arbitrarySizedPat n =
  oneof
    [ pure $ PVar () Nothing,
      PVar () . Just <$> arbitrary,
      PEnum () () LocalScope <$> arbitrary,
      PLit () <$> arbitrary,
      POne () <$> arbitrarySizedPat n,
      pure $ PEmpty (),
      PCommentAbove <$> arbitrary <*> arbitrarySizedPat (n `div` 3),
      PCommentAfter <$> arbitrarySizedPat (n `div` 3) <*> arbitrary,
      PCommentBelow <$> arbitrarySizedPat (n `div` 3) <*> arbitrary,
      (\xs -> PTuple () (tListFromList xs) ()) <$> do
        k <- choose (0, n)
        sequence [(,Nothing) <$> arbitrarySizedPat (n `div` 3) | _ <- [1 .. k]]
        `suchThat` (\xs -> length xs /= 1)
    ]

instance Arbitrary e => Arbitrary (NEList.NonEmpty e) where
  arbitrary = NEList.fromList <$> (arbitrary `suchThat` (not . null))
  shrink = genericShrink

instance Arbitrary (Expr () ()) where
  shrink = recursivelyShrink
  arbitrary = sized arbitrarySized
    where
      -- Don't generate implicit variables, because parser does not support them
      arbitraryExtIdent = ExtIdent <$> Right <$> arbitraryName
      arbitraryImplExpl = oneof [Impl <$> arbitraryExtIdent, Expl <$> arbitraryExtIdent]
      arbitraryVar =
        oneof
          [ Var () () LocalScope <$> arbitraryImplExpl,
            OpVar () () LocalScope . Ident
              <$> ( oneof $
                      concatMap
                        ( \case
                            (InfixOp _, _, op) -> [pure op]
                            _ -> []
                        )
                        $ concat $ IntMap.elems baseOpsTable
                  )
          ]
      arbitraryEnum = Enum () () LocalScope <$> arbitrary
      arbitraryLit = Lit () <$> arbitrary

      arbitraryApp n =
        App
          <$> (arbitrarySized $ n `div` 3)
          <*> (arbitrarySized $ n `div` 3)

      arbitraryLam n =
        (\vs e -> Lam () vs () e)
          <$> arbitraryLamVars <*> (arbitrarySized $ n `div` 3)
        where
          -- Don't generate implicit vars. Sorry, there must be a nicer way to do this
          arbitraryLamVars :: Gen (NEList.NonEmpty ((), Maybe ExtIdent))
          arbitraryLamVars = arbitrary `suchThat` (all isSomeRight . snd . NEList.unzip)
          isSomeRight (Just (ExtIdent (Right _))) = True
          isSomeRight _ = False

      arbitraryLet n =
        (\v e1 e2 -> Let () () v () e1 () e2)
          <$> arbitraryImplExpl <*> (arbitrarySized $ n `div` 3) <*> (arbitrarySized $ n `div` 3)

      arbitraryIString n =
        (\xs -> InterpolatedString () xs ())
          <$> do
            k <- choose (0, n)
            oneof [SomeIStr <$> goT k, SomeIStr <$> goF k]
        where
          goT :: Int -> Gen (IStr 'True ((), Expr () (), ()))
          goT = \case
            0 -> pure ISEmpty
            m ->
              oneof
                [ ISExpr <$> ((\x -> ((), x, ())) <$> (arbitrarySized $ n `div` 3)) <*> goT (m -1),
                  ISExpr <$> ((\x -> ((), x, ())) <$> (arbitrarySized $ n `div` 3)) <*> goF (m -1)
                ]

          goF :: Int -> Gen (IStr 'False ((), Expr () (), ()))
          goF = \case
            0 ->
              ISStr
                <$> ( (pack . getPrintableString <$> arbitrary)
                        `suchThat` (\x -> not (Text.null x) && Text.all (\c -> c /= '\\' && c /= '$' && c /= '`') x)
                    )
                <*> pure ISEmpty
            m ->
              ISStr
                <$> ( (pack . getPrintableString <$> arbitrary)
                        `suchThat` (\x -> not (Text.null x) && Text.all (\c -> c /= '\\' && c /= '$' && c /= '`') x)
                    )
                <*> goT (m -1)

      arbitraryIf n =
        (\c t f -> If () c () t () f)
          <$> (arbitrarySized $ n `div` 3) <*> (arbitrarySized $ n `div` 3) <*> (arbitrarySized $ n `div` 3)

      arbitraryAssert n =
        (\c e -> Assert () c () e)
          <$> (arbitrarySized $ n `div` 3) <*> (arbitrarySized $ n `div` 3)

      arbitraryOp n =
        (\(prec, fix, op) e1 e2 -> Op e1 () () (prec, fix) LocalScope (Ident op) e2)
          <$> ( oneof $
                  map pure $
                    concatMap
                      ( \(prec, xs) ->
                          concatMap
                            ( \case
                                (InfixOp fix, _, op) -> [(prec, fix, op)]
                                _ -> []
                            )
                            xs
                      )
                      $ IntMap.toList baseOpsTable
              )
          <*> (arbitrarySized $ n `div` 3)
          <*> (arbitrarySized $ n `div` 3)

      arbitraryPreOp n =
        (\(prec, op) e -> PreOp () () prec LocalScope (Ident op) e)
          <$> ( oneof $
                  map pure $
                    concatMap
                      ( \(prec, xs) ->
                          concatMap
                            ( \case
                                (PrefixOp, _, op) -> [(prec, op)]
                                _ -> []
                            )
                            xs
                      )
                      $ IntMap.toList baseOpsTable
              )
          <*> (arbitrarySized $ n `div` 3)

      arbitraryCase n =
        (\e cs -> Case () e () (NEList.fromList cs) ())
          <$> (arbitrarySized $ n `div` 3)
          <*> do
            k <- choose (0, n)
            sequence
              [ (\i e -> ((), i, (), e))
                  <$> arbitrarySizedPat (n `div` 3) <*> arbitrarySized (n `div` 3)
                | _ <- [1 .. k]
              ]
            `suchThat` (not . null)

      arbitraryBracketed n = (\e -> Bracketed () e ()) <$> arbitrarySized (n `div` 3)
      arbitrarySized 0 =
        oneof
          [ arbitraryVar,
            arbitraryEnum,
            arbitraryLit,
            pure $ Empty ()
          ]
      arbitrarySized n =
        oneof
          [ arbitraryVar,
            arbitraryEnum,
            arbitraryLit,
            arbitraryApp n,
            arbitraryLam n,
            arbitraryLet n,
            arbitraryIString n,
            arbitraryIf n,
            arbitraryOp n,
            arbitraryPreOp n,
            (\xs -> Array () xs ())
              <$> ( do
                      k <- choose (0, n)
                      sequence [(,Nothing) <$> arbitrarySized (n `div` 3) | _ <- [1 .. k]]
                  ),
            One () <$> arbitrarySized (n `div` 3),
            pure $ Empty (),
            arbitraryAssert n,
            arbitraryCase n,
            (\e xs c -> ArrayComp () e () (NEList.fromList [((), x, (), e', Nothing) | (x, e') <- xs]) c ())
              <$> (arbitrarySized $ n `div` 3)
              <*> do
                k <- choose (0, n)
                sequence [(,) <$> arbitrary <*> arbitrarySized (n `div` 3) | _ <- [1 .. k]]
                `suchThat` (not . null)
              <*> oneof [Just . ((),) <$> (arbitrarySized $ n `div` 3), pure Nothing],
            arbitraryBracketed n,
            CommentAbove <$> arbitrary <*> arbitrarySized (n `div` 3),
            CommentAfter <$> arbitrarySized (n `div` 3) <*> arbitrary,
            CommentBelow <$> arbitrarySized (n `div` 3) <*> arbitrary
          ]

normalizePat :: Pat h a -> Pat h a
normalizePat = ana $ \case
  PTuple p1 xs p2 -> project $ PTuple p1 (fmap (\(e, _) -> (normalizePat e, Nothing)) xs) p2
  x -> project x

normalizeExpr :: Expr h a -> Expr h a
normalizeExpr = ana $ \case
  PreOp pos hsh prec LocalScope (Ident "-") e -> case normalizeExpr e of
    Lit l' (LInt x) -> project $ Lit l' $ LInt $ - x
    Lit l' (LDouble x) -> project $ Lit l' $ LDouble $ - x
    PreOp _ _ _ LocalScope (Ident "-") e' -> project $ e'
    e' -> project $ PreOp pos hsh prec LocalScope (Ident "-") e'
  Tuple p1 xs p2 -> project $ Tuple p1 (fmap (\(e, _) -> (normalizeExpr e, Nothing)) xs) p2
  Array p1 xs p2 -> project $ Array p1 (fmap (\(e, _) -> (normalizeExpr e, Nothing)) xs) p2
  ArrayComp p1 e_body p2 args e_cond p3 ->
    project $
      ArrayComp
        p1
        (normalizeExpr e_body)
        p2
        (fmap (\(p4, x, p5, e, _) -> (p4, x, p5, normalizeExpr e, Nothing)) args)
        (fmap (\(p4, e) -> (p4, normalizeExpr e)) e_cond)
        p3
  Bracketed _ e _ -> project $ normalizeExpr e
  Op e1 p1 h (_, fix) modNm i e2 -> project $ Op (normalizeExpr e1) p1 h (0, fix) modNm i (normalizeExpr e2)
  Case p1 e_case p2 patExprs p3 -> project $ Case p1 (normalizeExpr e_case) p2 (fmap (\(p4, p, p5, e) -> (p4, normalizePat p, p5, normalizeExpr e)) patExprs) p3
  x -> project x

(<?>) :: (Testable p) => p -> Text -> Property
(<?>) = flip (counterexample . unpack)

infixl 2 <?>

parsingTests :: Spec
parsingTests = describe "pretty printing/parsing" $ do
  prop "parseExpr and pretty are inverse up to normalizeExpr" $
    \(x :: Expr () ()) -> case parseExpr baseOpsTable builtinModulesOpsTable (renderPretty x) of
      Left err ->
        property False
          <?> ( "Pretty: \n" <> (renderPretty x)
                  <> "\nParse error:\n"
                  <> (pack $ prettyError $ fst $ NEList.head err)
              )
      Right (res, _comments) ->
        (normalizeExpr (removeComments x) === normalizeExpr (fmap (const ()) res))
          <?> ( "Pretty: \n" <> (renderPretty x)
                  <> "\nParsed: \n"
                  <> (toStrict $ pShow res)
                  <> "\nParsed pretty: \n"
                  <> (renderPretty res)
              )

  describe "parsing literals" $ do
    shouldSucceedFor "0" $ Lit () (LInt 0)
    shouldSucceedFor "0.0" $ Lit () (LDouble 0)
    shouldSucceedFor "3" $ Lit () (LInt 3)
    shouldSucceedFor "3.1415" $ Lit () (LDouble 3.1415)
    shouldSucceedFor "0xff" $ Lit () (LHex 255)
    shouldSucceedFor "0Xff" $ Lit () (LHex 255)
    shouldSucceedFor "0xFf" $ Lit () (LHex 255)
    shouldSucceedFor "0XFF" $ Lit () (LHex 255)
    shouldSucceedFor "0x123456789abcdef" $ Lit () (LHex 81985529216486895)
    shouldFailFor "0x3.14"
    shouldSucceedFor "\"0XFF\"" $ Lit () (LText "0XFF")
    shouldSucceedFor "\"0X\\nFF\"" $ Lit () (LText "0X\nFF")
    shouldSucceedFor "\"0X\\\\nFF\"" $ Lit () (LText "0X\\nFF")
    shouldFailFor "\"0X\nFF\""

  describe "parsing interpolated strings" $ do
    shouldSucceedFor "``" $ InterpolatedString () (SomeIStr $ ISEmpty) ()
    shouldSucceedFor "`hello\nworld`" $ InterpolatedString () (SomeIStr (ISStr "hello\nworld" ISEmpty)) ()
    shouldSucceedFor "`${1}`" $ InterpolatedString () (SomeIStr (ISExpr ((), Lit () (LInt 1), ()) ISEmpty)) ()
    shouldSucceedFor "`hello\nworld${1}`" $ InterpolatedString () (SomeIStr (ISStr "hello\nworld" (ISExpr ((), Lit () (LInt 1), ()) ISEmpty))) ()
    shouldSucceedFor "`hello\nworld${\"!\"}`" $ InterpolatedString () (SomeIStr (ISStr "hello\nworld" (ISExpr ((), Lit () (LText "!"), ()) ISEmpty))) ()
    shouldSucceedFor "`hello\nworld${`I am ${\"nested\"}`}`" $
      InterpolatedString () (SomeIStr (ISStr "hello\nworld" (ISExpr ((), InterpolatedString () (SomeIStr (ISStr "I am " (ISExpr ((), Lit () (LText "nested"), ()) ISEmpty))) (), ()) ISEmpty))) ()
    shouldFailFor "`hello\nworld${}`"

  describe "parsing negation" $ do
    shouldSucceedFor "-3" $ PreOp () () 19 LocalScope (Ident "-") (Lit () (LInt 3))
    shouldSucceedFor "(-3)" $ Bracketed () (PreOp () () 19 LocalScope (Ident "-") (Lit () (LInt 3))) ()
    shouldFailFor "--3"
    shouldSucceedFor "-x" $ PreOp () () 19 LocalScope (Ident "-") (Var () () LocalScope (Expl (ExtIdent $ Right "x")))
    shouldSucceedFor "(-(-x))" $ Bracketed () (PreOp () () 19 LocalScope (Ident "-") (Bracketed () (PreOp () () 19 LocalScope (Ident "-") (Var () () LocalScope (Expl (ExtIdent $ Right "x")))) ())) ()
    shouldSucceedFor "5+(-3)" $ Op (Lit () (LInt 5)) () () (9, LeftFix) LocalScope (Ident "+") (Bracketed () (PreOp () () 19 LocalScope (Ident "-") (Lit () (LInt 3))) ())
    shouldSucceedFor "5+-3" $ Op (Lit () (LInt 5)) () () (9, LeftFix) LocalScope (Ident "+") (PreOp () () 19 LocalScope (Ident "-") (Lit () (LInt 3)))
    shouldSucceedFor "-3+5" $ Op (PreOp () () 19 LocalScope (Ident "-") (Lit () (LInt 3))) () () (9, LeftFix) LocalScope (Ident "+") (Lit () (LInt 5))
    shouldSucceedFor "(-3)+5" $ Op (Bracketed () (PreOp () () 19 LocalScope (Ident "-") (Lit () (LInt 3))) ()) () () (9, LeftFix) LocalScope (Ident "+") (Lit () (LInt 5))

  describe "parsing variables" $ do
    shouldSucceedFor "x" $ Var () () LocalScope (Expl (ExtIdent $ Right "x"))
    shouldSucceedFor "A.x" $ Var () () (Scope (ModuleName "A")) (Expl (ExtIdent $ Right "x"))
    shouldSucceedFor "x127652" $ Var () () LocalScope (Expl (ExtIdent $ Right "x127652"))
    shouldSucceedFor "X12aaAA" $ Var () () LocalScope (Expl (ExtIdent $ Right "X12aaAA"))
    shouldSucceedFor "X_12aaAA" $ Var () () LocalScope (Expl (ExtIdent $ Right "X_12aaAA"))
    shouldSucceedFor "X__" $ Var () () LocalScope (Expl (ExtIdent $ Right "X__"))
    shouldFailFor "_x"
    shouldFailFor "let _ = () in ()"
    shouldFailFor "let _x = () in ()"
    shouldSucceedFor "fun _x -> ()" $ Lam () (((), Nothing) NEList.:| []) () (Tuple () TNil ())

  describe "parsing implicit variables" $ do
    let letImpl x = Let () () (Impl (ExtIdent $ Right x)) () (Tuple () TNil ()) () (Tuple () TNil ())
    shouldSucceedFor "let ?X__ = () in ()" $ letImpl "X__"
    shouldSucceedFor "let ?x = () in ()" $ letImpl "x"
    shouldSucceedFor "let ?x_y = () in ()" $ letImpl "x_y"
    shouldFailFor "let ?_ = () in ()"
    shouldFailFor "let ?x-y = () in ()"

  describe "parsing tuples" $ do
    shouldSucceedFor "()" $ Tuple () TNil ()
    shouldSucceedFor "(None, None)" $ Tuple () (TCons (Empty (), Just ()) (Empty (), Nothing) []) ()
    shouldSucceedFor "(None)" $ Bracketed () (Empty ()) ()

  describe "parsing arrays" $ do
    shouldSucceedFor "[]" $ Array () [] ()
    shouldSucceedFor "[None, None]" $ Array () [(Empty (), Just ()), (Empty (), Nothing)] ()

  describe "parsing infix operators" $ do
    shouldSucceedFor "2*3+7/2" $
      Op
        (Op (Lit () (LInt 2)) () () (10, LeftFix) LocalScope (Ident "*") (Lit () (LInt 3)))
        ()
        ()
        (9, LeftFix)
        LocalScope
        (Ident "+")
        (Op (Lit () (LInt 7)) () () (10, LeftFix) LocalScope (Ident "/") (Lit () (LInt 2)))
    shouldSucceedFor "2*(3+7)/2" $
      Op
        ( Op
            (Lit () (LInt 2))
            ()
            ()
            (10, LeftFix)
            LocalScope
            (Ident "*")
            (Bracketed () (Op (Lit () (LInt 3)) () () (9, LeftFix) LocalScope (Ident "+") (Lit () (LInt 7))) ())
        )
        ()
        ()
        (10, LeftFix)
        LocalScope
        (Ident "/")
        (Lit () (LInt 2))
    shouldSucceedFor "2*3*4" $
      Op
        (Op (Lit () (LInt 2)) () () (10, LeftFix) LocalScope (Ident "*") (Lit () (LInt 3)))
        ()
        ()
        (10, LeftFix)
        LocalScope
        (Ident "*")
        (Lit () (LInt 4))
    -- should this parse or should <,<=,>,>= be the same precedence level as == ?
    shouldSucceedFor "2>3==3<2" $
      Op
        (Op (Lit () (LInt 2)) () () (7, NoFix) LocalScope (Ident ">") (Lit () (LInt 3)))
        ()
        ()
        (6, NoFix)
        LocalScope
        (Ident "==")
        (Op (Lit () (LInt 3)) () () (7, NoFix) LocalScope (Ident "<") (Lit () (LInt 2)))
    shouldFailFor "2==3==4"

  describe "parsing case statements" $ do
    shouldFailFor "match () with {}"
    shouldSucceedFor "match () with { () -> ()}" $ Case () (Tuple () TNil ()) () (((), PTuple () TNil (), (), Tuple () TNil ()) NEList.:| []) ()
    shouldSucceedFor "match () with { | () -> ()}" $ Case () (Tuple () TNil ()) () (((), PTuple () TNil (), (), Tuple () TNil ()) NEList.:| []) ()

  describe "parsing assertions" $ do
    shouldFailFor "assert #false"
    shouldSucceedFor "assert #false in ()" $ Assert () (Enum () () LocalScope (Ident "false")) () (Tuple () TNil ())

  describe "parsing array builder" $ do
    shouldSucceedFor "[() | x <- someList]" $
      ArrayComp
        ()
        (Tuple () TNil ())
        ()
        (((), Ident "x", (), Var () () LocalScope (Expl (ExtIdent $ Right "someList")), Nothing) NEList.:| [])
        Nothing
        ()
    shouldSucceedFor "[(x,y) | x <- someList, y <- otherList]" $
      ArrayComp
        ()
        (Tuple () (TCons (Var () () LocalScope (Expl (ExtIdent $ Right "x")), Just ()) (Var () () LocalScope (Expl (ExtIdent $ Right "y")), Nothing) []) ())
        ()
        (((), Ident "x", (), Var () () LocalScope (Expl (ExtIdent $ Right "someList")), Just ()) NEList.:| [((), Ident "y", (), Var () () LocalScope (Expl (ExtIdent $ Right "otherList")), Nothing)])
        Nothing
        ()
    shouldSucceedFor "[2*x | x <- someList, if x > 10]" $
      ArrayComp
        ()
        (Op (Lit () (LInt 2)) () () (10, LeftFix) LocalScope (Ident "*") (Var () () LocalScope (Expl (ExtIdent $ Right "x"))))
        ()
        (((), Ident "x", (), Var () () LocalScope (Expl (ExtIdent $ Right "someList")), Just ()) NEList.:| [])
        (Just ((), Op (Var () () LocalScope (Expl (ExtIdent $ Right "x"))) () () (7, NoFix) LocalScope (Ident ">") (Lit () (LInt 10))))
        ()
    shouldFailFor "[() | if x > 10]"
  where
    shouldSucceedFor str ast =
      it ("should succeed for \"" <> unpack str <> "\"") $
        case parseExpr baseOpsTable builtinModulesOpsTable str of
          Left err -> expectationFailure $ "Failed with: " <> (prettyError $ fst $ NEList.head err)
          Right (res, _) -> fmap (const ()) res `shouldBe` ast
    shouldFailFor str =
      it ("should fail for \"" <> unpack str <> "\"") $
        case parseExpr baseOpsTable builtinModulesOpsTable str of
          Left _err -> pure ()
          Right _res -> expectationFailure $ "This should not parse"