git.iko.soy/rowtype-yoga/purescript-native
on db7dadf help sign in
rowtype-yoga/purescript-native/src/PureScript/Parser/Common.hs
180 lines 5.7 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : PureScript.Parser.Common
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.Common where
17import Control.Applicative
18import Control.Monad
19import qualified Text.Parsec as P
20import qualified Text.Parsec.Indent as I
22import PureScript.Names
24reservedNames :: [String]
25reservedNames = [ "case"
26 , "data"
27 , "type"
28 , "var"
29 , "while"
30 , "for"
31 , "if"
32 , "then"
33 , "else"
34 , "return"
35 , "true"
36 , "false"
37 , "extern"
38 , "forall" ]
40reservedOpNames :: [String]
41reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"
42 , "==", "!=", "&", "^", "|", "&&", "||" ]
44identStart :: I.IndentParser String u Char
45identStart = P.lower <|> P.oneOf "_$"
47properNameStart :: I.IndentParser String u Char
48properNameStart = P.upper
50identLetter :: I.IndentParser String u Char
51identLetter = P.alphaNum <|> P.oneOf "_'"
53opStart :: I.IndentParser String u Char
54opStart = P.oneOf ":!#$%&*+/<=>?@^|-~"
56opLetter :: I.IndentParser String u Char
57opLetter = P.oneOf ":#$%&*+./<=>?@^|"
59whiteSpace :: I.IndentParser String u ()
60whiteSpace = P.skipMany $ P.choice
61 [ P.oneOf " \t" >> return ()
62 , P.try $ P.skipMany1 (P.oneOf " \t\r\n") >> I.indented
63 , P.try lineComment
64 , P.try blockComment ]
66unindentedBlock :: I.IndentParser String u a -> I.IndentParser String u [a]
67unindentedBlock p = I.block $ I.withPos (p <* P.skipMany (P.oneOf "\r\n"))
69indentedBlock :: I.IndentParser String u a -> I.IndentParser String u [a]
70indentedBlock p = I.block $ I.withPos (p <* P.skipMany (P.oneOf " \t\r\n"))
72lineComment :: I.IndentParser String u ()
73lineComment = do
74 P.string "--"
75 P.skipMany $ P.satisfy (/= '\n')
76 return ()
78blockComment :: I.IndentParser String u ()
79blockComment = do
80 P.string "{--"
81 P.manyTill P.anyChar $ P.try $ P.string "--}"
82 return ()
84lexeme :: I.IndentParser String u a -> I.IndentParser String u a
85lexeme p = p <* whiteSpace
87identifier :: I.IndentParser String u String
88identifier = lexeme $ do
89 name <- (:) <$> identStart <*> P.many identLetter
90 when (name `elem` reservedNames) $ P.unexpected ("reserved word " ++ show name)
91 return name
93properName :: I.IndentParser String u String
94properName = lexeme $ do
95 (:) <$> properNameStart <*> many identLetter P.<?> "name"
97reserved :: String -> I.IndentParser String u String
98reserved name = lexeme $ P.string name <* P.notFollowedBy identLetter
100reservedOp :: String -> I.IndentParser String u String
101reservedOp name = lexeme $ P.string name <* P.notFollowedBy opLetter
103operator :: I.IndentParser String u String
104operator = lexeme $ do
105 name <- (:) <$> opStart <*> P.many opLetter
106 when (name `elem` reservedOpNames) $ P.unexpected ("reserved operator " ++ show name)
107 return name
109stringLiteral :: I.IndentParser String u String
110stringLiteral = lexeme $ P.between (P.char '"') (P.char '"') (P.many (P.noneOf "\""))
112number :: I.IndentParser String u String
113number = do
114 intPart <- P.many1 P.digit
115 fracPart <- P.option "" $ (:) <$> P.char '.' <*> P.many1 P.digit
116 expPart <- P.option "" $ (:) <$> P.oneOf "eE" <*> P.many1 P.digit
117 return $ intPart ++ fracPart ++ expPart
119signedNumber :: I.IndentParser String u String
120signedNumber = do
121 s <- P.optionMaybe $ P.oneOf "-+"
122 n <- number
123 return $ maybe id (:) s n
125unsignedNumber :: I.IndentParser String u String
126unsignedNumber = lexeme number
128semi :: I.IndentParser String u Char
129semi = lexeme $ P.char ';'
131comma :: I.IndentParser String u Char
132comma = lexeme $ P.char ','
134colon :: I.IndentParser String u Char
135colon = lexeme $ P.char ':'
137dot :: I.IndentParser String u Char
138dot = lexeme $ P.char '.'
140tick :: I.IndentParser String u Char
141tick = lexeme $ P.char '`'
143semiSep :: I.IndentParser String u a -> I.IndentParser String u [a]
144semiSep p = P.sepBy p semi
146semiSep1 :: I.IndentParser String u a -> I.IndentParser String u [a]
147semiSep1 p = P.sepBy1 p semi
149commaSep :: I.IndentParser String u a -> I.IndentParser String u [a]
150commaSep p = P.sepBy p comma
152commaSep1 :: I.IndentParser String u a -> I.IndentParser String u [a]
153commaSep1 p = P.sepBy1 p comma
155parens :: I.IndentParser String u a -> I.IndentParser String u a
156parens p = lexeme (P.char '(') *> lexeme p <* lexeme (P.char ')')
158braces :: I.IndentParser String u a -> I.IndentParser String u a
159braces p = lexeme (P.char '{') *> lexeme p <* lexeme (P.char '}')
161angles :: I.IndentParser String u a -> I.IndentParser String u a
162angles p = lexeme (P.char '<') *> lexeme p <* lexeme (P.char '>')
164squares :: I.IndentParser String u a -> I.IndentParser String u a
165squares p = lexeme (P.char '[') *> lexeme p <* lexeme (P.char ']')
167augment :: P.Stream s m t => P.ParsecT s u m a -> P.ParsecT s u m b -> (a -> b -> a) -> P.ParsecT s u m a
168augment p q f = (flip $ maybe id $ flip f) <$> p <*> P.optionMaybe q
170fold :: P.Stream s m t => P.ParsecT s u m a -> P.ParsecT s u m b -> (a -> b -> a) -> P.ParsecT s u m a
171fold first more combine = do
172 a <- first
173 bs <- P.many more
174 return $ foldl combine a bs
176parseIdent :: I.IndentParser String () Ident
177parseIdent = (Ident <$> identifier) <|> (Op <$> parens operator)
179parseIdentInfix :: I.IndentParser String () Ident
180parseIdentInfix = (Ident <$> P.between tick tick identifier) <|> (Op <$> operator)