git.iko.soy/rowtype-yoga/purescript-native
on 7b064bd help sign in
rowtype-yoga/purescript-native/src/PureScript/Parser/Types.hs
90 lines 3.1 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.Common
23import Control.Applicative
24import qualified Text.Parsec as P
25import qualified Text.Parsec.Expr as P
26import Control.Arrow (Arrow(..))
28parseNumber :: P.Parsec String P.Column Type
29parseNumber = const Number <$> P.string "Number"
31parseString :: P.Parsec String P.Column Type
32parseString = const String <$> P.string "String"
34parseBoolean :: P.Parsec String P.Column Type
35parseBoolean = const Boolean <$> P.string "Boolean"
37parseArray :: P.Parsec String P.Column Type
38parseArray = squares $ Array <$> parseType
40parseObject :: P.Parsec String P.Column Type
41parseObject = braces $ Object <$> parseRow
43parseFunction :: P.Parsec String P.Column Type
44parseFunction = do
45 args <- lexeme $ parens $ commaSep parseType
46 lexeme $ P.string "->"
47 resultType <- parseType
48 return $ Function args resultType
50parseTypeVariable :: P.Parsec String P.Column Type
51parseTypeVariable = TypeVar <$> identifier
53parseTypeConstructor :: P.Parsec String P.Column Type
54parseTypeConstructor = TypeConstructor <$> properName
56parseTypeAtom :: P.Parsec String P.Column Type
57parseTypeAtom = indented *> P.choice (map P.try
58 [ parseNumber
59 , parseString
60 , parseBoolean
61 , parseArray
62 , parseObject
63 , parseFunction
64 , parseTypeVariable
65 , parseTypeConstructor
66 , parens parseType ])
68parsePolyType :: P.Parsec String P.Column PolyType
69parsePolyType = PolyType <$> (P.option [] (indented *> reserved "forall" *> many (indented *> identifier) <* indented <* dot))
70 <*> parseType
72parseType :: P.Parsec String P.Column Type
73parseType = P.buildExpressionParser operators . buildPostfixParser postfixTable $ parseTypeAtom
74 where
75 postfixTable :: [P.Parsec String P.Column (Type -> Type)]
76 postfixTable = [ flip TypeApp <$> parseTypeAtom ]
77 operators = [ [ P.Infix (lexeme (P.try (P.string "->")) >> return (\t1 t2 -> Function [t1] t2)) P.AssocLeft ] ]
79parseNameAndType :: P.Parsec String P.Column (String, Type)
80parseNameAndType = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> parseType
82parseRowEnding :: P.Parsec String P.Column Row
83parseRowEnding = P.option REmpty (RowVar <$> (lexeme (indented *> P.char '|') *> indented *> identifier))
85parseRow :: P.Parsec String P.Column Row
86parseRow = fromList <$> (parseNameAndType `P.sepBy` (indented *> semi)) <*> parseRowEnding
87 where
88 fromList :: [(String, Type)] -> Row -> Row
89 fromList [] r = r
90 fromList ((name, t):ts) r = RCons name t (fromList ts r)