git.iko.soy/rowtype-yoga/purescript-native
on a10616f help sign in
rowtype-yoga/purescript-native/src/PureScript/Parser/Types.hs
84 lines 2.4 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 parseRow
18) where
20import PureScript.Types
21import PureScript.Parser.Common
22import Control.Applicative
23import qualified Text.Parsec as P
24import Control.Arrow (Arrow(..))
26parseNumber :: P.Parsec String () Type
27parseNumber = const Number <$> P.string "Number"
29parseString :: P.Parsec String () Type
30parseString = const String <$> P.string "String"
32parseBoolean :: P.Parsec String () Type
33parseBoolean = const Boolean <$> P.string "Boolean"
35parseArray :: P.Parsec String () Type
36parseArray = squares $ Array <$> parseType
38parseObject :: P.Parsec String () Type
39parseObject = braces $ Object <$> parseRow
41parseFunction :: P.Parsec String () Type
42parseFunction = do
43 args <- lexeme $ parens $ commaSep parseType
44 lexeme $ P.string "->"
45 resultType <- parseType
46 return $ Function args resultType
48parseTypeVariable :: P.Parsec String () Type
49parseTypeVariable = TypeVar <$> identifier
51parseTypeConstructor :: P.Parsec String () Type
52parseTypeConstructor = TypeConstructor <$> properName
54parseTypeAtom :: P.Parsec String () Type
55parseTypeAtom = P.choice $ map P.try
56 [ parseNumber
57 , parseString
58 , parseBoolean
59 , parseArray
60 , parseObject
61 , parseFunction
62 , parseTypeVariable
63 , parseTypeConstructor
64 , parens parseType ]
66parseType :: P.Parsec String () Type
67parseType = fold (lexeme parseTypeAtom) (lexeme parseTypeAtom) TypeApp
69parseREmpty :: P.Parsec String () Row
70parseREmpty = braces whiteSpace >> return REmpty
72parseRCons :: P.Parsec String () Row
73parseRCons = RCons <$> (identifier <* lexeme (P.string "::"))
74 <*> (parseType <* semi)
75 <*> parseRow
77parseRowVariable :: P.Parsec String () Row
78parseRowVariable = RowVar <$> identifier
80parseRow :: P.Parsec String () Row
81parseRow = P.choice $ map P.try
82 [ parseRCons
83 , parseRowVariable
84 , parseREmpty ]