git.iko.soy/elk
on master help sign in
Call out to stringLiteral/charLiteral for string/char literal parsing
5ea3ec7Max New
compiler/Parse/Helpers.hs+60−39
compare with master
unifiedsplit
@@ -1,19 +1,21 @@
1module Parse.Helpers where
1module Parse.Helpers where
2
2
3import Prelude hiding (until)
3import Prelude hiding (until)
4−import Control.Applicative ((<$>),(<*>))
4+import Control.Applicative ((<$>),(<*>), (<$), pure)
5import Control.Monad
5import Control.Monad
6import Control.Monad.State
6import Control.Monad.State
7import Data.Char (isUpper)
7import Data.Char (isUpper)
8import qualified Data.Set as Set
8import qualified Data.Set as Set
9import qualified Data.Map as Map
9import qualified Data.Map as Map
10+import Text.Parsec hiding (newline,spaces,State)
11+import Text.Parsec.Indent
12+import qualified Text.Parsec.Token as P
13+
10import SourceSyntax.Helpers as Help
14import SourceSyntax.Helpers as Help
11import SourceSyntax.Location as Location
15import SourceSyntax.Location as Location
12import SourceSyntax.Expression
16import SourceSyntax.Expression
13import SourceSyntax.PrettyPrint
17import SourceSyntax.PrettyPrint
14import SourceSyntax.Declaration (Assoc)
18import SourceSyntax.Declaration (Assoc)
15−import Text.Parsec hiding (newline,spaces,State)
16−import Text.Parsec.Indent
17
19
18reserveds = [ "if", "then", "else"
20reserveds = [ "if", "then", "else"
19 , "case", "of"
21 , "case", "of"
@@ -45,7 +47,8 @@ jsReserveds = Set.fromList
45expecting = flip (<?>)
47expecting = flip (<?>)
46
48
47type OpTable = Map.Map String (Int, Assoc)
49type OpTable = Map.Map String (Int, Assoc)
50+type SourceM = State SourcePos
48−type IParser a = ParsecT String OpTable (State SourcePos) a
51+type IParser a = ParsecT String OpTable SourceM a
49
52
50iParse :: IParser a -> String -> Either ParseError a
53iParse :: IParser a -> String -> Either ParseError a
51iParse = iParseWithTable "" Map.empty
54iParse = iParseWithTable "" Map.empty
@@ -54,23 +57,6 @@ iParseWithTable :: SourceName -> OpTable -> IParser a -> String -> Either ParseE
54iParseWithTable sourceName table aParser input =
57iParseWithTable sourceName table aParser input =
55 runIndent sourceName $ runParserT aParser table sourceName input
58 runIndent sourceName $ runParserT aParser table sourceName input
56
59
57−readMaybe :: Read a => String -> Maybe a
58−readMaybe s =
59− case [ x | (x,t) <- reads s, ("","") <- lex t ] of
60− [x] -> Just x
61− _ -> Nothing
62−
63−backslashed :: IParser Char
64−backslashed = do
65− char '\\'
66− c <- anyChar
67− case readMaybe ['\'','\\',c,'\''] of
68− Just chr -> return chr
69− Nothing ->
70− fail $ "Did not recognize character '\\" ++ [c] ++
71− "'. If the backslash is meant to be a character of its own, " ++
72− "it should be escaped like this: \"\\\\" ++ [c] ++ "\""
73−
74var :: IParser String
60var :: IParser String
75var = makeVar (letter <|> char '_' <?> "variable")
61var = makeVar (letter <|> char '_' <?> "variable")
76
62
@@ -326,23 +312,58 @@ markdown interpolation = try (string "[markdown|") >> closeMarkdown "" []
326 ]
312 ]
327
313
328str :: IParser String
314str :: IParser String
315+str =
329−str = choice [ quote >> dewindows <$> manyTill (backslashed <|> anyChar) quote
316+ choice [ quote >> manyTill stringChar quote
330− , liftM dewindows . expecting "string" . betwixt '"' '"' . many $
317+ , expecting "string" . betwixt '"' '"' . many $ stringChar
331− backslashed <|> satisfy (/='"')
318+ ]
332− ]
319+ >>= parseStringLiteral . wrapQuotes '\"' . join
320+ where quote = try (string "\"\"\"")
321+
322+wrapQuotes :: Char -> String -> String
323+wrapQuotes delim s = (delim:s ++ [delim])
324+
325+stringChar :: IParser String
326+stringChar = newline <|> escaped '\"' <|> (pure <$> satisfy (/= '\"'))
333− where
327+ where newline = ['\\', 'n'] <$ char '\n'
334− quote = try (string "\"\"\"")
328+ <|> ['\\', 'r'] <$ char '\r'
335−
329+
336− -- Remove \r from strings to fix generated JavaScript
330+escaped :: Char -> IParser String
337− dewindows [] = []
331+escaped delim = try $ do
338− dewindows cs =
332+ char '\\'
339− let (pre, suf) = break (`elem` ['\r','\n']) cs
333+ c <- char '\\' <|> char delim
340− in pre ++ case suf of
334+ return ['\\', c]
341− ('\r':'\n':rest) -> '\n' : dewindows rest
342− ('\n':rest) -> '\n' : dewindows rest
343− ('\r':rest) -> '\n' : dewindows rest
344− _ -> []
345
335
346chr :: IParser Char
336chr :: IParser Char
347−chr = betwixt '\'' '\'' (backslashed <|> satisfy (/='\''))
337+chr = (betwixt '\'' '\'' (many1 (escaped '\'' <|> (pure <$> satisfy (/='\''))))
338+ >>= parseCharLiteral . wrapQuotes '\'' . join
339+ )
348− <?> "character"
340+ <?> "character"
341+
342+calloutParser :: String -> IParser a -> IParser a
343+calloutParser inp p = case iParse p inp of
344+ Left err -> fail . show $ err
345+ Right s -> return s
346+
347+parseStringLiteral :: String -> IParser String
348+parseStringLiteral s = calloutParser s . P.stringLiteral $ lexer
349+
350+parseCharLiteral :: String -> IParser Char
351+parseCharLiteral s = calloutParser s . P.charLiteral $ lexer
352+
353+lexer = P.makeTokenParser elmDef
354+
355+-- I don't know how many of these are necessary for charLiteral/stringLiteral
356+elmDef :: P.GenLanguageDef String u SourceM
357+elmDef = P.LanguageDef {
358+ P.commentStart = "{-"
359+ , P.commentEnd = "-}"
360+ , P.commentLine = "--"
361+ , P.nestedComments = True
362+ , P.identStart = undefined
363+ , P.identLetter = undefined
364+ , P.opStart = undefined
365+ , P.opLetter = undefined
366+ , P.reservedNames = reserveds
367+ , P.reservedOpNames = [":", "->", "<-", "|"]
368+ , P.caseSensitive = True
369+ }