fix parsing tests, make let-binding names unqualified

elara.cabal

@@ -149,7 +149,7 @@ test-suite elara-test
       DeriveFunctor
       TypeApplications
       QuasiQuotes
-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Wredundant-constraints -Wunused-imports -Wunused-foralls -Wmissing-fields -Winaccessible-code -Wincomplete-record-updates -Wpartial-fields -Werror=missing-home-modules -Widentities -Wmonomorphism-restriction -fplugin=Polysemy.Plugin -optP-Wno-nonportable-include-path -feager-blackholing -threaded -O0 -feager-blackholing
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Wredundant-constraints -Wunused-imports -Wunused-foralls -Wmissing-fields -Winaccessible-code -Wincomplete-record-updates -Wpartial-fields -Werror=missing-home-modules -Widentities -Wmonomorphism-restriction -fplugin=Polysemy.Plugin -optP-Wno-nonportable-include-path -feager-blackholing -threaded -O0
   build-depends:
       HUnit
     , QuickCheck

package.yaml

@@ -83,7 +83,6 @@ tests:
     ghc-options: 
     - -threaded
     - -O0
-    - -feager-blackholing
     dependencies:
       - elara
       - neat-interpolation

source.elr

@@ -11,4 +11,4 @@ let y =  \sk ->
             then
               ()
             else
-              K)
+              3)

src/Elara/AST/Annotated.hs

@@ -3,7 +3,7 @@
 module Elara.AST.Annotated where
 
 import Control.Lens (makePrisms)
-import Elara.AST.Name (Name (NOpName, NVarName), OpName, Qualified, TypeName, VarName)
+import Elara.AST.Name (Name (NOpName, NVarName), OpName, Qualified, TypeName, Unqualified, VarName)
 import Elara.AST.Region (Located (Located))
 import Prelude hiding (Op, Type)
 
@@ -27,8 +27,8 @@ data Expr'
     | If Expr Expr Expr
     | BinaryOperator BinaryOperator Expr Expr
     | List [Expr]
-    | LetIn (Located (Qualified VarName)) Expr Expr
-    | Let (Located (Qualified VarName)) Expr
+    | LetIn (Located (Unqualified VarName)) Expr Expr
+    | Let (Located (Unqualified VarName)) Expr
     | Block (NonEmpty Expr)
     | InParens Expr
     deriving (Show, Eq)

src/Elara/AST/Frontend.hs

@@ -3,7 +3,7 @@
 module Elara.AST.Frontend where
 
 import Control.Lens.TH
-import Elara.AST.Name (MaybeQualified, Name, OpName, TypeName, VarName)
+import Elara.AST.Name (MaybeQualified, Name, OpName, TypeName, VarName, Unqualified)
 import Elara.AST.Region (Located)
 import Prelude hiding (Type)
 
@@ -21,8 +21,8 @@ data Expr'
   | If Expr Expr Expr
   | BinaryOperator BinaryOperator Expr Expr
   | List [Expr]
-  | LetIn (Located (MaybeQualified VarName)) [Pattern] Expr Expr
-  | Let (Located (MaybeQualified VarName)) [Pattern] Expr
+  | LetIn (Located (Unqualified VarName)) [Pattern] Expr Expr
+  | Let (Located (Unqualified VarName)) [Pattern] Expr
   | Block (NonEmpty Expr)
   | InParens Expr
   deriving (Show, Eq)
@@ -59,5 +59,6 @@ data Type
   | UserDefinedType (Located (MaybeQualified TypeName))
   deriving (Show, Eq)
 
+
 makePrisms ''Expr
 makePrisms ''Pattern

src/Elara/AST/Frontend/Pretty/Unlocated.hs

@@ -1,7 +1,8 @@
 module Elara.AST.Frontend.Pretty.Unlocated (prettyPrint) where
 
+import Control.Lens ((^.))
 import Elara.AST.Frontend.Unlocated
-import Elara.AST.Name (MaybeQualified (..), ModuleName (ModuleName), OpName (OpName), TypeName (TypeName), VarName (..))
+import Elara.AST.Name (HasName (name), MaybeQualified (..), ModuleName (ModuleName), OpName (OpName), TypeName (TypeName), Unqualified, VarName (..))
 import Text.PrettyPrint
 import Text.PrettyPrint qualified as PP
 import Prelude hiding (Op, length, (<>))
@@ -53,6 +54,9 @@ instance {-# OVERLAPPABLE #-} Pretty x => Pretty (MaybeQualified x) where
     ppr p (MaybeQualified n (Just m)) = ppr p m <> "." <> ppr p n
     ppr p (MaybeQualified n Nothing) = ppr p n
 
+instance {-# OVERLAPPABLE #-} Pretty x => Pretty (Unqualified x) where
+    ppr p uq = ppr p (uq ^. name)
+
 instance Pretty ModuleName where
     ppr _ (ModuleName m) = PP.hcat (PP.punctuate "." (fmap (PP.text . toString) (toList m)))
 

src/Elara/AST/Frontend/Unlocated.hs

@@ -1,6 +1,6 @@
 module Elara.AST.Frontend.Unlocated where
 
-import Elara.AST.Name (MaybeQualified, Name, OpName, TypeName, VarName)
+import Elara.AST.Name (MaybeQualified, Name, OpName, TypeName, VarName, Unqualified)
 import Prelude hiding (Op, Type)
 
 {- | Frontend AST without location information.
@@ -20,8 +20,8 @@ data Expr
     | If Expr Expr Expr
     | BinaryOperator BinaryOperator Expr Expr
     | List [Expr]
-    | LetIn (MaybeQualified VarName) [Pattern] Expr Expr
-    | Let (MaybeQualified VarName) [Pattern] Expr
+    | LetIn (Unqualified VarName) [Pattern] Expr Expr
+    | Let (Unqualified VarName) [Pattern] Expr
     | Block (NonEmpty Expr)
     | InParens Expr
     deriving (Show, Eq)

src/Elara/AST/Name.hs

@@ -8,20 +8,9 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-module Elara.AST.Name (
-    ModuleName (..),
-    VarName (..),
-    TypeName (..),
-    OpName (..),
-    Name (..),
-    NameLike (..),
-    ToName (..),
-    MaybeQualified (..),
-    Unqualified (..),
-    Qualified (..),
-) where
-
-import Control.Lens (makeClassy, makeLenses, makePrisms, view)
+module Elara.AST.Name where
+
+import Control.Lens (makeClassy, makeFields, makeLenses, makePrisms, view)
 import Data.Data (Data)
 import Data.Text qualified as T (intercalate)
 import Elara.AST.Region (Located, _Unlocate)
@@ -136,20 +125,21 @@ instance NameLike n => NameLike (Located n) where
     moduleName = moduleName . view _Unlocate
 
 data MaybeQualified name = MaybeQualified
-    { _maybeQualifiedNameName :: name
-    , _maybeQualifiedNameQualifier :: Maybe ModuleName
+    { _maybeQualifiedName :: name
+    , _maybeQualifiedQualifier :: Maybe ModuleName
     }
     deriving (Ord, Show, Eq, Data, Functor, Foldable, Traversable)
 
 data Qualified name = Qualified
-    { _qualifiedNameName :: name
-    , _qualifiedNameQualifier :: ModuleName
+    { _qualifiedName :: name
+    , _qualifiedQualifier :: ModuleName
     }
     deriving (Show, Eq, Data, Ord, Functor, Foldable, Traversable)
 newtype Unqualified name = Unqualified
-    { _unqualifiedNameName :: name
+    { _unqualifiedName :: name
     }
     deriving (Show, Eq, Data, Ord, Functor, Foldable, Traversable)
 
-makeClassy ''MaybeQualified
-makeClassy ''Qualified
+makeFields ''MaybeQualified
+makeFields ''Qualified
+makeFields ''Unqualified

src/Elara/Annotate.hs

@@ -174,18 +174,16 @@ annotateModule thisModule = traverseOf (_Module . _Unlocate) (const annotate) th
         pure (Annotated.BinaryOperator annotatedOp annotatedLeft annotatedRight)
     annotateExpr' (Frontend.List xs) = Annotated.List <$> traverse annotateExpr xs
     annotateExpr' (Frontend.LetIn lName lPats lExp lBody) = do
-        annotatedName <- qualifyInThisModule lName
         annotatedPats <- traverse annotatePattern lPats
         annotatedExp <- annotateExpr lExp
         annotatedBody <- annotateExpr lBody
         let lambdaExp = unfoldLambda annotatedPats annotatedExp
-        pure (Annotated.LetIn annotatedName lambdaExp annotatedBody)
+        pure (Annotated.LetIn lName lambdaExp annotatedBody)
     annotateExpr' (Frontend.Let lName lPats lExp) = do
-        annotatedName <- qualifyInThisModule lName
         annotatedPats <- traverse annotatePattern lPats
         annotatedExp <- annotateExpr lExp
         let lambdaExp = unfoldLambda annotatedPats annotatedExp
-        pure (Annotated.Let annotatedName lambdaExp)
+        pure (Annotated.Let lName lambdaExp)
     annotateExpr' (Frontend.Block exprs) = do
         annotatedExprs <- traverse annotateExpr exprs
         pure (Annotated.Block annotatedExprs)

src/Elara/Parse/Expression.hs

@@ -4,12 +4,12 @@ import Control.Monad.Combinators.Expr (Operator (..), makeExprParser)
 import Data.Set qualified as Set
 import Elara.AST.Frontend (Expr (..))
 import Elara.AST.Frontend qualified as Frontend
-import Elara.AST.Name (MaybeQualified (..), VarName, nameText)
+import Elara.AST.Name (MaybeQualified (..), Unqualified, VarName, nameText)
 import Elara.AST.Region (Located (..), enclosingRegion, getLocation)
 import Elara.Parse.Error
 import Elara.Parse.Indents (blockAt, optionallyIndented, sub1, withCurrentIndentOrNormal, withIndentOrNormal)
 import Elara.Parse.Literal (charLiteral, floatLiteral, integerLiteral, stringLiteral)
-import Elara.Parse.Names (opName, typeName, varName)
+import Elara.Parse.Names (maybeQualified, opName, typeName, unqualifiedVarName, varName)
 import Elara.Parse.Pattern (pattern')
 import Elara.Parse.Primitives (HParser, IsParser (fromParsec), char', inParens, lexeme, located, sc, symbol, withPredicate, (<??>))
 import HeadedMegaparsec (endHead)
@@ -62,7 +62,7 @@ operator :: HParser Frontend.BinaryOperator
 operator = Frontend.MkBinaryOperator <$> (asciiOp <|> infixOp) <??> "operator"
   where
     asciiOp = located $ do
-        Frontend.Op <$> located opName
+        Frontend.Op <$> located (maybeQualified opName)
     infixOp = located $ lexeme $ do
         char' '`'
         endHead
@@ -156,12 +156,11 @@ ifElse = locatedExpr $ do
     start <- sub1 <$> fromParsec indentLevel
     symbol "if"
     endHead
-    afterIf <- fromParsec indentLevel
-    (_, condition) <- blockAt afterIf element
-    (afterThen, _) <- withIndentOrNormal start (symbol "then")
-    (_, thenBranch) <- blockAt afterThen element
-    (afterElse, _) <- withIndentOrNormal start (symbol "else")
-    (_, elseBranch) <- blockAt afterElse element
+    (_, condition) <- blockAt start element
+    _ <- withIndentOrNormal start (symbol "then")
+    (_, thenBranch) <- blockAt start element
+    _ <- withIndentOrNormal start (symbol "else")
+    (_, elseBranch) <- blockAt start element
 
     pure (Frontend.If condition thenBranch elseBranch)
 
@@ -185,13 +184,13 @@ letInExpression = locatedExpr $ do
     -- let promote = fmap (transform (Name.promoteArguments names))
     pure (Frontend.LetIn name patterns e body)
 
-letPreamble :: HParser (Pos, Located (MaybeQualified VarName), [Frontend.Pattern], Expr)
+letPreamble :: HParser (Pos, Located (Unqualified VarName), [Frontend.Pattern], Expr)
 letPreamble = do
     start <- fromParsec indentLevel
     symbol "let"
     H.endHead
     afterLet <- fromParsec indentLevel
-    name <- lexeme $ located varName
+    name <- lexeme $ located unqualifiedVarName
     (_, patterns) <- withCurrentIndentOrNormal $ do
         sepBy (lexeme pattern') sc
     _ <- withIndentOrNormal afterLet (symbol "=")

src/Elara/Parse/Module.hs

@@ -5,7 +5,7 @@ import Elara.AST.Name
 import Elara.AST.Region
 import Elara.AST.Select
 import Elara.Parse.Declaration (declaration)
-import Elara.Parse.Names (opName, varName)
+import Elara.Parse.Names (maybeQualified, opName, varName)
 import Elara.Parse.Names qualified as Parse (moduleName)
 import Elara.Parse.Primitives
 import HeadedMegaparsec (endHead)
@@ -52,7 +52,7 @@ exposition = exposedValue <|> exposedOp
   where
     exposedValue, exposedOp :: HParser (Exposition Frontend)
     exposedValue = ExposedValue <$> located varName
-    exposedOp = ExposedOp <$> located (inParens opName)
+    exposedOp = ExposedOp <$> located (inParens (maybeQualified opName))
 
 import' :: HParser (Import Frontend)
 import' = fmapLocated Import $ do

src/Elara/Parse/Names.hs

@@ -1,7 +1,8 @@
 module Elara.Parse.Names where
 
+import Control.Lens ((^.))
 import Data.Set (member)
-import Elara.AST.Name (MaybeQualified (..), ModuleName (..), OpName (..), TypeName (..), VarName (..))
+import Elara.AST.Name (HasName (..), MaybeQualified (..), ModuleName (..), OpName (..), TypeName (..), Unqualified (Unqualified), VarName (..))
 import Elara.Parse.Combinators (sepBy1')
 import Elara.Parse.Primitives (HParser, char', inParens, lexeme, (<??>))
 import HeadedMegaparsec (endHead)
@@ -12,11 +13,20 @@ import Text.Megaparsec.Char (alphaNumChar, char, lowerChar, upperChar)
 varName :: HParser (MaybeQualified VarName)
 varName = operatorVarName <|> normalVarName
 
+unqualifiedVarName :: HParser (Unqualified VarName)
+unqualifiedVarName = unqualifiedOperatorVarName <|> unqualifiedNormalVarName
+
 normalVarName :: HParser (MaybeQualified VarName)
-normalVarName = maybeQualified (NormalVarName <$> alphaVarName) <??> "variable name"
+normalVarName = maybeQualified $ (^. name) <$> unqualifiedNormalVarName <??> "variable name"
+
+unqualifiedNormalVarName :: HParser (Unqualified VarName)
+unqualifiedNormalVarName = Unqualified . NormalVarName <$> alphaVarName <??> "variable name"
 
 operatorVarName :: HParser (MaybeQualified VarName)
-operatorVarName = (OperatorVarName <<$>> inParens opName) <??> "operator name in parens"
+operatorVarName = (OperatorVarName <<$>> inParens (maybeQualified opName)) <??> "operator name in parens"
+
+unqualifiedOperatorVarName :: HParser (Unqualified VarName)
+unqualifiedOperatorVarName = (Unqualified . OperatorVarName <$> inParens opName) <??> "operator name in parens"
 
 typeName :: HParser (MaybeQualified TypeName)
 typeName = do
@@ -52,8 +62,8 @@ alphaVarName =
     rest <- H.parse (many alphaNumChar)
     pure (start : rest)
 
-opName :: HParser (MaybeQualified OpName)
-opName = maybeQualified $ OpName . toText <$> lexeme (some operatorChar)
+opName :: HParser OpName
+opName = OpName . toText <$> lexeme (some operatorChar)
  where
   operatorChars :: Set Char
   operatorChars = ['!', '#', '$', '%', '&', '*', '+', '.', '/', '\\', '<', '>', '=', '?', '@', '^', '|', '-', '~']

test/AST/Module/Inspection.hs

@@ -38,7 +38,7 @@ mainTest = do
             import Quux qualified
         the context would be
     -}
-    let quux = makeModule "Quux" [Declaration' "Quux" (makeMQName NVarName "quux" Nothing) (DeclarationBody $ (Value (Int 0) [] Nothing))] []
+    let quux = makeModule "Quux" [Declaration' "Quux" (makeMQName NVarName "quux" Nothing) (DeclarationBody $ Value (Int 0) [] Nothing)] []
     let bar = makeModule "Bar" [Declaration' "Bar" (makeMQName NVarName "bar" Nothing) (DeclarationBody $ Value (Int 0) [] Nothing)] []
     let fooBar = makeModule "Foo" [Declaration' "Foo" (makeMQName NVarName "fooBar" Nothing) (DeclarationBody $ Value (Int 0) [] Nothing)] []
     let baz = makeModule "Baz" [

test/Orphans.hs

@@ -7,7 +7,7 @@ module Orphans where
 import Data.Char (isLower, isUpper)
 import Data.Text (splitOn)
 
-import Elara.AST.Name (MaybeQualified (..), ModuleName (..), Name (NOpName, NTypeName, NVarName), OpName (..), TypeName (..), VarName (..))
+import Elara.AST.Name (MaybeQualified (..), ModuleName (..), Name (NOpName, NTypeName, NVarName), OpName (..), TypeName (..), Unqualified (..), VarName (..))
 
 instance IsString VarName where
     fromString = NormalVarName . fromString
@@ -28,6 +28,9 @@ instance IsString Name where
 instance IsString s => IsString (MaybeQualified s) where
     fromString s = MaybeQualified (fromString s) Nothing
 
+instance IsString s => IsString (Unqualified s) where
+    fromString s = Unqualified (fromString s)
+
 instance IsString ModuleName where
     -- oh boy i love having 2 string types
     fromString s = ModuleName $ fromList (fromString . toString <$> splitOn (fromString ".") (fromString s))

test/Parse/Common.hs

@@ -2,16 +2,13 @@ module Parse.Common where
 
 import Control.Lens
 import Elara.AST.Frontend.StripLocation
-import Elara.AST.Frontend.Unlocated
-import Elara.AST.Module (Declaration (..), Declaration', Module)
+import Elara.AST.Module (Declaration (..), Declaration')
 import Elara.AST.Module qualified as Mod
 import Elara.AST.Name
-import Elara.AST.Region
 import Elara.AST.Select
 import Elara.Parse (parse)
 import Elara.Parse.Error (unWParseErrorBundle)
-import Print (prettyShow)
-import Test.Hspec.Megaparsec (parseSatisfies, shouldParse)
+import Test.Hspec.Megaparsec (parseSatisfies)
 import Test.QuickCheck
 import Text.Megaparsec (ParseErrorBundle, ShowErrorComponent, TraversableStream, VisualStream, errorBundlePretty)