git.iko.soy/rowtype-yoga/purescript-native
on d66e332 help sign in
rowtype-yoga/purescript-native/src/PureScript/Parser/Common.hs
175 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 , "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"
66 , "Number"
67 , "String"
68 , "Boolean" ]
70reservedOpNames :: [String]
71reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"
72 , "==", "!=", "&", "^", "|", "&&", "||" ]
74identStart :: P.Parsec String u Char
75identStart = P.lower <|> P.oneOf "_$"
77properNameStart :: P.Parsec String u Char
78properNameStart = P.upper
80identLetter :: P.Parsec String u Char
81identLetter = P.alphaNum <|> P.oneOf "_'"
83opStart :: P.Parsec String u Char
84opStart = P.oneOf "!#$%&*+/<=>?@^|-~"
86opLetter :: P.Parsec String u Char
87opLetter = P.oneOf ":#$%&*+./<=>?@^|"
89langDef = PT.LanguageDef
90 { PT.reservedNames = reservedNames
91 , PT.reservedOpNames = reservedOpNames
92 , PT.commentStart = "{-"
93 , PT.commentEnd = "-}"
94 , PT.commentLine = "--"
95 , PT.nestedComments = True
96 , PT.identStart = identStart
97 , PT.identLetter = identLetter
98 , PT.opStart = opStart
99 , PT.opLetter = opLetter
100 , PT.caseSensitive = True
101 }
103tokenParser = PT.makeTokenParser langDef
105lexeme = PT.lexeme tokenParser
106identifier = PT.identifier tokenParser
107reserved = PT.reserved tokenParser
108reservedOp = PT.reservedOp tokenParser
109operator = PT.operator tokenParser
110stringLiteral = PT.stringLiteral tokenParser
111whiteSpace = PT.whiteSpace tokenParser
112parens = PT.parens tokenParser
113braces = PT.braces tokenParser
114angles = PT.angles tokenParser
115squares = PT.squares tokenParser
116semi = PT.semi tokenParser
117comma = PT.comma tokenParser
118colon = PT.colon tokenParser
119dot = PT.dot tokenParser
120semiSep = PT.semiSep tokenParser
121semiSep1 = PT.semiSep1 tokenParser
122commaSep = PT.commaSep tokenParser
123commaSep1 = PT.commaSep1 tokenParser
125tick :: P.Parsec String u Char
126tick = lexeme $ P.char '`'
128properName :: P.Parsec String u String
129properName = lexeme $ P.try ((:) <$> P.upper <*> many (PT.identLetter langDef) P.<?> "name")
131integerOrFloat :: P.Parsec String u (Either Integer Double)
132integerOrFloat = Left <$> P.try (PT.integer tokenParser) <|>
133 Right <$> P.try (PT.float tokenParser)
135augment :: 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
136augment p q f = (flip $ maybe id $ flip f) <$> p <*> P.optionMaybe q
138fold :: 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
139fold first more combine = do
140 a <- first
141 bs <- P.many more
142 return $ foldl combine a bs
144buildPostfixParser :: P.Stream s m t => [P.ParsecT s u m (a -> a)] -> P.ParsecT s u m a -> P.ParsecT s u m a
145buildPostfixParser f x = fold x (P.choice (map P.try f)) (flip ($))
147parseIdent :: P.Parsec String u Ident
148parseIdent = (Ident <$> identifier) <|> (Op <$> parens operator)
150parseIdentInfix :: P.Parsec String u Ident
151parseIdentInfix = (Ident <$> P.between tick tick identifier) <|> (Op <$> operator)
153mark :: P.Parsec String P.Column a -> P.Parsec String P.Column a
154mark p = do
155 current <- P.getState
156 pos <- P.sourceColumn <$> P.getPosition
157 P.putState pos
158 a <- p
159 P.putState current
160 return a
162checkIndentation :: (P.Column -> P.Column -> Bool) -> P.Parsec String P.Column ()
163checkIndentation rel = (do
164 col <- P.sourceColumn <$> P.getPosition
165 current <- P.getState
166 guard $ col `rel` current) <|> P.parserFail "Indentation check"
168indented :: P.Parsec String P.Column ()
169indented = checkIndentation (>)
171same :: P.Parsec String P.Column ()
172same = checkIndentation (==)
174runIndentParser :: P.Column -> P.Parsec String P.Column a -> String -> Either P.ParseError a
175runIndentParser col p = P.runParser p 0 ""