Some more fleshing-out of the parser and better AST utils.

1 files changed, 20 insertions, 15 deletions

diff --git a/src/Language/Fiddle/Parser.hs b/src/Language/Fiddle/Parser.hs
index 16489c1..59faeda 100644
--- a/src/Language/Fiddle/Parser.hs
+++ b/src/Language/Fiddle/Parser.hs
@@ -7,6 +7,7 @@ module Language.Fiddle.Parser
   )
 where
 
+import Debug.Trace
 import Data.Functor.Identity
 import Data.Text (Text)
 import qualified Data.Text
@@ -25,9 +26,9 @@ type P = ParsecT S () Identity
 type Pa (a :: Stage -> (* -> *) -> * -> *) = P (a 'Stage1 F (Commented SourceSpan))
 
 fiddleUnit :: Pa FiddleUnit
-fiddleUnit =
+fiddleUnit = do
   withMeta $
-    FiddleUnit <$> many (fiddleDecl <* tok TokSemi)
+    FiddleUnit <$> many1 (fiddleDecl <* tok TokSemi)
 
 fiddleDecl :: Pa FiddleDecl
 fiddleDecl =
@@ -66,7 +67,7 @@ objType = recur objType'
         (ReferencedObjType <$> ident)
           <|> (AnonymousObjType <$> defer body objTypeBody)
 
-exprInParen :: P (Expression Stage1 (Commented SourceSpan))
+exprInParen :: Pa Expression
 exprInParen = tok TokLParen *> expression <* tok TokRParen
 
 objTypeBody :: Pa ObjTypeBody
@@ -91,7 +92,7 @@ objTypeDecl =
                 <*> optionMaybe (tok TokColon *> registerBody)
           )
 
-modifier :: P (Modifier (Commented SourceSpan))
+modifier :: Pa Modifier
 modifier =
   withMeta $
     ModifierKeyword
@@ -139,7 +140,7 @@ registerBitsTypeRef = recur typeRef
         (tok KWEnum >> RegisterBitsAnonymousType <$> anonymousBitsType)
           <|> (RegisterBitsReference <$> ident)
 
-anonymousBitsType :: P (AnonymousBitsType F (Commented SourceSpan))
+anonymousBitsType :: Pa AnonymousBitsType
 anonymousBitsType = withMeta $ do
   tok KWEnum
   AnonymousEnumBody <$> exprInParen <*> defer body enumBody
@@ -157,15 +158,15 @@ enumBody :: Pa EnumBody
 enumBody =
   withMeta $
     withinBody $
-      EnumBody <$> many enumConstantDecl
+      EnumBody <$> many (enumConstantDecl <* tok TokComma)
 
-enumConstantDecl :: P (EnumConstantDecl Stage1 (Commented SourceSpan))
+enumConstantDecl :: Pa EnumConstantDecl
 enumConstantDecl =
   withMeta $
     (tok KWReserved >> EnumConstantReserved <$> exprInParen)
       <|> (EnumConstantDecl <$> ident <*> (tok TokEq >> expression))
 
-expression :: P (Expression 'Stage1 (Commented SourceSpan))
+expression :: Pa Expression
 expression = withMeta $
   token $ \case
     (TokLitNum num) -> Just (LitNum num)
@@ -182,7 +183,8 @@ body = do
         ( body <|> fmap (: []) anyToken
         )
         (lookAhead $ tok TokRBrace)
-  return $ t0 : ret
+  t1 <- tok TokRBrace
+  return $ t0 : ret ++ [t1]
 
 -- Parses something within braces.
 withinBody :: P a -> P a
@@ -197,8 +199,11 @@ withinBody p = tok TokLBrace *> p <* tok TokRBrace
 defer :: P [Token SourceSpan] -> P b -> P (F b)
 defer p0 pb = do
   contents <- p0
+
   sourcePos <- getPosition
 
+  traceM $ "Contents: " ++ show contents
+
   return $
     Text.Parsec.runParser
       ( do
@@ -215,7 +220,7 @@ packageBody =
     withinBody $
       PackageBody <$> many (fiddleDecl <* tok TokSemi)
 
-ident :: P (Identifier (Commented SourceSpan))
+ident :: Pa Identifier
 ident =
   withMeta $
     token $ \case
@@ -227,10 +232,9 @@ ident =
 withMeta :: P (Commented SourceSpan -> b) -> P b
 withMeta p = try $ do
   comments <- many comment
-  (Token _ (SourceSpan start _)) <- lookAhead anyToken
+  start <- getPosition
   fn <- p
-  (Token _ (SourceSpan end _)) <- lookAhead anyToken
-
+  end <- getPosition
   return $ fn (Commented comments (SourceSpan start end))
   where
     comment :: P Comment
@@ -255,5 +259,6 @@ tok t' =
     (\tok@(Token t _) -> if t == t' then Just tok else Nothing)
 
 parseFiddleText :: String -> Text -> F (FiddleUnit 'Stage1 F (Commented SourceSpan))
-parseFiddleText sourceName txt = runIdentity $ do
-  Text.Parsec.runParserT fiddleUnit () sourceName []
+parseFiddleText sourceName txt = runIdentity .
+  Text.Parsec.runParserT
+    (fiddleUnit <* eof) () sourceName =<< tokenize sourceName txt