Add partial parsers

This makes it easier to incorporate the parsers in other libraries
afterwards.

Author: harpocrates

src/Language/Rust/Parser.hs

@@ -23,7 +23,7 @@ sourceFile :: SourceFile Span
 
 module Language.Rust.Parser (
   -- * Parsing
-  parse, parse', readSourceFile, readTokens, Parse(..), P, execParser, initPos, Span,
+  parse, parsePartial, parse', readSourceFile, readTokens, Parse(..), P, execParser, initPos, Span,
   -- * Lexing
   lexToken, lexNonSpace, lexTokens, translateLit,
   -- * Input stream
@@ -38,7 +38,7 @@ import Language.Rust.Data.Position (Position, Span, Spanned, initPos, prettyPosi
 import Language.Rust.Parser.Internal
 import Language.Rust.Parser.Lexer (lexToken, lexNonSpace, lexTokens, lexicalError)
 import Language.Rust.Parser.Literals (translateLit)
-import Language.Rust.Parser.ParseMonad (P, execParser, parseError)
+import Language.Rust.Parser.ParseMonad (P, execParser, parseError, getPosition)
 
 import Data.Typeable (Typeable)
 import Control.Exception (Exception, throw) 
@@ -55,6 +55,12 @@ parse' is = case execParser parser is initPos of
               Left (pos, msg) -> throw (ParseFail pos msg)
               Right x -> x
 
+-- | Parse something from an input stream (it is assumed the initial position is 'initPos'), return
+-- the position of the longest partial parse, as well as what was parsed
+parsePartial :: Parse a => InputStream -> Either (Position,String) (Position,a)
+parsePartial is = execParser parser' is initPos
+  where parser' = flip (,) <$> partialParser <*> getPosition
+
 -- | Given a path pointing to a Rust source file, read that file and parse it into a 'SourceFile'
 readSourceFile :: FilePath -> IO (SourceFile Span)
 readSourceFile fileName = parse' <$> readInputStream fileName
@@ -78,23 +84,77 @@ instance Exception ParseFail
 
 -- | Describes things that can be parsed
 class Parse a where
+  -- | Complete parser (fails if not all of the input is consumed)
   parser :: P a
 
-instance Parse (Lit Span) where parser = parseLit
-instance Parse (Attribute Span) where parser = parseAttr
-instance Parse (Ty Span) where parser = parseTy 
-instance Parse (Pat Span) where parser = parsePat
-instance Parse (Expr Span) where parser = parseExpr
-instance Parse (Stmt Span) where parser = parseStmt
-instance Parse (Item Span) where parser = parseItem
-instance Parse (SourceFile Span) where parser = parseSourceFile
-instance Parse TokenTree where parser = parseTt
-instance Parse TokenStream where parser = parseTokenStream
-instance Parse (Block Span) where parser = parseBlock
-instance Parse (ImplItem Span) where parser = parseImplItem 
-instance Parse (TraitItem Span) where parser = parseTraitItem
-instance Parse (TyParam Span) where parser = parseTyParam
-instance Parse (LifetimeDef Span) where parser = parseLifetimeDef
-instance Parse (Generics Span) where parser = parseGenerics
-instance Parse (WhereClause Span) where parser = parseWhereClause
+  -- | Partial parser (doesn't fail if not all the input is consumed)
+  partialParser :: P a
+
+instance Parse (Lit Span) where
+  parser = parseLit
+  partialParser = parseLitP
+
+instance Parse (Attribute Span) where
+  parser = parseAttr
+  partialParser = parseAttrP
+
+instance Parse (Ty Span) where
+  parser = parseTy 
+  partialParser = parseTyP
+
+instance Parse (Pat Span) where
+  parser = parsePat
+  partialParser = parsePatP
+
+instance Parse (Expr Span) where
+  parser = parseExpr
+  partialParser = parseExprP
+
+instance Parse (Stmt Span) where
+  parser = parseStmt
+  partialParser = parseStmtP
+
+instance Parse (Item Span) where
+  parser = parseItem
+  partialParser = parseItemP
+
+instance Parse (SourceFile Span) where
+  parser = parseSourceFile
+  partialParser = parseSourceFileP
+
+instance Parse TokenTree where
+  parser = parseTt
+  partialParser = parseTtP
+
+instance Parse TokenStream where
+  parser = parseTokenStream
+  partialParser = parseTokenStreamP
+
+instance Parse (Block Span) where
+  parser = parseBlock
+  partialParser = parseBlockP
+
+instance Parse (ImplItem Span) where
+  parser = parseImplItem 
+  partialParser = parseImplItemP
+
+instance Parse (TraitItem Span) where
+  parser = parseTraitItem
+  partialParser = parseTraitItemP
+
+instance Parse (TyParam Span) where
+  parser = parseTyParam
+  partialParser = parseTyParamP
+
+instance Parse (LifetimeDef Span) where
+  parser = parseLifetimeDef
+  partialParser = parseLifetimeDefP
+
+instance Parse (Generics Span) where
+  parser = parseGenerics
+  partialParser = parseGenericsP
+
+instance Parse (WhereClause Span) where
+  parser = parseWhereClause
+  partialParser = parseWhereClauseP
 

src/Language/Rust/Parser/Internal.y

@@ -27,9 +27,15 @@ To get information about transition states and such, run
 {-# LANGUAGE OverloadedStrings, OverloadedLists, PartialTypeSignatures #-}
 
 module Language.Rust.Parser.Internal (
+  -- * Complete parsers
   parseLit, parseAttr, parseTy, parsePat, parseStmt, parseExpr, parseItem, parseSourceFile,
   parseBlock, parseImplItem, parseTraitItem, parseTt, parseTokenStream, parseTyParam,
-  parseGenerics, parseWhereClause, parseLifetimeDef
+  parseGenerics, parseWhereClause, parseLifetimeDef,
+  
+  -- * Partial parsers
+  parseLitP, parseAttrP, parseTyP, parsePatP, parseStmtP, parseExprP, parseItemP, parseSourceFileP,
+  parseBlockP, parseImplItemP, parseTraitItemP, parseTtP, parseTokenStreamP, parseTyParamP,
+  parseGenericsP, parseWhereClauseP, parseLifetimeDefP
 ) where
 
 import Language.Rust.Syntax
@@ -66,12 +72,32 @@ import Text.Read (readMaybe)
 %name parseWhereClause where_clause
 %name parseGenerics generics
 
+-- we also document the partial parsers
+%partial parseLitP lit
+%partial parseAttrP export_attribute
+%partial parseTyP export_ty
+%partial parsePatP pat
+%partial parseStmtP stmt
+%partial parseExprP expr
+%partial parseItemP mod_item
+%partial parseSourceFileContentsP source_file
+%partial parseBlockP export_block
+%partial parseImplItemP impl_item
+%partial parseTraitItemP trait_item
+%partial parseTtP token_tree
+%partial parseTokenStreamP token_stream
+%partial parseTyParamP ty_param
+%partial parseLifetimeDefP lifetime_def
+%partial parseWhereClauseP where_clause
+%partial parseGenericsP generics
+
+
 %tokentype { Spanned Token }
 %lexer { lexNonSpace >>= } { Spanned Eof _ }
 %monad { P } { >>= } { return }
 
 %errorhandlertype explist
-%error { expParseError } --parseError }
+%error { expParseError }
 
 %expect 0
 
@@ -1794,6 +1820,13 @@ parseSourceFile = do
   (as,items) <- parseSourceFileContents
   pure (SourceFile sh as items)
 
+-- | Parse a partial source file
+parseSourceFileP :: P (SourceFile Span)
+parseSourceFileP = do
+  sh <- lexShebangLine
+  (as,items) <- parseSourceFileContentsP
+  pure (SourceFile sh as items)
+
 -- | Nudge the span endpoints of a 'Span' value
 nudge :: Int -> Int -> Span -> Span
 nudge leftSide rightSide (Span l r) = Span l' r'

src/Language/Rust/QuasiQuote.hs

@@ -0,0 +1,38 @@
+{-# LANGUAGE TemplateHaskellQuotes #-}
+
+module Language.Rust.QuasiQuote (
+  expr 
+) where
+
+import Language.Rust.Parser.ParseMonad
+import Language.Rust.Parser.Internal
+import Language.Rust.Data.InputStream (inputStreamFromString)
+import Language.Rust.Data.Position (Position(..))
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Quote (QuasiQuoter(..), dataToExpQ, dataToPatQ)
+
+import Data.Data (Data)
+
+expr :: QuasiQuoter
+expr = QuasiQuoter { quoteExp = expr' 
+                   , quotePat = notExprFail
+                   , quoteType = noExprFail
+                   , quoteDec = notExprFail
+                   }
+  where
+  notExprFail :: String -> Q a
+  notExprFail _ = fail "This quasiquoter only works for expressions"
+
+  exprParser 
+
+  expr' :: String -> Q Exp
+  expr' s =
+    case parsePartial (inputStreamFromString s) of
+      Left (pos,msg) -> fail $ "Could not parse the type in the quasiquote 
+    let inp = inputStreamFromString s
+        ty_either = parsePartial inp
+    in 
+
+
+

src/Language/Rust/QuasiQuoteParser.y

@@ -0,0 +1,9 @@
+{
+{-# OPTIONS_HADDOCK hide, not-home #-}
+{-# LANGUAGE OverloadedStrings, OverloadedLists, PartialTypeSignatures #-}
+
+module Language.Rust.QuasiQuoteParser (
+  
+) where
+
+

src/Language/Rust/Syntax/Token.hs

@@ -92,8 +92,8 @@ data Token
   | Underscore            -- ^ @_@ token
   | LifetimeTok Ident     -- ^ a lifetime (something like @\'a@ or @\'static@)
   | Space Space Name      -- ^ whitespace
-  -- ^ doc comment with its contents, whether it is outer/inner, and whether it is inline or not
   | Doc String !AttrStyle !Bool
+  -- ^ doc comment with its contents, whether it is outer/inner, and whether it is inline or not
   | Shebang               -- ^ @#!@ shebang token
   | Eof                   -- ^ end of file token