git.iko.soy/rowtype-yoga/purescript-native
on d6ab2e7 help sign in
rowtype-yoga/purescript-native/src/PureScript/Parser/Common.hs
174 lines 5.4 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 "\r\n") >> P.skipMany1 (P.oneOf " \t") >> I.indented
63 , P.try lineComment
64 , P.try blockComment ]
66lineComment :: I.IndentParser String u ()
67lineComment = do
68 P.string "--"
69 P.skipMany $ P.satisfy (/= '\n')
70 return ()
72blockComment :: I.IndentParser String u ()
73blockComment = do
74 P.string "{--"
75 P.manyTill P.anyChar $ P.try $ P.string "--}"
76 return ()
78lexeme :: I.IndentParser String u a -> I.IndentParser String u a
79lexeme p = p <* whiteSpace
81identifier :: I.IndentParser String u String
82identifier = lexeme $ do
83 name <- (:) <$> identStart <*> P.many identLetter
84 when (name `elem` reservedNames) $ P.unexpected ("reserved word " ++ show name)
85 return name
87properName :: I.IndentParser String u String
88properName = lexeme $ do
89 (:) <$> properNameStart <*> many identLetter P.<?> "name"
91reserved :: String -> I.IndentParser String u String
92reserved name = lexeme $ P.string name <* P.notFollowedBy identLetter
94reservedOp :: String -> I.IndentParser String u String
95reservedOp name = lexeme $ P.string name <* P.notFollowedBy opLetter
97operator :: I.IndentParser String u String
98operator = lexeme $ do
99 name <- (:) <$> opStart <*> P.many opLetter
100 when (name `elem` reservedOpNames) $ P.unexpected ("reserved operator " ++ show name)
101 return name
103stringLiteral :: I.IndentParser String u String
104stringLiteral = lexeme $ P.between (P.char '"') (P.char '"') (P.many (P.noneOf "\""))
106number :: I.IndentParser String u String
107number = do
108 intPart <- P.many1 P.digit
109 fracPart <- P.option "" $ (:) <$> P.char '.' <*> P.many1 P.digit
110 expPart <- P.option "" $ (:) <$> P.oneOf "eE" <*> P.many1 P.digit
111 return $ intPart ++ fracPart ++ expPart
113signedNumber :: I.IndentParser String u String
114signedNumber = do
115 s <- P.optionMaybe $ P.oneOf "-+"
116 n <- number
117 return $ maybe id (:) s n
119unsignedNumber :: I.IndentParser String u String
120unsignedNumber = lexeme number
122semi :: I.IndentParser String u Char
123semi = lexeme $ P.char ';'
125comma :: I.IndentParser String u Char
126comma = lexeme $ P.char ','
128colon :: I.IndentParser String u Char
129colon = lexeme $ P.char ':'
131dot :: I.IndentParser String u Char
132dot = lexeme $ P.char '.'
134tick :: I.IndentParser String u Char
135tick = lexeme $ P.char '`'
137semiSep :: I.IndentParser String u a -> I.IndentParser String u [a]
138semiSep p = P.sepBy p semi
140semiSep1 :: I.IndentParser String u a -> I.IndentParser String u [a]
141semiSep1 p = P.sepBy1 p semi
143commaSep :: I.IndentParser String u a -> I.IndentParser String u [a]
144commaSep p = P.sepBy p comma
146commaSep1 :: I.IndentParser String u a -> I.IndentParser String u [a]
147commaSep1 p = P.sepBy1 p comma
149parens :: I.IndentParser String u a -> I.IndentParser String u a
150parens p = lexeme (P.char '(') *> lexeme p <* lexeme (P.char ')')
152braces :: I.IndentParser String u a -> I.IndentParser String u a
153braces p = lexeme (P.char '{') *> lexeme p <* lexeme (P.char '}')
155angles :: I.IndentParser String u a -> I.IndentParser String u a
156angles p = lexeme (P.char '<') *> lexeme p <* lexeme (P.char '>')
158squares :: I.IndentParser String u a -> I.IndentParser String u a
159squares p = lexeme (P.char '[') *> lexeme p <* lexeme (P.char ']')
161augment :: 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
162augment p q f = (flip $ maybe id $ flip f) <$> p <*> P.optionMaybe q
164fold :: 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
165fold first more combine = do
166 a <- first
167 bs <- P.many more
168 return $ foldl combine a bs
170parseIdent :: I.IndentParser String () Ident
171parseIdent = (Ident <$> identifier) <|> (Op <$> parens operator)
173parseIdentInfix :: I.IndentParser String () Ident
174parseIdentInfix = (Ident <$> P.between tick tick identifier) <|> (Op <$> operator)