@@ -3,17 +3,20 @@ module Parse.Literal (literal, shader) where
33
44import Prelude hiding (exponent)
55import Control.Monad (join)
6+import qualified Data.Char as Char
7+import qualified Data.List as List
68import qualified Data.Map as Map
79import qualified Language.GLSL.Parser as GLP
810import qualified Language.GLSL.Syntax as GLS
911import Text.Parsec
10− ( ParseError, (<|>), (<?>), anyChar, char, choice, digit, hexDigit
11− , lookAhead, many1, manyTill, notFollowedBy, option, parserFail
12− , string, try
12+ ( ParseError, (<|>), anyChar, char, choice, digit, getPosition
13+ , hexDigit, lookAhead, many1, option, parserFail, satisfy
14+ , setPosition, string, try, upper
1315 )
1416
15−import Parse.Helpers (IParser, expecting)
1617import qualified AST.Literal as L
18+import Parse.Helpers (IParser, expecting, failure)
19+import qualified Reporting.Error.Syntax as Error
1720
1821
1922
@@ -24,8 +27,8 @@ literal :: IParser L.Literal
2427literal =
2528 choice
2629 [ toLiteral <$> rawNumber
27− , L.Str <$> str
28− , L.Chr <$> chr
30+ , stringLiteral
31+ , charLiteral
2932 ]
3033
3134
@@ -89,74 +92,169 @@ exponent =
8992
9093
9194
92−-- STRINGS
95+-- CHARACTERS
9396
9497
95−str :: IParser String
96−str =
97− expecting "a string like \"hello\"" $
98− choice [ multiStr, singleStr ]
98+charLiteral :: IParser L.Literal
99+charLiteral =
100+ expecting "a character like 'c'" $
101+ do start <- getPosition
102+ char '\''
103+ firstChar <-
104+ choice
105+ [ char '\\' >> escapeCode
106+ , satisfy (\c -> c /= '\'' && c > '\026')
107+ ]
108+ choice
109+ [ do char '\''
110+ return (L.Chr firstChar)
111+ , do setPosition start
112+ failure Error.singleQuotes
113+ ]
99114
100115
101−delimitedSequence :: IParser a -> IParser String -> IParser String
102−delimitedSequence quote insides =
103− do quote
104− concat <$> manyTill insides quote
105116
117+-- STRINGS
106118
107−multiStr :: IParser String
108−multiStr =
109− delimitedSequence (try (string "\"\"\"")) multilineStringChar
110119
120+stringLiteral :: IParser L.Literal
121+stringLiteral =
122+ expecting "a string like \"hello\"" $
123+ do char '"'
124+ choice
125+ [ do try (string "\"\"")
126+ multiStringClose mempty
127+ , do singleStringClose mempty
128+ ]
111129
112−singleStr :: IParser String
113−singleStr =
114− delimitedSequence (char '"') ((:[]) <$> anyChar)
115130
131+singleStringClose :: (String -> String) -> IParser L.Literal
132+singleStringClose builder =
133+ choice
134+ [ do char '"'
135+ return (L.Str (builder ""))
136+ , do char '\\'
137+ choice
138+ [ do char '&'
139+ singleStringClose builder
140+ , do c <- escapeCode
141+ singleStringClose (\end -> builder (c : end))
142+ ]
143+ , do c <- satisfy (\c -> c > '\026')
144+ singleStringClose (\end -> builder (c : end))
145+ , failure "Not expecting a character like this in a string."
146+ ]
116147
117148
118−-- CHARACTERS
149+multiStringClose :: (String -> String) -> IParser L.Literal
150+multiStringClose builder =
151+ choice
152+ [ do try (string "\"\"\"")
153+ return (L.Str (builder ""))
154+ , do char '\n'
155+ multiStringClose (\end -> builder ('\n' : end))
156+ , do char '\\'
157+ choice
158+ [ do char '&'
159+ multiStringClose builder
160+ , do c <- escapeCode
161+ multiStringClose (\end -> builder (c : end))
162+ ]
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."
166+ ]
119167
120168
121−chr :: IParser Char
122−chr =
123− expecting "a character like 'x'" $
124− do char '\''
125− myChar <- anyChar <?> "a character"
126− char '\''
127− return myChar
169+escapeCode :: IParser Char
170+escapeCode =
171+ choice
172+ [ do char '^'
173+ code <- upper
174+ return (toEnum (fromEnum code - fromEnum 'A' + 1))
175+ -- NUMBERS
176+ , do parseCode 10 digit
177+ , do char 'x'
178+ parseCode 16 hexDigit
179+ -- ESCAPES
180+ , c2c 'a' '\a'
181+ , c2c 'b' '\b'
182+ , c2c 'f' '\f'
183+ , c2c 'n' '\n'
184+ , c2c 'r' '\r'
185+ , c2c 't' '\t'
186+ , c2c 'v' '\v'
187+ , c2c '"' '"'
188+ , c2c '\\' '\\'
189+ , c2c '\'' '\''
190+ -- ASCII CODES
191+ , s2c "BS" '\BS'
192+ , s2c "HT" '\HT'
193+ , s2c "LF" '\LF'
194+ , s2c "VT" '\VT'
195+ , s2c "FF" '\FF'
196+ , s2c "CR" '\CR'
197+ , s2c "SO" '\SO'
198+ , s2c "SI" '\SI'
199+ , s2c "EM" '\EM'
200+ , s2c "FS" '\FS'
201+ , s2c "GS" '\GS'
202+ , s2c "RS" '\RS'
203+ , s2c "US" '\US'
204+ , s2c "SP" '\SP'
205+ , s2c "NUL" '\NUL'
206+ , s2c "SOH" '\SOH'
207+ , s2c "STX" '\STX'
208+ , s2c "ETX" '\ETX'
209+ , s2c "EOT" '\EOT'
210+ , s2c "ENQ" '\ENQ'
211+ , s2c "ACK" '\ACK'
212+ , s2c "BEL" '\BEL'
213+ , s2c "DLE" '\DLE'
214+ , s2c "DC1" '\DC1'
215+ , s2c "DC2" '\DC2'
216+ , s2c "DC3" '\DC3'
217+ , s2c "DC4" '\DC4'
218+ , s2c "NAK" '\NAK'
219+ , s2c "SYN" '\SYN'
220+ , s2c "ETB" '\ETB'
221+ , s2c "CAN" '\CAN'
222+ , s2c "SUB" '\SUB'
223+ , s2c "ESC" '\ESC'
224+ , s2c "DEL" '\DEL'
225+ ]
128226
129−{-
130− failure $
131− "Elm uses double quotes for strings. Switch\
132− \ the ' to \" on both ends of the string and\
133− \ you should be all set!"
134−-}
135227
228+c2c :: Char -> Char -> IParser Char
229+c2c escapedChar resultingChar =
230+ do char escapedChar
231+ return resultingChar
136232
137−-- CHARACTER HELPERS
138233
234+s2c :: String -> Char -> IParser Char
235+s2c escapedString resultingChar =
236+ do string escapedString
237+ return resultingChar
139238
140−multilineStringChar :: IParser String
141−multilineStringChar =
142− do notFollowedBy (string "\"\"\"")
143− choice
144− [ newlineChar
145− , escapeQuotes <$> anyChar
146− ]
147239
240+parseCode :: Integer -> IParser Char -> IParser Char
241+parseCode base baseDigit =
242+ do start <- getPosition
243+ code <- parseNumber base baseDigit
244+ if code <= 0x10FFFF
245+ then
246+ return (toEnum (fromInteger code))
148247
149−escapeQuotes :: Char -> String
150−escapeQuotes c =
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."
152251
153252
154−newlineChar :: IParser String
155−newlineChar =
156− choice
157− [ char '\n' >> return "\\n"
158− , char '\r' >> return "\\r"
159− ]
253+parseNumber :: Integer -> IParser Char -> IParser Integer
254+parseNumber base baseDigit =
255+ do digits <- many1 baseDigit
256+ let n = List.foldl' (\x d -> base * x + toInteger (Char.digitToInt d)) 0 digits
257+ seq n (return n)
160258
161259
162260