5fb0d04 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Simplify escape characters

5fb0d04Evan Czaplicki9 years ago

src/Parse/Primitives.hs+255−158

compare with master

unifiedsplit

@@ -23,6 +23,8 @@ import Prelude hiding (length)

23import qualified Control.Applicative as Applicative ( Applicative(..), Alternative(..) )

24import Control.Monad

25import qualified Data.ByteString as BS

26+import qualified Data.ByteString.Builder as BS (toLazyByteString, word16HexFixed)

27+import qualified Data.ByteString.Lazy as BS (toStrict)

26import qualified Data.Char as Char

28import qualified Data.Char as Char

27import Data.Monoid ((<>))

29import Data.Monoid ((<>))

28import qualified Data.Set as Set

30import qualified Data.Set as Set

@@ -33,7 +35,7 @@ import qualified Data.Text.Encoding as Text

33import qualified Data.Text.Internal as Text

35import qualified Data.Text.Internal as Text

34import qualified Data.Text.Unsafe as Text

36import qualified Data.Text.Unsafe as Text

35import qualified Data.Text.Lazy as LT

37import qualified Data.Text.Lazy as LT

36−import qualified Data.Text.Lazy.Builder as LB

38+import qualified Data.Text.Lazy.Builder as B

37import Data.Text.Internal.Encoding.Utf16 (chr2)

39import Data.Text.Internal.Encoding.Utf16 (chr2)

38import Data.Text.Internal.Unsafe.Char (unsafeChr)

40import Data.Text.Internal.Unsafe.Char (unsafeChr)

39import GHC.Word (Word8, Word16)

41import GHC.Word (Word8, Word16)

@@ -107,19 +109,24 @@ runAt sRow sCol parser (Text.Text array offset length) =

107 Err (ParseError row col problem) ->

109 Err (ParseError row col problem) ->

108 let

110 let

109 pos = R.Position row col

111 pos = R.Position row col

110− region = R.Region pos pos

111 mkError overallRegion subRegion =

112 mkError overallRegion subRegion =

112 Left (A.A overallRegion (E.Parse subRegion problem))

113 Left (A.A overallRegion (E.Parse subRegion problem))

113 in

114 in

114 case problem of

115 case problem of

116+ BadChar endCol ->

117+ mkError (R.Region pos (R.Position row endCol)) Nothing

118+

119+ BadEscape width _ ->

120+ mkError (R.Region pos (R.Position row (col + width))) Nothing

121+

115 BadOp _ ((_, start) : _) ->

122 BadOp _ ((_, start) : _) ->

116− mkError (R.Region start pos) (Just region)

123+ mkError (R.Region start pos) (Just (R.Region pos pos))

117

124

118 Theories ((_, start) : _) _ ->

125 Theories ((_, start) : _) _ ->

119− mkError (R.Region start pos) (Just region)

126+ mkError (R.Region start pos) (Just (R.Region pos pos))

120

127

121 _ ->

128 _ ->

122− mkError region Nothing

129+ mkError (R.Region pos pos) Nothing

123

130

124

131

125data Result a

132data Result a

@@ -323,7 +330,7 @@ moveCursor array offset length row col =

323 if word == 0x000A {- \n -} then

330 if word == 0x000A {- \n -} then

324 moveCursor array (offset + 1) (length - 1) (row + 1) 1

331 moveCursor array (offset + 1) (length - 1) (row + 1) 1

325

332

326− else if word < 0xD800 || word > 0xDBFF then

333+ else if word < 0xD800 || 0xDBFF < word then

327 moveCursor array (offset + 1) (length - 1) row (col + 1)

334 moveCursor array (offset + 1) (length - 1) row (col + 1)

328

335

329 else

336 else

@@ -447,7 +454,7 @@ peek array offset =

447 let

454 let

448 !word = Text.unsafeIndex array offset

455 !word = Text.unsafeIndex array offset

449 in

456 in

450− if word < 0xD800 || word > 0xDBFF then

457+ if word < 0xD800 || 0xDBFF < word then

451 Text.Iter (unsafeChr word) 1

458 Text.Iter (unsafeChr word) 1

452 else

459 else

453 Text.Iter (chr2 word (Text.unsafeIndex array (offset + 1))) 2

460 Text.Iter (chr2 word (Text.unsafeIndex array (offset + 1))) 2

@@ -459,7 +466,7 @@ peekChar array offset =

459 let

466 let

460 !word = Text.unsafeIndex array offset

467 !word = Text.unsafeIndex array offset

461 in

468 in

462− if word < 0xD800 || word > 0xDBFF then

469+ if word < 0xD800 || 0xDBFF < word then

463 unsafeChr word

470 unsafeChr word

464 else

471 else

465 chr2 word (Text.unsafeIndex array (offset + 1))

472 chr2 word (Text.unsafeIndex array (offset + 1))

@@ -661,7 +668,7 @@ eatLineCommentHelp array offset length row col =

661 if word == 0x000A {- \n -} then

668 if word == 0x000A {- \n -} then

662 eatSpaces array (offset + 1) (length - 1) (row + 1) 1

669 eatSpaces array (offset + 1) (length - 1) (row + 1) 1

663

670

664− else if word < 0xD800 || word > 0xDBFF then

671+ else if word < 0xD800 || 0xDBFF < word then

665 eatLineCommentHelp array (offset + 1) (length - 1) row (col + 1)

672 eatLineCommentHelp array (offset + 1) (length - 1) row (col + 1)

666

673

667 else

674 else

@@ -715,7 +722,7 @@ eatMultiCommentHelp array offset length row col openComments =

715

722

716 eatMultiCommentHelp array (offset + 2) (length - 2) row (col + 2) (openComments + 1)

723 eatMultiCommentHelp array (offset + 2) (length - 2) row (col + 2) (openComments + 1)

717

724

718− else if word < 0xD800 || word > 0xDBFF then

725+ else if word < 0xD800 || 0xDBFF < word then

719

726

720 eatMultiCommentHelp array (offset + 1) (length - 1) row (col + 1) openComments

727 eatMultiCommentHelp array (offset + 1) (length - 1) row (col + 1) openComments

721

728

@@ -771,7 +778,7 @@ eatDocs array offset length row col =

771 if word == 0x000A {- \n -} then

778 if word == 0x000A {- \n -} then

772 eatDocs array (offset + 1) (length - 1) (row + 1) 1

779 eatDocs array (offset + 1) (length - 1) (row + 1) 1

773

780

774− else if word < 0xD800 || word > 0xDBFF then

781+ else if word < 0xD800 || 0xDBFF < word then

775 eatDocs array (offset + 1) (length - 1) row (col + 1)

782 eatDocs array (offset + 1) (length - 1) row (col + 1)

776

783

777 else

784 else

@@ -819,7 +826,7 @@ string =

819

826

820 Right ( newOffset, newLength, newCol, builder ) ->

827 Right ( newOffset, newLength, newCol, builder ) ->

821 cok

828 cok

822− (LT.toStrict (LB.toLazyText builder))

829+ (LT.toStrict (B.toLazyText builder))

823 (State array newOffset newLength indent row newCol ctx)

830 (State array newOffset newLength indent row newCol ctx)

824 noError

831 noError

825

832

@@ -834,7 +841,7 @@ isQuote array offset =

834-- SINGLE STRINGS

841-- SINGLE STRINGS

835

842

836

843

837−singleString :: Text.Array -> Int -> Int -> Int -> Int -> Int -> LB.Builder -> Either ParseError ( Int, Int, Int, LB.Builder )

844+singleString :: Text.Array -> Int -> Int -> Int -> Int -> Int -> B.Builder -> Either ParseError ( Int, Int, Int, B.Builder )

838singleString array offset length row col initialOffset builder =

845singleString array offset length row col initialOffset builder =

839 if length == 0 then

846 if length == 0 then

840 Left (ParseError row col EndOfFile_String)

847 Left (ParseError row col EndOfFile_String)

@@ -844,75 +851,55 @@ singleString array offset length row col initialOffset builder =

844 !word = Text.unsafeIndex array offset

851 !word = Text.unsafeIndex array offset

845 in

852 in

846 if word == 0x0022 {- " -} then

853 if word == 0x0022 {- " -} then

847− let

854+ Right

848− finalBuilder =

855+ ( offset + 1

849− mappend builder $ LB.fromText $

856+ , length - 1

857+ , col + 1

850− Text.Text array initialOffset (offset - initialOffset)

858+ , builder <> B.fromText (copyText array initialOffset (offset - initialOffset))

851− in

859+ )

852− Right ( offset + 1, length - 1, col + 1, finalBuilder )

853

860

854 else if word == 0x000A {- \n -} then

861 else if word == 0x000A {- \n -} then

855 Left (ParseError row col NewLineInString)

862 Left (ParseError row col NewLineInString)

856

863

857 else if word == 0x0027 {- ' -} then

864 else if word == 0x0027 {- ' -} then

858−

865+ singleStringHelp array offset length row col initialOffset builder 1 "\\'"

859− let

860− !newOffset = offset + 1

861− chunk = Text.Text array initialOffset (offset - initialOffset)

862− newBuilder = builder <> LB.fromText chunk <> LB.fromText "\\'"

863− in

864− singleString array newOffset (length - 1) row (col + 1) newOffset newBuilder

865

866

866 else if word == 0x005C {- \ -} then

867 else if word == 0x005C {- \ -} then

867− case eatEscape array (offset + 1) (length - 1) row (col + 1) EndOfFile_String of

868+ case eatEscape array (offset + 1) (length - 1) of

868− Left err ->

869+ EscapeNormal ->

869− Left err

870+ singleString array (offset + 2) (length - 2) row (col + 2) initialOffset builder

870

871

871− Right size ->

872+ EscapeUnicode delta code ->

872− singleString array (offset + size) (length - size) row (col + size) initialOffset builder

873+ singleStringHelp array offset length row col initialOffset builder delta code

873

874

875+ EscapeProblem newOffset problem ->

876+ Left (ParseError row col (BadEscape (newOffset - offset) problem))

877+

878+ EscapeEndOfFile ->

879+ Left (ParseError row (col + 1) EndOfFile_String)

880+

874− else if word < 0xD800 || word > 0xDBFF then

881+ else if word < 0xD800 || 0xDBFF < word then

875 singleString array (offset + 1) (length - 1) row (col + 1) initialOffset builder

882 singleString array (offset + 1) (length - 1) row (col + 1) initialOffset builder

876

883

877 else

884 else

878 singleString array (offset + 2) (length - 2) row (col + 1) initialOffset builder

885 singleString array (offset + 2) (length - 2) row (col + 1) initialOffset builder

879

886

880

887

881−eatEscape :: Text.Array -> Int -> Int -> Int -> Int -> Problem -> Either ParseError Int

888+singleStringHelp :: Text.Array -> Int -> Int -> Int -> Int -> Int -> B.Builder -> Int -> Text.Text -> Either ParseError ( Int, Int, Int, B.Builder )

882−eatEscape array offset length row col problem =

889+singleStringHelp array offset length row col initialOffset builder delta escape =

883− if length == 0 then

890+ let

884− Left (ParseError row col problem)

891+ chunk = copyText array initialOffset (offset - initialOffset)

885−

892+ newBuilder = builder <> B.fromText chunk <> B.fromText escape

886− else

893+ !newOffset = offset + delta

887− case Text.unsafeIndex array offset of

894+ in

888− 0x0061 {- a -} -> Right 2

895+ singleString array newOffset (length - delta) row (col + delta) newOffset newBuilder

889− 0x0062 {- b -} -> Right 2

890− 0x0066 {- f -} -> Right 2

891− 0x006E {- n -} -> Right 2

892− 0x0072 {- r -} -> Right 2

893− 0x0074 {- t -} -> Right 2

894− 0x0076 {- v -} -> Right 2

895− 0x0022 {- " -} -> Right 2

896− 0x005C {- \ -} -> Right 2

897− 0x0027 {- ' -} -> Right 2

898− 0x0075 {- u -} | length >= 5 && fourHex array offset -> Right 6

899− _ ->

900− Left (ParseError row col BadEscape)

901−

902−

903−fourHex :: Text.Array -> Int -> Bool

904−fourHex array offset =

905− isHex (Text.unsafeIndex array (offset + 1))

906− && isHex (Text.unsafeIndex array (offset + 2))

907− && isHex (Text.unsafeIndex array (offset + 3))

908− && isHex (Text.unsafeIndex array (offset + 4))

909

896

910

897

911

898

912-- MULTI STRINGS

899-- MULTI STRINGS

913

900

914

901

915−multiString :: Text.Array -> Int -> Int -> Int -> Int -> Int -> LB.Builder -> Either ParseError ( Int, Int, Int, LB.Builder )

902+multiString :: Text.Array -> Int -> Int -> Int -> Int -> Int -> B.Builder -> Either ParseError ( Int, Int, Int, B.Builder )

916multiString array offset length row col initialOffset builder =

903multiString array offset length row col initialOffset builder =

917 if length < 3 then

904 if length < 3 then

918 Left (ParseError row col EndOfFile_MultiString)

905 Left (ParseError row col EndOfFile_MultiString)

@@ -922,48 +909,51 @@ multiString array offset length row col initialOffset builder =

922 !word = Text.unsafeIndex array offset

909 !word = Text.unsafeIndex array offset

923 in

910 in

924 if word == 0x0022 {- " -} && isQuote array (offset + 1) && isQuote array (offset + 2) then

911 if word == 0x0022 {- " -} && isQuote array (offset + 1) && isQuote array (offset + 2) then

925−

912+ Right

926− let

913+ ( offset + 3

927− finalBuilder =

914+ , length - 3

928− mappend builder $ LB.fromText $

915+ , col + 3

929− Text.Text array initialOffset (offset - initialOffset)

916+ , builder <> B.fromText (copyText array initialOffset (offset - initialOffset))

930− in

917+ )

931− Right ( offset + 3, length - 3, col + 3, finalBuilder )

932

918

933 else if word == 0x0027 {- ' -} then

919 else if word == 0x0027 {- ' -} then

934−

920+ multiStringHelp array offset length row col initialOffset builder 1 "\\'"

935− let

936− !newOffset = offset + 1

937− chunk = Text.Text array initialOffset (offset - initialOffset)

938− newBuilder = builder <> LB.fromText chunk <> LB.fromText "\\'"

939− in

940− multiString array newOffset (length - 1) row (col + 1) newOffset newBuilder

941

921

942 else if word == 0x000A {- \n -} then

922 else if word == 0x000A {- \n -} then

943−

923+ multiStringHelp array offset length row col initialOffset builder 1 "\\n"

944− let

945− !newOffset = offset + 1

946− chunk = Text.Text array initialOffset (offset - initialOffset)

947− newBuilder = builder <> LB.fromText chunk <> LB.fromText "\\n"

948− in

949− multiString array newOffset (length - 1) (row + 1) 1 newOffset newBuilder

950

924

951 else if word == 0x005C {- \ -} then

925 else if word == 0x005C {- \ -} then

952

926

953− case eatEscape array (offset + 1) (length - 1) row (col + 1) EndOfFile_MultiString of

927+ case eatEscape array (offset + 1) (length - 1) of

954− Left err ->

928+ EscapeNormal ->

955− Left err

929+ multiString array (offset + 2) (length - 2) row (col + 2) initialOffset builder

930+

931+ EscapeUnicode delta code ->

932+ multiStringHelp array offset length row col initialOffset builder delta code

956

933

957− Right size ->

934+ EscapeProblem newOffset problem ->

958− multiString array (offset + size) (length - size) row (col + size) initialOffset builder

935+ Left (ParseError row col (BadEscape (newOffset - offset) problem))

959

936

937+ EscapeEndOfFile ->

938+ Left (ParseError row (col + 1) EndOfFile_MultiString)

939+

960− else if word < 0xD800 || word > 0xDBFF then

940+ else if word < 0xD800 || 0xDBFF < word then

961 multiString array (offset + 1) (length - 1) row (col + 1) initialOffset builder

941 multiString array (offset + 1) (length - 1) row (col + 1) initialOffset builder

962

942

963 else

943 else

964 multiString array (offset + 2) (length - 2) row (col + 1) initialOffset builder

944 multiString array (offset + 2) (length - 2) row (col + 1) initialOffset builder

965

945

966

946

947+multiStringHelp :: Text.Array -> Int -> Int -> Int -> Int -> Int -> B.Builder -> Int -> Text.Text -> Either ParseError ( Int, Int, Int, B.Builder )

948+multiStringHelp array offset length row col initialOffset builder delta escape =

949+ let

950+ chunk = copyText array initialOffset (offset - initialOffset)

951+ newBuilder = builder <> B.fromText chunk <> B.fromText escape

952+ !newOffset = offset + delta

953+ in

954+ multiString array newOffset (length - delta) row (col + delta) newOffset newBuilder

955+

956+

967

957

968-- CHARACTER

958-- CHARACTER

969

959

@@ -978,49 +968,136 @@ character =

978 if Text.unsafeIndex array offset /= 0x0027 {- ' -} then

968 if Text.unsafeIndex array offset /= 0x0027 {- ' -} then

979 eerr noError

969 eerr noError

980

970

981− else if length < 3 then

982− cerr (ParseError row col BadChar)

983−

984 else

971 else

985− case characterHelp array (offset + 1) (length - 1) row (col + 1) of

972+ case chompChar array (offset + 1) (length - 1) row (col + 1) 0 "" of

986 Left err ->

973 Left err ->

987 cerr err

974 cerr err

988

975

989− Right (endCol, size) ->

976+ Right ( newOffset, newLength, newCol, numChars, mostRecentChar ) ->

990− let

977+ if numChars /= 1 then

991− !newOffset = offset + size + 1

992− !newLength = length - size - 1

993− in

994− if newLength == 0 || Text.unsafeIndex array newOffset /= 0x0027 {- ' -} then

995− cerr (ParseError row col BadChar)

978+ cerr (ParseError row col (BadChar newCol))

979+ else

980+ cok mostRecentChar

981+ (State array newOffset newLength indent row newCol ctx)

982+ noError

996

983

997− else

984+chompChar :: Text.Array -> Int -> Int -> Int -> Int -> Int -> Text.Text -> Either ParseError ( Int, Int, Int, Int, Text.Text )

998− cok

985+chompChar array offset length row col numChars mostRecentChar =

999− (copyText array (offset + 1) size)

986+ if length == 0 then

1000− (State array (newOffset + 1) (newLength - 1) indent row endCol ctx)

987+ Left (ParseError row col EndOfFile_Char)

1001− noError

1002

988

989+ else

990+ let

991+ !word = Text.unsafeIndex array offset

992+ in

993+ if word == 0x0027 {- ' -} then

994+ Right

995+ ( offset + 1

996+ , length - 1

997+ , col + 1

998+ , numChars

999+ , mostRecentChar

1000+ )

1003

1001

1004−characterHelp :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError ( Int, Int )

1005−characterHelp array offset length row col =

1006− let

1007− !word = Text.unsafeIndex array offset

1008− in

1009− if word == 0x0027 {- ' -} || word == 0x000A {- \n -} then

1002+ else if word == 0x000A {- \n -} then

1010− Left (ParseError row col BadChar)

1003+ Left (ParseError row col NewLineInChar)

1004+

1005+ else if word == 0x0022 {- " -} then

1006+ chompChar array (offset + 1) (length - 1) row (col + 1) (numChars + 1) "\\\""

1011

1007

1012− else if word == 0x005C {- \ -} then

1008+ else if word == 0x005C {- \ -} then

1013− do n <- eatEscape array (offset + 1) (length - 1) row (col + 1) BadChar

1009+ case eatEscape array (offset + 1) (length - 1) of

1014− return (col + n + 2, n)

1010+ EscapeNormal ->

1011+ chompChar array (offset + 2) (length - 2) row (col + 2) (numChars + 1) (copyText array offset 2)

1012+

1013+ EscapeUnicode delta code ->

1014+ chompChar array (offset + delta) (length - delta) row (col + delta) (numChars + 1) code

1015+

1016+ EscapeProblem newOffset problem ->

1017+ Left (ParseError row col (BadEscape (newOffset - offset) problem))

1018+

1019+ EscapeEndOfFile ->

1020+ Left (ParseError row col EndOfFile_Char)

1021+

1022+ else if word < 0xD800 || 0xDBFF < word then

1023+ chompChar array (offset + 1) (length - 1) row (col + 1) (numChars + 1) (copyText array offset 1)

1024+

1025+ else

1026+ chompChar array (offset + 2) (length - 2) row (col + 1) (numChars + 1) (copyText array offset 2)

1015

1027

1016− else if word < 0xD800 || word > 0xDBFF then

1017− Right (col + 3, 1)

1018

1028

1019− else if length > 2 then

1029+

1020− Right (col + 3, 2)

1030+-- ESCAPE CHARACTERS

1031+

1032+

1033+data Escape

1034+ = EscapeNormal

1035+ | EscapeUnicode !Int Text.Text

1036+ | EscapeProblem !Int E.EscapeProblem

1037+ | EscapeEndOfFile

1038+

1039+

1040+eatEscape :: Text.Array -> Int -> Int -> Escape

1041+eatEscape array offset length =

1042+ if length == 0 then

1043+ EscapeEndOfFile

1044+

1045+ else

1046+ case Text.unsafeIndex array offset of

1047+ 0x006E {- n -} -> EscapeNormal

1048+ 0x0074 {- t -} -> EscapeNormal

1049+ 0x0022 {- " -} -> EscapeNormal

1050+ 0x0027 {- ' -} -> EscapeNormal

1051+ 0x005C {- \ -} -> EscapeNormal

1052+ 0x0075 {- u -} -> eatUnicode array (offset + 1) (length - 1)

1053+ _ -> EscapeProblem offset E.UnknownEscape

1054+

1055+

1056+eatUnicode :: Text.Array -> Int -> Int -> Escape

1057+eatUnicode array offset length =

1058+ if length == 0 || Text.unsafeIndex array offset /= 0x007B {- { -} then

1059+ EscapeProblem offset E.UnicodeSyntax

1060+ else

1061+ let

1062+ !digitOffset =

1063+ offset + 1

1064+

1065+ (# newOffset, newLength, code #) =

1066+ chompHex array digitOffset (length - 1)

1067+

1068+ !numDigits =

1069+ newOffset - digitOffset

1070+ in

1071+ if newLength == 0 || Text.unsafeIndex array newOffset /= 0x007D {- } -} then

1072+ EscapeProblem newOffset E.UnicodeSyntax

1073+

1074+ else if code < 0 || 0x10FFFF < code then

1075+ EscapeProblem (newOffset + 1) E.UnicodeRange

1076+

1077+ else if numDigits < 4 || 6 < numDigits then

1078+ EscapeProblem (newOffset + 1) $

1079+ E.UnicodeLength numDigits (copyText array digitOffset numDigits)

1021

1080

1022 else

1081 else

1023− Left (ParseError row col BadChar)

1082+ EscapeUnicode (numDigits + 4) (codePointToBuilder code)

1083+

1084+

1085+{-# INLINE codePointToBuilder #-}

1086+codePointToBuilder :: Int -> Text.Text

1087+codePointToBuilder code =

1088+ if code < 0xFFFF then

1089+ "\\u" <> toHex code

1090+

1091+ else

1092+ "\\u" <> toHex ((code `div` 0x400) + 0xD800)

1093+ <>

1094+ "\\u" <> toHex ((code `mod` 0x400) + 0xDC00)

1095+

1096+

1097+toHex :: Int -> Text.Text

1098+toHex word16 =

1099+ Text.decodeUtf8 $ BS.toStrict $ BS.toLazyByteString $

1100+ BS.word16HexFixed (fromIntegral word16)

1024

1101

1025

1102

1026

1103

@@ -1198,7 +1275,7 @@ chompZero array startOffset offset length =

1198 !word = Text.unsafeIndex array offset

1275 !word = Text.unsafeIndex array offset

1199 in

1276 in

1200 if word == 0x0078 {- x -} then

1277 if word == 0x0078 {- x -} then

1201− chompHex array startOffset (offset + 1) (length - 1)

1278+ chompHexNumber array (offset + 1) (length - 1)

1202

1279

1203 else if word == 0x002E {- . -} then

1280 else if word == 0x002E {- . -} then

1204 chompFraction array startOffset (offset + 1) (length - 1)

1281 chompFraction array startOffset (offset + 1) (length - 1)

@@ -1210,28 +1287,16 @@ chompZero array startOffset offset length =

1210 Right ( offset, length, L.IntNum 0 )

1287 Right ( offset, length, L.IntNum 0 )

1211

1288

1212

1289

1213−chompHex :: Text.Array -> Int -> Int -> Int -> Either (Int, Problem) (Int, Int, L.Literal)

1290+chompHexNumber :: Text.Array -> Int -> Int -> Either (Int, Problem) (Int, Int, L.Literal)

1214−chompHex array startOffset offset length =

1291+chompHexNumber array offset length =

1215− if length == 0 then

1292+ let

1216− Left (offset, BadNumberHex)

1293+ (# newOffset, newLength, hexNumber #) =

1217−

1218− else if isHex (Text.unsafeIndex array offset) then

1219− chompHexHelp array startOffset (offset + 1) (length - 1)

1294+ chompHex array offset length

1220−

1295+ in

1221− else

1222− Left (offset, BadNumberHex)

1223−

1224−

1225−chompHexHelp :: Text.Array -> Int -> Int -> Int -> Either (Int, Problem) (Int, Int, L.Literal)

1226−chompHexHelp array startOffset offset length =

1227− if length == 0 then

1296+ if hexNumber == -1 then

1228− Right ( offset, length, readInt array startOffset offset )

1297+ Left ( newOffset, BadNumberHex )

1229−

1230− else if isHex (Text.unsafeIndex array offset) then

1231− chompHexHelp array startOffset (offset + 1) (length - 1)

1232−

1233 else

1298 else

1234− Right ( offset, length, readInt array startOffset offset )

1299+ Right ( newOffset, newLength, L.IntNum hexNumber )

1235

1300

1236

1301

1237

1302

@@ -1244,18 +1309,6 @@ isDigit word =

1244 word <= 0x0039 {- 9 -} && word >= 0x0030 {- 0 -}

1309 word <= 0x0039 {- 9 -} && word >= 0x0030 {- 0 -}

1245

1310

1246

1311

1247−{-# INLINE isHex #-}

1248−isHex :: Word16 -> Bool

1249−isHex word =

1250− word <= 0x0066 {- f -} && (word >= 0x0061 {- a -} || isDigit word || isCapHex word)

1251−

1252−

1253−{-# INLINE isCapHex #-}

1254−isCapHex :: Word16 -> Bool

1255−isCapHex word =

1256− 0x0041 {- A -} <= word && word <= 0x0046 {- F -}

1257−

1258−

1259{-# INLINE readInt #-}

1312{-# INLINE readInt #-}

1260readInt :: Text.Array -> Int -> Int -> L.Literal

1313readInt :: Text.Array -> Int -> Int -> L.Literal

1261readInt array startOffset endOffset =

1314readInt array startOffset endOffset =

@@ -1271,6 +1324,50 @@ readFloat array startOffset endOffset =

1271

1324

1272

1325

1273

1326

1327+-- CHOMP HEX

1328+

1329+

1330+-- Return -1 if it has NO digits

1331+-- Return -2 if it has BAD digits

1332+

1333+{-# INLINE chompHex #-}

1334+chompHex :: Text.Array -> Int -> Int -> (# Int, Int, Int #)

1335+chompHex array offset length =

1336+ chompHexHelp array offset length (-1) 0

1337+

1338+

1339+chompHexHelp :: Text.Array -> Int -> Int -> Int -> Int -> (# Int, Int, Int #)

1340+chompHexHelp array offset length finalNumber hexNumber =

1341+ if length == 0 then

1342+ (# offset, length, finalNumber #)

1343+ else

1344+ let

1345+ !newNumber =

1346+ stepHex (Text.unsafeIndex array offset) hexNumber

1347+ in

1348+ if newNumber < 0 then

1349+ (# offset, length, if newNumber == -1 then finalNumber else -2 #)

1350+ else

1351+ chompHexHelp array (offset + 1) (length - 1) newNumber newNumber

1352+

1353+

1354+{-# INLINE stepHex #-}

1355+stepHex :: Word16 -> Int -> Int

1356+stepHex word hexNumber =

1357+ if word <= 0x0039 {- 9 -} && word >= 0x0030 {- 0 -} then

1358+ 16 * hexNumber + fromIntegral (word - 0x0030 {- 0 -})

1359+

1360+ else if word <= 0x0066 {- f -} && word >= 0x0061 {- a -} then

1361+ 16 * hexNumber + 10 + fromIntegral (word - 0x0061 {- a -})

1362+

1363+ else if word <= 0x0046 {- F -} && word >= 0x0041 {- A -} then

1364+ 16 * hexNumber + 10 + fromIntegral (word - 0x0041 {- A -})

1365+

1366+ else

1367+ -1

1368+

1369+

1370+

1274-- SHADER

1371-- SHADER

1275

1372

1276

1373

@@ -1306,7 +1403,7 @@ eatShader array offset length row col =

1306 else if word == 0x000A {- \n -} then

1403 else if word == 0x000A {- \n -} then

1307 eatShader array (offset + 1) (length - 1) (row + 1) 1

1404 eatShader array (offset + 1) (length - 1) (row + 1) 1

1308

1405

1309− else if word < 0xD800 || word > 0xDBFF then

1406+ else if word < 0xD800 || 0xDBFF < word then

1310 eatShader array (offset + 1) (length - 1) row (col + 1)

1407 eatShader array (offset + 1) (length - 1) row (col + 1)

1311

1408

1312 else

1409 else

@@ -1333,7 +1430,7 @@ kernelChunk =

1333 chompChunk array offset length row col

1430 chompChunk array offset length row col

1334

1431

1335 !javascript =

1432 !javascript =

1336− Text.encodeUtf8 (Text.Text array offset (jsOffset - offset))

1433+ Text.encodeUtf8 (copyText array offset (jsOffset - offset))

1337

1434

1338 !newState =

1435 !newState =

1339 State array newOffset newLength indent newRow newCol ctx

1436 State array newOffset newLength indent newRow newCol ctx

@@ -1356,7 +1453,7 @@ chompChunk array offset length row col =

1356 else if word == 0x000A {- \n -} then

1453 else if word == 0x000A {- \n -} then

1357 chompChunk array (offset + 1) (length - 1) (row + 1) 1

1454 chompChunk array (offset + 1) (length - 1) (row + 1) 1

1358

1455

1359− else if word < 0xD800 || word > 0xDBFF then

1456+ else if word < 0xD800 || 0xDBFF < word then

1360 chompChunk array (offset + 1) (length - 1) row (col + 1)

1457 chompChunk array (offset + 1) (length - 1) row (col + 1)

1361

1458

1362 else

1459 else

@@ -1374,10 +1471,10 @@ chompChunkTag array jsOffset offset length row col =

1374

1471

1375 !chunkTag =

1472 !chunkTag =

1376 if word == 0x0024 {- $ -} then

1473 if word == 0x0024 {- $ -} then

1377− KernelElmField (Text.Text array (offset + 1) (newOffset - offset - 1))

1474+ KernelElmField (copyText array (offset + 1) (newOffset - offset - 1))

1378

1475

1379 else

1476 else

1380− let !chunk = Text.Text array offset (newOffset - offset) in

1477+ let !chunk = copyText array offset (newOffset - offset) in

1381 if isDigit word then

1478 if isDigit word then

1382 KernelEnum (fromIntegral (word - 0x0030 {- 0 -})) chunk

1479 KernelEnum (fromIntegral (word - 0x0030 {- 0 -})) chunk

1383

1480

src/Reporting/Error/Syntax.hs+97−11

@@ -4,6 +4,7 @@ module Reporting.Error.Syntax

4 ( Error(..)

5 , ParseError(..)

6 , Problem(..), Theory(..)

7+ , EscapeProblem(..)

7 , ContextStack, Context(..)

8 , ContextStack, Context(..)

8 , BadOp(..), Next(..)

9 , BadOp(..), Next(..)

9 , toReport

10 , toReport

@@ -18,7 +19,7 @@ import qualified Reporting.Render.Type as RenderType

18import qualified Reporting.Region as R

19import qualified Reporting.Region as R

19import qualified Reporting.Report as Report

20import qualified Reporting.Report as Report

20import qualified Reporting.Helpers as Help

21import qualified Reporting.Helpers as Help

21−import Reporting.Helpers ((<>), dullyellow, hsep, i2t, reflowParagraph, text)

22+import Reporting.Helpers ((<>), dullyellow, green, hsep, i2t, reflowParagraph, text)

@@ -66,9 +67,11 @@ data Problem

66 | EndOfFile_Shader

67 | EndOfFile_Shader

67 | EndOfFile_String

68 | EndOfFile_String

68 | EndOfFile_MultiString

69 | EndOfFile_MultiString

70+ | EndOfFile_Char

69 | NewLineInString

71 | NewLineInString

72+ | NewLineInChar

70− | BadEscape

73+ | BadEscape Int EscapeProblem

71− | BadChar

74+ | BadChar Int

72 | BadNumberDot

75 | BadNumberDot

73 | BadNumberEnd

76 | BadNumberEnd

74 | BadNumberExp

77 | BadNumberExp

@@ -80,6 +83,13 @@ data Problem

80 | Theories ContextStack [Theory]

83 | Theories ContextStack [Theory]

86+data EscapeProblem

87+ = UnknownEscape

88+ | UnicodeSyntax

89+ | UnicodeRange

90+ | UnicodeLength Int Text

91+

92+

83data BadOp = HasType | Equals | Arrow | Pipe | Dot

93data BadOp = HasType | Equals | Arrow | Pipe | Dot

@@ -449,6 +459,14 @@ problemToReport subRegion problem =

449 \ to be missing."

459 \ to be missing."

450 )

460 )

451

461

462+ EndOfFile_Char ->

463+ parseReport

464+ "I got to the end of the file while parsing a character."

465+ (reflowParagraph $

466+ "Characters look like 'x' with single quotes on each end.\

467+ \ So the closing single quote seems to be missing."

468+ )

469+

452 NewLineInString ->

470 NewLineInString ->

453 parseReport

471 parseReport

454 "This string is missing the closing quote."

472 "This string is missing the closing quote."

@@ -461,16 +479,17 @@ problemToReport subRegion problem =

461 ]

479 ]

462 )

480 )

463

481

464− BadEscape ->

482+ NewLineInChar ->

465 parseReport

483 parseReport

466− "A backslash starts an escaped character, but I do not recognize this one:"

484+ "This character is missing the closing quote."

467− ( reflowParagraph

485+ ( reflowParagraph $

468− "Elm allows typical escape characters like \\\\ and \\n and \\t. You can\

486+ "Elm characters must start and end with a single quote, like 'a' and 'b'"

469− \ also say \\u0040 to refer to unicode characters by their hex code.\

470− \ Maybe there is some typo?"

471 )

487 )

472

488

489+ BadEscape _ escapeProblem ->

490+ uncurry parseReport (escapeProblemToReport escapeProblem)

491+

473− BadChar ->

492+ BadChar _ ->

474 parseReport

493 parseReport

475 "Ran into a bad use of single quotes."

494 "Ran into a bad use of single quotes."

476 ( Help.stack

495 ( Help.stack

@@ -479,7 +498,7 @@ problemToReport subRegion problem =

479 , Help.indent 4 $

498 , Help.indent 4 $

480 dullyellow (text "'this'")

499 dullyellow (text "'this'")

481 <> text " => "

500 <> text " => "

482− <> dullyellow (text "\"this\"")

501+ <> green (text "\"this\"")

483 , reflowParagraph $

502 , reflowParagraph $

484 "Unlike JavaScript, Elm distinguishes between strings like \"hello\"\

503 "Unlike JavaScript, Elm distinguishes between strings like \"hello\"\

485 \ and individual characters like 'A' and '3'. If you really do want\

504 \ and individual characters like 'A' and '3'. If you really do want\

@@ -609,6 +628,73 @@ problemToReport subRegion problem =

609 ++ map (bullet . theoryToText stack) theories

628 ++ map (bullet . theoryToText stack) theories

610

629

611

630

631+escapeProblemToReport :: EscapeProblem -> ( Text, Help.Doc )

632+escapeProblemToReport escapeProblem =

633+ case escapeProblem of

634+ UnknownEscape ->

635+ ( "A backslash starts an escaped character, but I do not recognize this one:"

636+ , Help.stack

637+ [ "Maybe there is some typo?"

638+ , Help.toHint $ "Valid escape characters include:"

639+ , Help.indent 4 $ Help.vcat $

640+ [ "\\n"

641+ , "\\t"

642+ , "\\\""

643+ , "\\\'"

644+ , "\\\\"

645+ , "\\u{03BB}"

646+ ]

647+ , reflowParagraph $

648+ "The last one lets encode ANY character by its Unicode code\

649+ \ point, so there are no other escape characters in Elm."

650+ ]

651+ )

652+

653+ UnicodeSyntax ->

654+ ( "I ran into an invalid Unicode escape character:"

655+ , Help.stack

656+ [ "Here are some examples of valid Unicode escape characters:"

657+ , Help.indent 4 $ Help.vcat $

658+ [ "\\u{0041}"

659+ , "\\u{03BB}"

660+ , "\\u{6728}"

661+ , "\\u{1F60A}"

662+ ]

663+ , reflowParagraph $

664+ "Notice that the code point is always surrounded by curly\

665+ \ braces. They are required!"

666+ ]

667+ )

668+

669+ UnicodeRange ->

670+ ( "This is not a real Unicode code point:"

671+ , "All valid Unicode code points are between 0 and 10FFFF."

672+ )

673+

674+ UnicodeLength numDigits badCode ->

675+ let

676+ moreOrFewer =

677+ if numDigits < 4 then "more" else "fewer"

678+

679+ goodCode =

680+ Text.justifyRight 4 '0' $ Text.dropWhile (== '0') badCode

681+

682+ suggestion =

683+ [ "Try"

684+ , "using"

685+ , dullyellow $ text $ "\\u{" <> goodCode <> "}"

686+ , "instead."

687+ ]

688+ in

689+ ( "This Unicode code point needs " <> moreOrFewer <> " digits:"

690+ , hsep suggestion

691+ )

692+

693+

694+

695+-- HELPERS

696+

697+

612bullet :: Text -> Help.Doc

698bullet :: Text -> Help.Doc

613bullet point =

699bullet point =

614 Help.hang 4 (" - " <> reflowParagraph point)

700 Help.hang 4 (" - " <> reflowParagraph point)

src/Reporting/Helpers.hs+1−1

@@ -3,7 +3,7 @@

3module Reporting.Helpers

4 ( (|>)

5 -- re-exports

6− , Doc, (<+>), (<>), cat, dullyellow, fillSep, hang

6+ , Doc, (<+>), (<>), cat, dullyellow, fillSep, green, hang

7 , hsep, indent, parens, sep, text, underline, vcat

8 -- custom helpers

9 , i2t