@@ -3,17 +3,20 @@ module Parse.Literal (literal, shader) where
4import Prelude hiding (exponent)
4import Prelude hiding (exponent)
5import Control.Monad (join)
5import Control.Monad (join)
6+import qualified Data.Char as Char
7+import qualified Data.List as List
6import qualified Data.Map as Map
8import qualified Data.Map as Map
7import qualified Language.GLSL.Parser as GLP
9import qualified Language.GLSL.Parser as GLP
8import qualified Language.GLSL.Syntax as GLS
10import qualified Language.GLSL.Syntax as GLS
9import Text.Parsec
11import Text.Parsec
10− ( ParseError, (<|>), (<?>), anyChar, char, choice, digit, hexDigit
12+ ( ParseError, (<|>), anyChar, char, choice, digit, getPosition
11− , lookAhead, many1, manyTill, notFollowedBy, option, parserFail
13+ , hexDigit, lookAhead, many1, option, parserFail, satisfy
12− , string, try
14+ , setPosition, string, try, upper
15−import Parse.Helpers (IParser, expecting)
16import qualified AST.Literal as L
17import qualified AST.Literal as L
18+import Parse.Helpers (IParser, expecting, failure)
19+import qualified Reporting.Error.Syntax as Error
@@ -24,8 +27,8 @@ literal :: IParser L.Literal
26 [ toLiteral <$> rawNumber
29 [ toLiteral <$> rawNumber
27− , L.Str <$> str
30+ , stringLiteral
28− , L.Chr <$> chr
31+ , charLiteral
@@ -89,74 +92,169 @@ exponent =
92−-- STRINGS
95+-- CHARACTERS
95−str :: IParser String
98+charLiteral :: IParser L.Literal
97− expecting "a string like \"hello\"" $
100+ expecting "a character like 'c'" $
101+ do start <- getPosition
98− choice [ multiStr, singleStr ]
104+ choice
105+ [ char '\\' >> escapeCode
106+ , satisfy (\c -> c /= '\'' && c > '\026')
110+ return (L.Chr firstChar)
111+ , do setPosition start
112+ failure Error.singleQuotes
101−delimitedSequence :: IParser a -> IParser String -> IParser String
102−delimitedSequence quote insides =
104− concat <$> manyTill insides quote
107−multiStr :: IParser String
109− delimitedSequence (try (string "\"\"\"")) multilineStringChar
120+stringLiteral :: IParser L.Literal
122+ expecting "a string like \"hello\"" $
125+ [ do try (string "\"\"")
126+ multiStringClose mempty
127+ , do singleStringClose mempty
112−singleStr :: IParser String
114− delimitedSequence (char '"') ((:[]) <$> anyChar)
131+singleStringClose :: (String -> String) -> IParser L.Literal
132+singleStringClose builder =
135+ return (L.Str (builder ""))
139+ singleStringClose builder
140+ , do c <- escapeCode
141+ singleStringClose (\end -> builder (c : end))
143+ , do c <- satisfy (\c -> c > '\026')
144+ singleStringClose (\end -> builder (c : end))
145+ , failure "Not expecting a character like this in a string."
118−-- CHARACTERS
149+multiStringClose :: (String -> String) -> IParser L.Literal
150+multiStringClose builder =
152+ [ do try (string "\"\"\"")
153+ return (L.Str (builder ""))
155+ multiStringClose (\end -> builder ('\n' : end))
159+ multiStringClose builder
160+ , do c <- escapeCode
161+ multiStringClose (\end -> builder (c : end))
163+ , do c <- satisfy (\c -> c > '\026')
164+ multiStringClose (\end -> builder (c : end))
165+ , failure "Not expecting a character like this in a multi-line string."
121−chr :: IParser Char
169+escapeCode :: IParser Char
122−chr =
170+escapeCode =
123− expecting "a character like 'x'" $
171+ choice
124− do char '\''
172+ [ do char '^'
125− myChar <- anyChar <?> "a character"
173+ code <- upper
126− char '\''
174+ return (toEnum (fromEnum code - fromEnum 'A' + 1))
127− return myChar
175+ -- NUMBERS
176+ , do parseCode 10 digit
178+ parseCode 16 hexDigit
131− "Elm uses double quotes for strings. Switch\
132− \ the ' to \" on both ends of the string and\
133− \ you should be all set!"
228+c2c :: Char -> Char -> IParser Char
229+c2c escapedChar resultingChar =
231+ return resultingChar
234+s2c :: String -> Char -> IParser Char
235+s2c escapedString resultingChar =
236+ do string escapedString
237+ return resultingChar
140−multilineStringChar :: IParser String
141−multilineStringChar =
142− do notFollowedBy (string "\"\"\"")
145− , escapeQuotes <$> anyChar
240+parseCode :: Integer -> IParser Char -> IParser Char
241+parseCode base baseDigit =
242+ do start <- getPosition
243+ code <- parseNumber base baseDigit
246+ return (toEnum (fromInteger code))
149−escapeQuotes :: Char -> String
151− if c == '\"' then "\\\"" else [c]
248+ else
249+ do setPosition start
250+ fail "This code is too big! UTF-8 only goes to 10FFFF."
154−newlineChar :: IParser String
253+parseNumber :: Integer -> IParser Char -> IParser Integer
155−newlineChar =
254+parseNumber base baseDigit =
156− choice
255+ do digits <- many1 baseDigit
157− [ char '\n' >> return "\\n"
256+ let n = List.foldl' (\x d -> base * x + toInteger (Char.digitToInt d)) 0 digits
158− , char '\r' >> return "\\r"
257+ seq n (return n)