module Language.PureScript.Parser.Types (
parseType,
parsePolyType,
parseRow
) where
import Language.PureScript.Types
import Language.PureScript.Parser.State
import Language.PureScript.Parser.Common
import Control.Applicative
import qualified Text.Parsec as P
import qualified Text.Parsec.Expr as P
import Control.Arrow (Arrow(..))
parseNumber :: P.Parsec String ParseState Type
parseNumber = const Number <$> reserved "Number"
parseString :: P.Parsec String ParseState Type
parseString = const String <$> reserved "String"
parseBoolean :: P.Parsec String ParseState Type
parseBoolean = const Boolean <$> reserved "Boolean"
parseArray :: P.Parsec String ParseState Type
parseArray = squares $ Array <$> parseType
parseObject :: P.Parsec String ParseState Type
parseObject = braces $ Object <$> parseRow
parseFunction :: P.Parsec String ParseState Type
parseFunction = do
args <- lexeme $ parens $ commaSep parseType
lexeme $ P.string "->"
resultType <- parseType
return $ Function args resultType
parseTypeVariable :: P.Parsec String ParseState Type
parseTypeVariable = TypeVar <$> identifier
parseTypeConstructor :: P.Parsec String ParseState Type
parseTypeConstructor = TypeConstructor <$> properName
parseTypeAtom :: P.Parsec String ParseState Type
parseTypeAtom = indented *> P.choice (map P.try
[ parseNumber
, parseString
, parseBoolean
, parseArray
, parseObject
, parseFunction
, parseTypeVariable
, parseTypeConstructor
, parens parseType ])
parsePolyType :: P.Parsec String ParseState PolyType
parsePolyType = (PolyType <$> P.option [] (indented *> reserved "forall" *> many (indented *> identifier) <* indented <* dot)
<*> parseType) P.<?> "polymorphic type"
parseType :: P.Parsec String ParseState Type
parseType = (P.buildExpressionParser operators . buildPostfixParser postfixTable $ parseTypeAtom) P.<?> "type"
where
postfixTable :: [P.Parsec String ParseState (Type -> Type)]
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)
parseNameAndType = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> parseType
parseRowEnding :: P.Parsec String ParseState Row
parseRowEnding = P.option REmpty (RowVar <$> (lexeme (indented *> P.char '|') *> indented *> identifier))
parseRow :: P.Parsec String ParseState Row
parseRow = (fromList <$> (parseNameAndType `P.sepBy` (indented *> comma)) <*> parseRowEnding) P.<?> "row"
where
fromList :: [(String, Type)] -> Row -> Row
fromList [] r = r
fromList ((name, t):ts) r = RCons name t (fromList ts r)