git.iko.soy/rowtype-yoga/purescript-native
on 294b01d help sign in
rowtype-yoga/purescript-native/src/PureScript/Parser/Types.hs
80 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
69parseNameAndType :: P.Parsec String () (String, Type)
70parseNameAndType = (,) <$> (identifier <* lexeme (P.string "::")) <*> parseType
72parseRowEnding :: P.Parsec String () Row
73parseRowEnding = P.option REmpty (RowVar <$> (lexeme (P.char '|') *> identifier))
75parseRow :: P.Parsec String () Row
76parseRow = fromList <$> semiSep parseNameAndType <*> parseRowEnding
77 where
78 fromList :: [(String, Type)] -> Row -> Row
79 fromList [] r = r
80 fromList ((name, t):ts) r = RCons name t (fromList ts r)