git.iko.soy/rowtype-yoga/purescript-native
on 0f7185b help sign in
rowtype-yoga/purescript-native/src/PureScript/Parser/Common.hs
176 lines 5.6 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-----------------------------------------------------------------------------
15{-# LANGUAGE FlexibleContexts #-}
17module PureScript.Parser.Common where
19import Data.Char (isSpace)
20import Control.Applicative
21import Control.Monad
22import Control.Monad.State
23import qualified Text.Parsec as P
24import qualified Text.Parsec.Pos as P
25import qualified Text.Parsec.Token as PT
27import PureScript.Names
29reservedNames :: [String]
30reservedNames = [ "case"
31 , "of"
32 , "data"
33 , "type"
34 , "var"
35 , "val"
36 , "while"
37 , "for"
38 , "foreach"
39 , "if"
40 , "then"
41 , "else"
42 , "return"
43 , "true"
44 , "false"
45 , "extern"
46 , "forall"
47 , "do"
48 , "until"
49 , "in"
50 , "break"
51 , "catch"
52 , "continue"
53 , "debugger"
54 , "default"
55 , "delete"
56 , "finally"
57 , "function"
58 , "instanceof"
59 , "new"
60 , "switch"
61 , "this"
62 , "throw"
63 , "try"
64 , "typeof"
65 , "void"
66 , "with"
67 , "Number"
68 , "String"
69 , "Boolean" ]
71reservedOpNames :: [String]
72reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"
73 , "==", "!=", "&", "^", "|", "&&", "||", "->" ]
75identStart :: P.Parsec String u Char
76identStart = P.lower <|> P.oneOf "_$"
78properNameStart :: P.Parsec String u Char
79properNameStart = P.upper
81identLetter :: P.Parsec String u Char
82identLetter = P.alphaNum <|> P.oneOf "_'"
84opStart :: P.Parsec String u Char
85opStart = P.oneOf "!#$%&*+/<=>?@^|-~"
87opLetter :: P.Parsec String u Char
88opLetter = P.oneOf ":#$%&*+./<=>?@^|"
90langDef = PT.LanguageDef
91 { PT.reservedNames = reservedNames
92 , PT.reservedOpNames = reservedOpNames
93 , PT.commentStart = "{-"
94 , PT.commentEnd = "-}"
95 , PT.commentLine = "--"
96 , PT.nestedComments = True
97 , PT.identStart = identStart
98 , PT.identLetter = identLetter
99 , PT.opStart = opStart
100 , PT.opLetter = opLetter
101 , PT.caseSensitive = True
102 }
104tokenParser = PT.makeTokenParser langDef
106lexeme = PT.lexeme tokenParser
107identifier = PT.identifier tokenParser
108reserved = PT.reserved tokenParser
109reservedOp = PT.reservedOp tokenParser
110operator = PT.operator tokenParser
111stringLiteral = PT.stringLiteral tokenParser
112whiteSpace = PT.whiteSpace tokenParser
113parens = PT.parens tokenParser
114braces = PT.braces tokenParser
115angles = PT.angles tokenParser
116squares = PT.squares tokenParser
117semi = PT.semi tokenParser
118comma = PT.comma tokenParser
119colon = PT.colon tokenParser
120dot = PT.dot tokenParser
121semiSep = PT.semiSep tokenParser
122semiSep1 = PT.semiSep1 tokenParser
123commaSep = PT.commaSep tokenParser
124commaSep1 = PT.commaSep1 tokenParser
126tick :: P.Parsec String u Char
127tick = lexeme $ P.char '`'
129properName :: P.Parsec String u String
130properName = lexeme $ P.try ((:) <$> P.upper <*> many (PT.identLetter langDef) P.<?> "name")
132integerOrFloat :: P.Parsec String u (Either Integer Double)
133integerOrFloat = Left <$> P.try (PT.natural tokenParser) <|>
134 Right <$> P.try (PT.float tokenParser)
136augment :: 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
137augment p q f = (flip $ maybe id $ flip f) <$> p <*> P.optionMaybe q
139fold :: 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
140fold first more combine = do
141 a <- first
142 bs <- P.many more
143 return $ foldl combine a bs
145buildPostfixParser :: P.Stream s m t => [P.ParsecT s u m (a -> a)] -> P.ParsecT s u m a -> P.ParsecT s u m a
146buildPostfixParser f x = fold x (P.choice (map P.try f)) (flip ($))
148parseIdent :: P.Parsec String u Ident
149parseIdent = (Ident <$> identifier) <|> (Op <$> parens operator)
151parseIdentInfix :: P.Parsec String u Ident
152parseIdentInfix = (Ident <$> P.between tick tick identifier) <|> (Op <$> operator)
154mark :: P.Parsec String P.Column a -> P.Parsec String P.Column a
155mark p = do
156 current <- P.getState
157 pos <- P.sourceColumn <$> P.getPosition
158 P.putState pos
159 a <- p
160 P.putState current
161 return a
163checkIndentation :: (P.Column -> P.Column -> Bool) -> P.Parsec String P.Column ()
164checkIndentation rel = (do
165 col <- P.sourceColumn <$> P.getPosition
166 current <- P.getState
167 guard $ col `rel` current) <|> P.parserFail "Indentation check"
169indented :: P.Parsec String P.Column ()
170indented = checkIndentation (>)
172same :: P.Parsec String P.Column ()
173same = checkIndentation (==)
175runIndentParser :: P.Column -> P.Parsec String P.Column a -> String -> Either P.ParseError a
176runIndentParser col p = P.runParser p 0 ""