git.iko.soy/elk
on master help sign in
Cosmetic: make some style changes to make it look more like the rest of the compiler
61dd68bEvan Czaplicki
compiler/Parse/Helpers.hs+58−57
compare with master
unifiedsplit
@@ -1,7 +1,8 @@
1+{-# OPTIONS_GHC -W #-}
1module Parse.Helpers where
2module Parse.Helpers where
2
3
3import Prelude hiding (until)
4import Prelude hiding (until)
4−import Control.Applicative ((<$>),(<*>), (<$), pure)
5+import Control.Applicative ((<$>),(<*>))
5import Control.Monad
6import Control.Monad
6import Control.Monad.State
7import Control.Monad.State
7import Data.Char (isUpper)
8import Data.Char (isUpper)
@@ -9,7 +10,7 @@ import qualified Data.Set as Set
9import qualified Data.Map as Map
10import qualified Data.Map as Map
10import Text.Parsec hiding (newline,spaces,State)
11import Text.Parsec hiding (newline,spaces,State)
11import Text.Parsec.Indent
12import Text.Parsec.Indent
12−import qualified Text.Parsec.Token as P
13+import qualified Text.Parsec.Token as T
13
14
14import SourceSyntax.Helpers as Help
15import SourceSyntax.Helpers as Help
15import SourceSyntax.Location as Location
16import SourceSyntax.Location as Location
@@ -311,31 +312,35 @@ markdown interpolation = try (string "[markdown|") >> closeMarkdown "" []
311 closeMarkdown (md ++ [c]) stuff
312 closeMarkdown (md ++ [c]) stuff
312 ]
313 ]
313
314
314−str :: IParser String
315+--str :: IParser String
315−str = expecting "String" $
316+str = expecting "String" $ do
316− choice [ quote >> manyTill multilineStringChar quote
317+ s <- choice [ multiStr, singleStr ]
317− , char '"' >> manyTill stringChar (char '"')
318+ processAs T.stringLiteral . sandwich '\"' $ concat s
318− ]
319− >>= parseStringLiteral . wrapQuotes '\"' . join
320− where quote = try (string "\"\"\"")
319+ where
320+ rawString quote insides =
321+ quote >> manyTill insides quote
321
322
322−wrapQuotes :: Char -> String -> String
323+ multiStr = rawString (try (string "\"\"\"")) multilineStringChar
323−wrapQuotes delim s = (delim:s ++ [delim])
324+ singleStr = rawString (char '"') stringChar
324
325
325−stringChar :: IParser String
326+ stringChar :: IParser String
326−stringChar = newlineChar <|> escaped '\"' <|> (pure <$> satisfy (/= '\"'))
327+ stringChar = choice [ newlineChar, escaped '\"', (:[]) <$> satisfy (/= '\"') ]
327
328
328−multilineStringChar :: IParser String
329+ multilineStringChar :: IParser String
329−multilineStringChar = noEnd
330+ multilineStringChar =
331+ do noEnd
330− >> (newlineChar <|> escaped '\"' <|> expandQuote <$> anyChar)
332+ choice [ newlineChar, escaped '\"', expandQuote <$> anyChar ]
333+ where
331− where noEnd = notFollowedBy (string "\"\"\"")
334+ noEnd = notFollowedBy (string "\"\"\"")
332− expandQuote c = if c == '\"'
335+ expandQuote c = if c == '\"' then "\\\"" else [c]
333− then "\\\""
334− else [c]
335
336
336−newlineChar :: IParser String
337+ newlineChar :: IParser String
337−newlineChar = ['\\', 'n'] <$ char '\n'
338+ newlineChar =
338− <|> ['\\', 'r'] <$ char '\r'
339+ choice [ char '\n' >> return "\\n"
340+ , char '\r' >> return "\\r" ]
341+
342+sandwich :: Char -> String -> String
343+sandwich delim s = delim : s ++ [delim]
339
344
340escaped :: Char -> IParser String
345escaped :: Char -> IParser String
341escaped delim = try $ do
346escaped delim = try $ do
@@ -344,37 +349,33 @@ escaped delim = try $ do
344 return ['\\', c]
349 return ['\\', c]
345
350
346chr :: IParser Char
351chr :: IParser Char
347−chr = (betwixt '\'' '\''
352+chr = betwixt '\'' '\'' character <?> "character"
353+ where
354+ character = do
348− (many1 (escaped '\'' <|> (pure <$> satisfy (/='\''))))
355+ c <- many1 $ choice [ escaped '\'', (:[]) <$> satisfy (/='\'') ]
349− >>= parseCharLiteral . wrapQuotes '\'' . join
356+ processAs T.charLiteral . sandwich '\'' $ concat c
350− )
357+
351− <?> "character"
358+processAs :: (T.GenTokenParser String u SourceM -> IParser a) -> String -> IParser a
352−
359+processAs processor s = calloutParser s (processor lexer)
360+ where
353−calloutParser :: String -> IParser a -> IParser a
361+ calloutParser :: String -> IParser a -> IParser a
354−calloutParser inp p = case iParse p inp of
362+ calloutParser inp p = either (fail . show) return (iParse p inp)
355− Left err -> fail . show $ err
363+
356− Right s -> return s
364+ lexer :: T.GenTokenParser String u SourceM
357−
358−parseStringLiteral :: String -> IParser String
359−parseStringLiteral s = calloutParser s . P.stringLiteral $ lexer
360−
361−parseCharLiteral :: String -> IParser Char
362−parseCharLiteral s = calloutParser s . P.charLiteral $ lexer
363−
364−lexer = P.makeTokenParser elmDef
365+ lexer = T.makeTokenParser elmDef
365−
366+
366−-- I don't know how many of these are necessary for charLiteral/stringLiteral
367+ -- I don't know how many of these are necessary for charLiteral/stringLiteral
367−elmDef :: P.GenLanguageDef String u SourceM
368+ elmDef :: T.GenLanguageDef String u SourceM
368−elmDef = P.LanguageDef {
369+ elmDef = T.LanguageDef
369− P.commentStart = "{-"
370+ { T.commentStart = "{-"
370− , P.commentEnd = "-}"
371+ , T.commentEnd = "-}"
371− , P.commentLine = "--"
372+ , T.commentLine = "--"
372− , P.nestedComments = True
373+ , T.nestedComments = True
373− , P.identStart = undefined
374+ , T.identStart = undefined
374− , P.identLetter = undefined
375+ , T.identLetter = undefined
375− , P.opStart = undefined
376+ , T.opStart = undefined
376− , P.opLetter = undefined
377+ , T.opLetter = undefined
377− , P.reservedNames = reserveds
378+ , T.reservedNames = reserveds
378− , P.reservedOpNames = [":", "->", "<-", "|"]
379+ , T.reservedOpNames = [":", "->", "<-", "|"]
379− , P.caseSensitive = True
380+ , T.caseSensitive = True
380− }
381+ }