git.iko.soy/rowtype-yoga/purescript-native
on 7b064bd help sign in
rowtype-yoga/purescript-native/src/PureScript/Parser/Common.hs
172 lines 5.5 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 , "data"
32 , "type"
33 , "var"
34 , "val"
35 , "while"
36 , "for"
37 , "foreach"
38 , "if"
39 , "then"
40 , "else"
41 , "return"
42 , "true"
43 , "false"
44 , "extern"
45 , "forall"
46 , "do"
47 , "until"
48 , "in"
49 , "break"
50 , "catch"
51 , "continue"
52 , "debugger"
53 , "default"
54 , "delete"
55 , "finally"
56 , "function"
57 , "instanceof"
58 , "new"
59 , "switch"
60 , "this"
61 , "throw"
62 , "try"
63 , "typeof"
64 , "void"
65 , "with" ]
67reservedOpNames :: [String]
68reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"
69 , "==", "!=", "&", "^", "|", "&&", "||" ]
71identStart :: P.Parsec String u Char
72identStart = P.lower <|> P.oneOf "_$"
74properNameStart :: P.Parsec String u Char
75properNameStart = P.upper
77identLetter :: P.Parsec String u Char
78identLetter = P.alphaNum <|> P.oneOf "_'"
80opStart :: P.Parsec String u Char
81opStart = P.oneOf "!#$%&*+/<=>?@^|-~"
83opLetter :: P.Parsec String u Char
84opLetter = P.oneOf ":#$%&*+./<=>?@^|"
86langDef = PT.LanguageDef
87 { PT.reservedNames = reservedNames
88 , PT.reservedOpNames = reservedOpNames
89 , PT.commentStart = "{-"
90 , PT.commentEnd = "-}"
91 , PT.commentLine = "--"
92 , PT.nestedComments = True
93 , PT.identStart = identStart
94 , PT.identLetter = identLetter
95 , PT.opStart = opStart
96 , PT.opLetter = opLetter
97 , PT.caseSensitive = True
98 }
100tokenParser = PT.makeTokenParser langDef
102lexeme = PT.lexeme tokenParser
103identifier = PT.identifier tokenParser
104reserved = PT.reserved tokenParser
105reservedOp = PT.reservedOp tokenParser
106operator = PT.operator tokenParser
107stringLiteral = PT.stringLiteral tokenParser
108whiteSpace = PT.whiteSpace tokenParser
109parens = PT.parens tokenParser
110braces = PT.braces tokenParser
111angles = PT.angles tokenParser
112squares = PT.squares tokenParser
113semi = PT.semi tokenParser
114comma = PT.comma tokenParser
115colon = PT.colon tokenParser
116dot = PT.dot tokenParser
117semiSep = PT.semiSep tokenParser
118semiSep1 = PT.semiSep1 tokenParser
119commaSep = PT.commaSep tokenParser
120commaSep1 = PT.commaSep1 tokenParser
122tick :: P.Parsec String u Char
123tick = lexeme $ P.char '`'
125properName :: P.Parsec String u String
126properName = lexeme $ P.try ((:) <$> P.upper <*> many (PT.identLetter langDef) P.<?> "name")
128integerOrFloat :: P.Parsec String u (Either Integer Double)
129integerOrFloat = Left <$> P.try (PT.integer tokenParser) <|>
130 Right <$> P.try (PT.float tokenParser)
132augment :: 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
133augment p q f = (flip $ maybe id $ flip f) <$> p <*> P.optionMaybe q
135fold :: 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
136fold first more combine = do
137 a <- first
138 bs <- P.many more
139 return $ foldl combine a bs
141buildPostfixParser :: P.Stream s m t => [P.ParsecT s u m (a -> a)] -> P.ParsecT s u m a -> P.ParsecT s u m a
142buildPostfixParser f x = fold x (P.choice (map P.try f)) (flip ($))
144parseIdent :: P.Parsec String u Ident
145parseIdent = (Ident <$> identifier) <|> (Op <$> parens operator)
147parseIdentInfix :: P.Parsec String u Ident
148parseIdentInfix = (Ident <$> P.between tick tick identifier) <|> (Op <$> operator)
150mark :: P.Parsec String P.Column a -> P.Parsec String P.Column a
151mark p = do
152 current <- P.getState
153 pos <- P.sourceColumn <$> P.getPosition
154 P.putState pos
155 a <- p
156 P.putState current
157 return a
159checkIndentation :: (P.Column -> P.Column -> Bool) -> P.Parsec String P.Column ()
160checkIndentation rel = (do
161 col <- P.sourceColumn <$> P.getPosition
162 current <- P.getState
163 guard $ col `rel` current) <|> P.parserFail "Indentation check"
165indented :: P.Parsec String P.Column ()
166indented = checkIndentation (>)
168same :: P.Parsec String P.Column ()
169same = checkIndentation (==)
171runIndentParser :: P.Column -> P.Parsec String P.Column a -> String -> Either P.ParseError a
172runIndentParser col p = P.runParser p 0 ""