git.iko.soy/rowtype-yoga/purescript-native
on 6b2d16b help sign in
rowtype-yoga/purescript-native/src/PureScript/Parser/Common.hs
110 lines 4.0 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 qualified Text.Parsec as P
19import qualified Text.Parsec.Indent as I
20import qualified Text.Parsec.Token as PT
21import qualified Text.Parsec.Language as PL
23import PureScript.Names
25langDef = PT.LanguageDef
26 { PT.reservedNames = [ "case"
27 , "data"
28 , "type"
29 , "var"
30 , "while"
31 , "for"
32 , "if"
33 , "then"
34 , "else"
35 , "return"
36 , "true"
37 , "false"
38 , "extern"
39 , "forall" ]
40 , PT.reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"
41 , "==", "!=", "&", "^", "|", "&&", "||" ]
42 , PT.commentStart = "{-"
43 , PT.commentEnd = "-}"
44 , PT.commentLine = "--"
45 , PT.nestedComments = True
46 , PT.identStart = P.lower <|> P.oneOf "_$"
47 , PT.identLetter = P.alphaNum <|> P.oneOf "_'"
48 , PT.opStart = P.oneOf ":#?@\\"
49 , PT.opLetter = P.oneOf ":!#$%&*+./<=>?@\\^|-~"
50 , PT.caseSensitive = True
51 }
53tokenParser = PT.makeTokenParser langDef
55whiteSpace = P.skipMany $ (P.oneOf " \t" >> return ()) <|> P.try (P.skipMany1 (P.oneOf "\r\n")) >> I.indented <|> P.try lineComment <|> P.try blockComment
57lineComment = do
58 P.string $ PT.commentLine langDef
59 P.skipMany $ P.satisfy (/= '\n')
60 I.indented
62blockComment = do
63 P.string $ PT.commentStart langDef
64 P.manyTill P.anyChar $ P.try $ P.string $ PT.commentEnd langDef
65 return ()
67lexeme p = p <* whiteSpace
68identifier = lexeme $ PT.identifier tokenParser
69reserved s = lexeme $ PT.reserved tokenParser s
70operator = lexeme $ PT.operator tokenParser
71stringLiteral = lexeme $ PT.stringLiteral tokenParser
72natural = lexeme $ PT.natural tokenParser
73naturalOrFloat = lexeme $ PT.naturalOrFloat tokenParser
75semi = lexeme $ PT.semi tokenParser
76comma = lexeme $ PT.comma tokenParser
77colon = lexeme $ PT.colon tokenParser
78dot = lexeme $ PT.dot tokenParser
80semiSep p = P.sepBy p semi
81semiSep1 p = P.sepBy1 p semi
82commaSep p = P.sepBy p comma
83commaSep1 p = P.sepBy1 p comma
85parens p = lexeme (P.char '(') *> lexeme p <* lexeme (P.char ')')
86braces p = lexeme (P.char '{') *> lexeme p <* lexeme (P.char '}')
87angles p = lexeme (P.char '<') *> lexeme p <* lexeme (P.char '>')
88squares p = lexeme (P.char '[') *> lexeme p <* lexeme (P.char ']')
90tick = lexeme (P.char '`')
92properName :: I.IndentParser String u String
93properName = lexeme $ P.try properName'
94 where
95 properName' = (:) <$> P.upper <*> many (PT.identLetter langDef) P.<?> "name"
97augment :: 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
98augment p q f = (flip $ maybe id $ flip f) <$> p <*> P.optionMaybe q
100fold :: 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
101fold first more combine = do
102 a <- first
103 bs <- P.many more
104 return $ foldl combine a bs
106parseIdent :: I.IndentParser String () Ident
107parseIdent = (Ident <$> identifier) <|> (Op <$> parens operator)
109parseIdentInfix :: I.IndentParser String () Ident
110parseIdentInfix = (Ident <$> P.between tick tick identifier) <|> (Op <$> operator)