module Language.PureScript.Parser.Declarations (
parseDeclaration,
parseModule,
parseModules
) where
import Data.Maybe (isJust, fromMaybe)
import Control.Applicative
import qualified Text.Parsec as P
import Language.PureScript.Parser.State
import Language.PureScript.Parser.Common
import Language.PureScript.Declarations
import Language.PureScript.Parser.Values
import Language.PureScript.Parser.Types
import Language.PureScript.Parser.Kinds
import Language.PureScript.CodeGen.JS.AST
parseDataDeclaration :: P.Parsec String ParseState Declaration
parseDataDeclaration = do
reserved "data"
name <- indented *> properName
tyArgs <- many (indented *> identifier)
_ <- lexeme $ indented *> P.char '='
ctors <- sepBy1 ((,) <$> properName <*> P.many (indented *> parseTypeAtom)) pipe
return $ DataDeclaration name tyArgs ctors
parseTypeDeclaration :: P.Parsec String ParseState Declaration
parseTypeDeclaration =
TypeDeclaration <$> P.try (parseIdent <* lexeme (indented *> P.string "::"))
<*> parsePolyType
parseTypeSynonymDeclaration :: P.Parsec String ParseState Declaration
parseTypeSynonymDeclaration =
TypeSynonymDeclaration <$> (P.try (reserved "type") *> indented *> properName)
<*> many (indented *> identifier)
<*> (lexeme (indented *> P.char '=') *> parsePolyType)
parseValueDeclaration :: P.Parsec String ParseState Declaration
parseValueDeclaration =
ValueDeclaration <$> parseIdent
<*> P.many parseBinderNoParens
<*> P.optionMaybe parseGuard
<*> (lexeme (indented *> P.char '=') *> parseValue)
parseExternDeclaration :: P.Parsec String ParseState Declaration
parseExternDeclaration = P.try (reserved "foreign") *> indented *> reserved "import" *> indented *>
(ExternDataDeclaration <$> (P.try (reserved "data") *> indented *> properName)
<*> (lexeme (indented *> P.string "::") *> parseKind)
<|> do ident <- parseIdent
js <- P.optionMaybe (JSRaw <$> stringLiteral)
ty <- lexeme (indented *> P.string "::") *> parsePolyType
return $ ExternDeclaration (if isJust js then InlineJavascript else ForeignImport) ident js ty)
parseAssociativity :: P.Parsec String ParseState Associativity
parseAssociativity =
(P.try (reserved "infixl") >> return Infixl) <|>
(P.try (reserved "infixr") >> return Infixr)
parseFixity :: P.Parsec String ParseState Fixity
parseFixity = Fixity <$> parseAssociativity <*> (indented *> natural)
parseFixityDeclaration :: P.Parsec String ParseState Declaration
parseFixityDeclaration = do
fixity <- parseFixity
indented
name <- operator
return $ FixityDeclaration fixity name
parseImportDeclaration :: P.Parsec String ParseState Declaration
parseImportDeclaration = do
reserved "import"
indented
moduleName' <- moduleName
idents <- P.optionMaybe $ parens $ commaSep1 (Left <$> parseIdent <|> Right <$> properName)
return $ ImportDeclaration moduleName' idents
parseTypeClassDeclaration :: P.Parsec String ParseState Declaration
parseTypeClassDeclaration = do
reserved "class"
className <- indented *> properName
idents <- indented *> P.many identifier
indented *> reserved "where"
members <- mark (P.many (same *> parseTypeDeclaration))
return $ TypeClassDeclaration className idents members
parseTypeInstanceDeclaration :: P.Parsec String ParseState Declaration
parseTypeInstanceDeclaration = do
reserved "instance"
deps <- P.optionMaybe $ do
deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many parseTypeAtom))
indented
reservedOp "=>"
return deps
className <- indented *> parseQualified properName
ty <- indented *> P.many parseTypeAtom
indented *> reserved "where"
members <- mark (P.many (same *> parseValueDeclaration))
return $ TypeInstanceDeclaration (fromMaybe [] deps) className ty members
parseDeclaration :: P.Parsec String ParseState Declaration
parseDeclaration = P.choice
[ parseDataDeclaration
, parseTypeDeclaration
, parseTypeSynonymDeclaration
, parseValueDeclaration
, parseExternDeclaration
, parseFixityDeclaration
, parseImportDeclaration
, parseTypeClassDeclaration
, parseTypeInstanceDeclaration ] P.<?> "declaration"
parseModule :: P.Parsec String ParseState Module
parseModule = do
reserved "module"
indented
name <- moduleName
_ <- lexeme $ P.string "where"
decls <- mark (P.many (same *> parseDeclaration))
return $ Module name decls
parseModules :: P.Parsec String ParseState [Module]
parseModules = whiteSpace *> mark (P.many (same *> parseModule)) <* P.eof