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