git.iko.soy/rowtype-yoga/purescript-native
on ea83764 help sign in
rowtype-yoga/purescript-native/src/PureScript/Parser/Types.hs
91 lines 3.2 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : PureScript.Parser.Types
4-- Copyright : (c) Phil Freeman 2013
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- |
12--
13-----------------------------------------------------------------------------
15module PureScript.Parser.Types (
16 parseType,
17 parsePolyType,
18 parseRow
19) where
21import PureScript.Types
22import PureScript.Parser.State
23import PureScript.Parser.Common
24import Control.Applicative
25import qualified Text.Parsec as P
26import qualified Text.Parsec.Expr as P
27import Control.Arrow (Arrow(..))
29parseNumber :: P.Parsec String ParseState Type
30parseNumber = const Number <$> reserved "Number"
32parseString :: P.Parsec String ParseState Type
33parseString = const String <$> reserved "String"
35parseBoolean :: P.Parsec String ParseState Type
36parseBoolean = const Boolean <$> reserved "Boolean"
38parseArray :: P.Parsec String ParseState Type
39parseArray = squares $ Array <$> parseType
41parseObject :: P.Parsec String ParseState Type
42parseObject = braces $ Object <$> parseRow
44parseFunction :: P.Parsec String ParseState Type
45parseFunction = do
46 args <- lexeme $ parens $ commaSep parseType
47 lexeme $ P.string "->"
48 resultType <- parseType
49 return $ Function args resultType
51parseTypeVariable :: P.Parsec String ParseState Type
52parseTypeVariable = TypeVar <$> identifier
54parseTypeConstructor :: P.Parsec String ParseState Type
55parseTypeConstructor = TypeConstructor <$> properName
57parseTypeAtom :: P.Parsec String ParseState Type
58parseTypeAtom = indented *> P.choice (map P.try
59 [ parseNumber
60 , parseString
61 , parseBoolean
62 , parseArray
63 , parseObject
64 , parseFunction
65 , parseTypeVariable
66 , parseTypeConstructor
67 , parens parseType ])
69parsePolyType :: P.Parsec String ParseState PolyType
70parsePolyType = (PolyType <$> P.option [] (indented *> reserved "forall" *> many (indented *> identifier) <* indented <* dot)
71 <*> parseType) P.<?> "polymorphic type"
73parseType :: P.Parsec String ParseState Type
74parseType = (P.buildExpressionParser operators . buildPostfixParser postfixTable $ parseTypeAtom) P.<?> "type"
75 where
76 postfixTable :: [P.Parsec String ParseState (Type -> Type)]
77 postfixTable = [ flip TypeApp <$> (indented *> parseTypeAtom) ]
78 operators = [ [ P.Infix (lexeme (P.try (P.string "->")) >> return (\t1 t2 -> Function [t1] t2)) P.AssocRight ] ]
80parseNameAndType :: P.Parsec String ParseState (String, Type)
81parseNameAndType = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> parseType
83parseRowEnding :: P.Parsec String ParseState Row
84parseRowEnding = P.option REmpty (RowVar <$> (lexeme (indented *> P.char '|') *> indented *> identifier))
86parseRow :: P.Parsec String ParseState Row
87parseRow = (fromList <$> (parseNameAndType `P.sepBy` (indented *> semi)) <*> parseRowEnding) P.<?> "row"
88 where
89 fromList :: [(String, Type)] -> Row -> Row
90 fromList [] r = r
91 fromList ((name, t):ts) r = RCons name t (fromList ts r)