git.iko.soy/rowtype-yoga/purescript-native
on 446c911 help sign in
rowtype-yoga/purescript-native/src/PureScript/Parser/Common.hs
152 lines 4.9 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" ]
50reservedOpNames :: [String]
51reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"
52 , "==", "!=", "&", "^", "|", "&&", "||" ]
54identStart :: P.Parsec String u Char
55identStart = P.lower <|> P.oneOf "_$"
57properNameStart :: P.Parsec String u Char
58properNameStart = P.upper
60identLetter :: P.Parsec String u Char
61identLetter = P.alphaNum <|> P.oneOf "_'"
63opStart :: P.Parsec String u Char
64opStart = P.oneOf "!#$%&*+/<=>?@^|-~"
66opLetter :: P.Parsec String u Char
67opLetter = P.oneOf ":#$%&*+./<=>?@^|"
69langDef = PT.LanguageDef
70 { PT.reservedNames = reservedNames
71 , PT.reservedOpNames = reservedOpNames
72 , PT.commentStart = "{-"
73 , PT.commentEnd = "-}"
74 , PT.commentLine = "--"
75 , PT.nestedComments = True
76 , PT.identStart = identStart
77 , PT.identLetter = identLetter
78 , PT.opStart = opStart
79 , PT.opLetter = opLetter
80 , PT.caseSensitive = True
81 }
83tokenParser = PT.makeTokenParser langDef
85lexeme = PT.lexeme tokenParser
86identifier = PT.identifier tokenParser
87reserved = PT.reserved tokenParser
88reservedOp = PT.reservedOp tokenParser
89operator = PT.operator tokenParser
90stringLiteral = PT.stringLiteral tokenParser
91whiteSpace = PT.whiteSpace tokenParser
92parens = PT.parens tokenParser
93braces = PT.braces tokenParser
94angles = PT.angles tokenParser
95squares = PT.squares tokenParser
96semi = PT.semi tokenParser
97comma = PT.comma tokenParser
98colon = PT.colon tokenParser
99dot = PT.dot tokenParser
100semiSep = PT.semiSep tokenParser
101semiSep1 = PT.semiSep1 tokenParser
102commaSep = PT.commaSep tokenParser
103commaSep1 = PT.commaSep1 tokenParser
105tick :: P.Parsec String u Char
106tick = lexeme $ P.char '`'
108properName :: P.Parsec String u String
109properName = lexeme $ P.try ((:) <$> P.upper <*> many (PT.identLetter langDef) P.<?> "name")
111integerOrFloat :: P.Parsec String u (Either Integer Double)
112integerOrFloat = Left <$> P.try (PT.integer tokenParser) <|>
113 Right <$> P.try (PT.float tokenParser)
115augment :: 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
116augment p q f = (flip $ maybe id $ flip f) <$> p <*> P.optionMaybe q
118fold :: 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
119fold first more combine = do
120 a <- first
121 bs <- P.many more
122 return $ foldl combine a bs
124parseIdent :: P.Parsec String u Ident
125parseIdent = (Ident <$> identifier) <|> (Op <$> parens operator)
127parseIdentInfix :: P.Parsec String u Ident
128parseIdentInfix = (Ident <$> P.between tick tick identifier) <|> (Op <$> operator)
130mark :: P.Parsec String P.Column a -> P.Parsec String P.Column a
131mark p = do
132 current <- P.getState
133 pos <- P.sourceColumn <$> P.getPosition
134 P.putState pos
135 a <- p
136 P.putState current
137 return a
139checkIndentation :: (P.Column -> P.Column -> Bool) -> P.Parsec String P.Column ()
140checkIndentation rel = (do
141 col <- P.sourceColumn <$> P.getPosition
142 current <- P.getState
143 guard $ col `rel` current) <|> P.parserFail "Indentation check"
145indented :: P.Parsec String P.Column ()
146indented = checkIndentation (>)
148same :: P.Parsec String P.Column ()
149same = checkIndentation (==)
151runIndentParser :: P.Column -> P.Parsec String P.Column a -> String -> Either P.ParseError a
152runIndentParser col p = P.runParser p 0 ""