language-lua2 0.1.0.3 → 0.1.0.4
raw patch · 6 files changed
+156/−69 lines, 6 filesdep +deepseq
Dependencies added: deepseq
Files
- language-lua2.cabal +3/−2
- src/Language/Lua/Lexer.hs +18/−4
- src/Language/Lua/Parser.hs +4/−0
- src/Language/Lua/Token.hs +57/−57
- test/Instances.hs +50/−3
- test/Spec.hs +24/−3
language-lua2.cabal view
@@ -1,5 +1,5 @@ name: language-lua2-version: 0.1.0.3+version: 0.1.0.4 synopsis: Lua parser and pretty printer description: Lua parser and pretty printer homepage: http://github.com/mitchellwrosen/language-lua2@@ -86,6 +86,7 @@ main-is: Spec.hs other-modules: Instances build-depends: base+ , deepseq , lexer-applicative , language-lua2 , QuickCheck@@ -95,7 +96,7 @@ , tasty-hunit , tasty-quickcheck , unordered-containers- ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-N -K1K" default-extensions: FlexibleInstances default-language: Haskell2010
src/Language/Lua/Lexer.hs view
@@ -213,14 +213,28 @@ , whitespace $ longest luaLineComment ] +-- A comment starts with a double hyphen (--) anywhere outside a string. If the+-- text immediately after -- is not an opening long bracket, the comment is a+-- short comment, which runs until the end of the line. Otherwise, it is a long+-- comment, which runs until the corresponding closing long bracket. Long+-- comments are frequently used to disable code temporarily.+ luaBlockCommentPrefix :: RE Char String-luaBlockCommentPrefix = "--[" *> many (sym '=') <* sym '['+luaBlockCommentPrefix = "--[[" -luaBlockCommentSuffix :: String -> RE Char Char-luaBlockCommentSuffix xs = many anySym *> "--]" *> exactlyN (length xs) (sym '=') *> sym ']'+luaBlockCommentSuffix :: String -> RE Char String+luaBlockCommentSuffix _ = many anySym *> "]]" luaLineComment :: RE Char String-luaLineComment = "--" *> many (psym (/= '\n'))+luaLineComment =+ "--"+ <|> "--\n"+ <|> "--" *> psym p *> many (psym (/= '\n'))+ <|> "--[\n"+ <|> "--[" *> psym p *> many (psym (/= '\n'))+ where+ p :: Char -> Bool+ p c = c /= '[' && c /= '\n' -------------------------------------------------------------------------------- -- Regex extras
src/Language/Lua/Parser.hs view
@@ -376,6 +376,7 @@ <|> mkFloat <$> floatLit <|> mkString <$> stringLit <|> mkVararg <$> vararg+ <|> mkFunDef <$> function <*> functionBody <|> mkPrefixExp <$> prefixExpression <|> mkTableCtor <$> tableConstructor @@ -676,6 +677,9 @@ mkVararg :: L Token -> Expression NodeInfo mkVararg = Vararg . nodeInfo++mkFunDef :: L Token -> FunctionBody NodeInfo -> Expression NodeInfo+mkFunDef a b = FunDef (nodeInfo a <> nodeInfo b) b mkPrefixExp :: PrefixExpression NodeInfo -> Expression NodeInfo mkPrefixExp a = PrefixExp (nodeInfo a) a
src/Language/Lua/Token.hs view
@@ -4,63 +4,63 @@ import GHC.Generics (Generic) data Token- = TkAnd -- ^ and- | TkBreak -- ^ break- | TkDo -- ^ do- | TkElse -- ^ else- | TkElseif -- ^ elseif- | TkEnd -- ^ end- | TkFalse -- ^ false- | TkFor -- ^ for- | TkFunction -- ^ function- | TkGoto -- ^ goto- | TkIf -- ^ if- | TkIn -- ^ in- | TkLocal -- ^ local- | TkNil -- ^ nil- | TkNot -- ^ not- | TkOr -- ^ or- | TkRepeat -- ^ repeat- | TkReturn -- ^ return- | TkThen -- ^ then- | TkTrue -- ^ true- | TkUntil -- ^ until- | TkWhile -- ^ while- | TkPlus -- ^ +- | TkDash -- ^ \-- | TkMult -- ^ \*- | TkFloatDiv -- ^ /- | TkModulo -- ^ %- | TkExponent -- ^ ^- | TkLength -- ^ #- | TkBitwiseAnd -- ^ &- | TkTilde -- ^ ~- | TkBitwiseOr -- ^ |- | TkLShift -- ^ <<- | TkRShift -- ^ \>\>- | TkFloorDiv -- ^ //- | TkEq -- ^ ==- | TkNeq -- ^ ~=- | TkLeq -- ^ <=- | TkGeq -- ^ \>=- | TkLt -- ^ <- | TkGt -- ^ >- | TkAssign -- ^ =- | TkLParen -- ^ (- | TkRParen -- ^ )- | TkLBrace -- ^ {- | TkRBrace -- ^ }- | TkLBracket -- ^ [- | TkRBracket -- ^ ]- | TkLabel -- ^ ::- | TkSemi -- ^ ;- | TkColon -- ^ :- | TkComma -- ^ ,- | TkDot -- ^ .- | TkConcat -- ^ ..- | TkVararg -- ^ ...- | TkQuote -- ^ '- | TkDoubleQuote -- ^ "+ = TkAnd -- ^ @and@+ | TkBreak -- ^ @break@+ | TkDo -- ^ @do@+ | TkElse -- ^ @else@+ | TkElseif -- ^ @elseif@+ | TkEnd -- ^ @end@+ | TkFalse -- ^ @false@+ | TkFor -- ^ @for@+ | TkFunction -- ^ @function@+ | TkGoto -- ^ @goto@+ | TkIf -- ^ @if@+ | TkIn -- ^ @in@+ | TkLocal -- ^ @local@+ | TkNil -- ^ @nil@+ | TkNot -- ^ @not@+ | TkOr -- ^ @or@+ | TkRepeat -- ^ @repeat@+ | TkReturn -- ^ @return@+ | TkThen -- ^ @then@+ | TkTrue -- ^ @true@+ | TkUntil -- ^ @until@+ | TkWhile -- ^ @while@+ | TkPlus -- ^ @+@+ | TkDash -- ^ @\-@+ | TkMult -- ^ @\*@+ | TkFloatDiv -- ^ @/@+ | TkModulo -- ^ @%@+ | TkExponent -- ^ @^@+ | TkLength -- ^ @#@+ | TkBitwiseAnd -- ^ @&@+ | TkTilde -- ^ @~@+ | TkBitwiseOr -- ^ @|@+ | TkLShift -- ^ @<<@+ | TkRShift -- ^ @\>\>@+ | TkFloorDiv -- ^ @//@+ | TkEq -- ^ @==@+ | TkNeq -- ^ @~=@+ | TkLeq -- ^ @<=@+ | TkGeq -- ^ @\>=@+ | TkLt -- ^ @<@+ | TkGt -- ^ @\>@+ | TkAssign -- ^ @=@+ | TkLParen -- ^ @(@+ | TkRParen -- ^ @)@+ | TkLBrace -- ^ @{@+ | TkRBrace -- ^ @}@+ | TkLBracket -- ^ @[@+ | TkRBracket -- ^ @]@+ | TkLabel -- ^ @::@+ | TkSemi -- ^ @;@+ | TkColon -- ^ @:@+ | TkComma -- ^ @,@+ | TkDot -- ^ @.@+ | TkConcat -- ^ @..@+ | TkVararg -- ^ @...@+ | TkQuote -- ^ @'@+ | TkDoubleQuote -- ^ @"@ | TkIdent String | TkStringLit String | TkIntLit String
test/Instances.hs view
@@ -1,21 +1,31 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Instances where +import Language.Lua.Token import Language.Lua.Syntax+import Language.Lua.Parser (NodeInfo) import Control.Applicative+import Control.DeepSeq import Data.Char (isAsciiLower, isAsciiUpper, isDigit) import Data.HashSet (HashSet) import qualified Data.HashSet as HS import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NE+import Data.Loc (L(..), Loc(..), Pos(..))+import GHC.Generics (Generic) import Test.QuickCheck.Arbitrary import Test.QuickCheck.Gen +--------------------------------------------------------------------------------+-- Arbitrary+ #if !MIN_VERSION_base(4,8,0) import Data.Typeable (Typeable) type C a = (Arbitrary a, Typeable a)@@ -210,7 +220,44 @@ shrink = genericShrink +--------------------------------------------------------------------------------+-- NFData++instance NFData NodeInfo+instance NFData Token++instance NFData a => NFData (Ident a)+instance NFData a => NFData (IdentList a)+instance NFData a => NFData (IdentList1 a)+instance NFData a => NFData (Block a)+instance NFData a => NFData (Statement a)+instance NFData a => NFData (ReturnStatement a)+instance NFData a => NFData (FunctionName a)+instance NFData a => NFData (Variable a)+instance NFData a => NFData (VariableList1 a)+instance NFData a => NFData (Expression a)+instance NFData a => NFData (ExpressionList a)+instance NFData a => NFData (ExpressionList1 a)+instance NFData a => NFData (PrefixExpression a)+instance NFData a => NFData (FunctionCall a)+instance NFData a => NFData (FunctionArgs a)+instance NFData a => NFData (FunctionBody a)+instance NFData a => NFData (TableConstructor a)+instance NFData a => NFData (Field a)+instance NFData a => NFData (FieldList a)+instance NFData a => NFData (Binop a)+instance NFData a => NFData (Unop a)+ -- Orphans instance Arbitrary a => Arbitrary (NonEmpty a) where arbitrary = NE.fromList <$> listOf1 arbitrary++deriving instance Generic a => Generic (L a)+instance (Generic a, NFData a) => NFData (L a)++deriving instance Generic Loc+instance NFData Loc++deriving instance Generic Pos+instance NFData Pos
test/Spec.hs view
@@ -12,6 +12,8 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$)) #endif+import Control.DeepSeq (rnf)+import Control.Exception (evaluate) import Data.Loc import Test.QuickCheck import Test.Tasty@@ -21,8 +23,7 @@ main :: IO () main = defaultMain $ testGroup "tests" [ lexerTests- -- TODO: Make smarter shrinks and re-enable- -- , parserTests+ , parserTests ] lexerTests :: TestTree@@ -30,6 +31,7 @@ [ stringLiteralTests , intLiteralTests , floatLiteralTests+ , commentTests ] where stringLiteralTests :: TestTree@@ -60,11 +62,30 @@ l "0X1.92P+1" @?= [TkFloatLit "0X1.92P+1"] l "0X1.92p1" @?= [TkFloatLit "0X1.92p1"] + commentTests :: TestTree+ commentTests = testCase "comments" $ do+ l "--" @?= []+ l "--just a comment" @?= []+ l "-- just a comment" @?= []+ l "3 -- hi" @?= [TkIntLit "3"]+ l "3 --[ hi" @?= [TkIntLit "3"]+ l "3 --[\nhi" @?= [TkIntLit "3", TkIdent "hi"]+ l "3 --[[hello\nworld]] 4" @?= [TkIntLit "3", TkIntLit "4"]+ l :: String -> [Token] l = map unLoc . streamToList . runLexer luaLexer "" parserTests :: TestTree-parserTests = QC.testProperty "Pretty-printer round-trip" (\luaAst -> luaFromString (luaToString luaAst) == Just luaAst)+parserTests = testGroup "parser tests"+ [ testCase "parse 1.lua" (parseFile "test/samples/1.lua")+ , testCase "parse 2.lua" (parseFile "test/samples/2.lua")++ -- TODO: Make smarter shrinks and re-enable+ -- , QC.testProperty "Pretty-printer round-trip" (\luaAst -> luaFromString (luaToString luaAst) == Just luaAst)+ ]++parseFile :: String -> IO ()+parseFile file = readFile file >>= evaluate . rnf . parseLua file luaToString :: Chunk () -> String luaToString c = displayS (renderPretty 1.0 80 (pretty c)) ""