diff --git a/purescript.cabal b/purescript.cabal --- a/purescript.cabal +++ b/purescript.cabal @@ -1,5 +1,5 @@ name: purescript -version: 0.1.3 +version: 0.1.4 cabal-version: >=1.8 build-type: Simple license: MIT @@ -12,7 +12,7 @@ category: Language author: Phil Freeman data-dir: "" - + library build-depends: base >=4 && <5, syb -any, cmdtheline -any, containers -any, mtl -any, transformers -any, parsec -any, @@ -39,7 +39,7 @@ exposed: True buildable: True hs-source-dirs: src - + executable psc build-depends: base >=4 && <5, cmdtheline -any, containers -any, mtl -any, transformers -any, parsec -any, utf8-string -any, @@ -48,7 +48,7 @@ buildable: True hs-source-dirs: src other-modules: Language.PureScript.Optimize - + test-suite tests build-depends: base >=4 && <5, syb -any, directory -any, filepath -any, containers -any, mtl -any, transformers -any, diff --git a/src/Language/PureScript/Parser/Common.hs b/src/Language/PureScript/Parser/Common.hs --- a/src/Language/PureScript/Parser/Common.hs +++ b/src/Language/PureScript/Parser/Common.hs @@ -148,7 +148,7 @@ return $ foldl combine a bs buildPostfixParser :: P.Stream s m t => [P.ParsecT s u m (a -> a)] -> P.ParsecT s u m a -> P.ParsecT s u m a -buildPostfixParser f x = fold x (P.choice (map P.try f)) (flip ($)) +buildPostfixParser f x = fold x (P.choice f) (flip ($)) parseIdent :: P.Parsec String u Ident parseIdent = (Ident <$> identifier) <|> (Op <$> parens operator) diff --git a/src/Language/PureScript/Parser/Declarations.hs b/src/Language/PureScript/Parser/Declarations.hs --- a/src/Language/PureScript/Parser/Declarations.hs +++ b/src/Language/PureScript/Parser/Declarations.hs @@ -48,31 +48,31 @@ parseTypeDeclaration :: P.Parsec String ParseState Declaration parseTypeDeclaration = - TypeDeclaration <$> parseIdent - <*> (lexeme (indented *> P.string "::") *> parsePolyType) + TypeDeclaration <$> P.try (parseIdent <* lexeme (indented *> P.string "::")) + <*> parsePolyType parseTypeSynonymDeclaration :: P.Parsec String ParseState Declaration parseTypeSynonymDeclaration = - TypeSynonymDeclaration <$> (reserved "type" *> indented *> properName) + TypeSynonymDeclaration <$> (P.try (reserved "type") *> indented *> properName) <*> many (indented *> identifier) <*> (lexeme (indented *> P.char '=') *> parseType) parseValueDeclaration :: P.Parsec String ParseState Declaration parseValueDeclaration = - ValueDeclaration <$> parseIdent - <*> (lexeme (indented *> P.char '=') *> parseValue) + ValueDeclaration <$> P.try (parseIdent <* lexeme (indented *> P.char '=')) + <*> parseValue parseExternDeclaration :: P.Parsec String ParseState Declaration -parseExternDeclaration = reserved "extern" *> indented *> - (ExternDataDeclaration <$> (reserved "data" *> indented *> properName) +parseExternDeclaration = P.try (reserved "extern") *> indented *> + (ExternDataDeclaration <$> (P.try (reserved "data") *> indented *> properName) <*> (lexeme (indented *> P.string "::") *> parseKind) <|> ExternDeclaration <$> parseIdent <*> (lexeme (indented *> P.string "::") *> parsePolyType)) parseAssociativity :: P.Parsec String ParseState Associativity parseAssociativity = - (reserved "infixl" >> return Infixl) <|> - (reserved "infixr" >> return Infixr) + (P.try (reserved "infixl") >> return Infixl) <|> + (P.try (reserved "infixr") >> return Infixr) parseFixity :: P.Parsec String ParseState Fixity parseFixity = Fixity <$> parseAssociativity <*> (indented *> natural) @@ -88,13 +88,13 @@ return $ FixityDeclaration fixity name parseDeclaration :: P.Parsec String ParseState Declaration -parseDeclaration = P.choice (map P.try +parseDeclaration = P.choice [ parseDataDeclaration , parseTypeDeclaration , parseTypeSynonymDeclaration , parseValueDeclaration , parseExternDeclaration - , parseFixityDeclaration ]) P. "declaration" + , parseFixityDeclaration ] P. "declaration" parseDeclarations :: P.Parsec String ParseState [Declaration] parseDeclarations = whiteSpace *> mark (same *> P.many parseDeclaration) <* P.eof diff --git a/src/Language/PureScript/Parser/Types.hs b/src/Language/PureScript/Parser/Types.hs --- a/src/Language/PureScript/Parser/Types.hs +++ b/src/Language/PureScript/Parser/Types.hs @@ -74,7 +74,7 @@ parseType = (P.buildExpressionParser operators . buildPostfixParser postfixTable $ parseTypeAtom) P. "type" where postfixTable :: [P.Parsec String ParseState (Type -> Type)] - postfixTable = [ flip TypeApp <$> (indented *> parseTypeAtom) ] + postfixTable = [ flip TypeApp <$> P.try (indented *> parseTypeAtom) ] operators = [ [ P.Infix (lexeme (P.try (P.string "->")) >> return (\t1 t2 -> Function [t1] t2)) P.AssocRight ] ] parseNameAndType :: P.Parsec String ParseState (String, Type) diff --git a/src/Language/PureScript/Parser/Values.hs b/src/Language/PureScript/Parser/Values.hs --- a/src/Language/PureScript/Parser/Values.hs +++ b/src/Language/PureScript/Parser/Values.hs @@ -75,7 +75,7 @@ parseConstructor = Constructor <$> C.properName parseCase :: P.Parsec String ParseState Value -parseCase = Case <$> P.between (C.reserved "case") (C.indented *> C.reserved "of") parseValue +parseCase = Case <$> P.between (P.try (C.reserved "case")) (C.indented *> C.reserved "of") parseValue <*> (C.indented *> C.mark (P.many (C.same *> C.mark parseCaseAlternative))) parseCaseAlternative :: P.Parsec String ParseState (Binder, Value) @@ -84,30 +84,30 @@ P. "case alternative" parseIfThenElse :: P.Parsec String ParseState Value -parseIfThenElse = IfThenElse <$> (C.reserved "if" *> C.indented *> parseValue) +parseIfThenElse = IfThenElse <$> (P.try (C.reserved "if") *> C.indented *> parseValue) <*> (C.indented *> C.reserved "then" *> C.indented *> parseValue) <*> (C.indented *> C.reserved "else" *> C.indented *> parseValue) parseBlock :: P.Parsec String ParseState Value -parseBlock = Block <$> (C.reserved "do" *> parseManyStatements) +parseBlock = Block <$> (P.try (C.reserved "do") *> parseManyStatements) parseManyStatements :: P.Parsec String ParseState [Statement] parseManyStatements = C.indented *> C.mark (P.many (C.same *> C.mark parseStatement)) P. "block" parseValueAtom :: P.Parsec String ParseState Value -parseValueAtom = C.indented *> P.choice (map P.try - [ parseNumericLiteral - , parseStringLiteral - , parseBooleanLiteral +parseValueAtom = C.indented *> P.choice + [ P.try parseNumericLiteral + , P.try parseStringLiteral + , P.try parseBooleanLiteral , parseArrayLiteral , parseObjectLiteral , parseAbs - , parseVar - , parseConstructor + , P.try parseVar + , P.try parseConstructor , parseBlock , parseCase , parseIfThenElse - , C.parens parseValue ]) + , C.parens parseValue ] parsePropertyUpdate :: P.Parsec String ParseState (String, Value) parsePropertyUpdate = do @@ -125,10 +125,10 @@ where indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom postfixTable1 = [ Accessor <$> (C.indented *> C.dot *> C.indented *> C.identifier) - , Indexer <$> (C.indented *> C.squares parseValue) - , flip ObjectUpdate <$> (C.indented *> C.braces ((C.indented *> parsePropertyUpdate) `P.sepBy1` (C.indented *> C.comma))) ] - postfixTable2 = [ C.indented *> indexersAndAccessors >>= \t2 -> return (\t1 -> App t1 [t2]) - , flip App <$> (C.indented *> C.parens (parseValue `P.sepBy` (C.indented *> C.comma))) + , P.try $ Indexer <$> (C.indented *> C.squares parseValue) + , P.try $ flip ObjectUpdate <$> (C.indented *> C.braces ((C.indented *> parsePropertyUpdate) `P.sepBy1` (C.indented *> C.comma))) ] + postfixTable2 = [ P.try (C.indented *> indexersAndAccessors >>= \t2 -> return (\t1 -> App t1 [t2])) + , P.try $ flip App <$> (C.indented *> C.parens (parseValue `P.sepBy` (C.indented *> C.comma))) , flip TypedValue <$> (P.try (C.lexeme (C.indented *> P.string "::")) *> parsePolyType) ] operators user = [ [ Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "!") >> return (Unary Not) @@ -173,7 +173,6 @@ C.reservedOp name P. "operator" return $ \t1 t2 -> App (App (Var (Op name)) [t1]) [t2]) levels - toAssoc :: Associativity -> Assoc toAssoc Infixl = AssocLeft