0 | module Parser.Support.Escaping

  2 | import Libraries.Data.String.Extra

  3 | import Data.List

  6 | hex : Char -> Maybe Int

  7 | hex '0' = Just 0

  8 | hex '1' = Just 1

  9 | hex '2' = Just 2

 10 | hex '3' = Just 3

 11 | hex '4' = Just 4

 12 | hex '5' = Just 5

 13 | hex '6' = Just 6

 14 | hex '7' = Just 7

 15 | hex '8' = Just 8

 16 | hex '9' = Just 9

 17 | hex 'a' = Just 10

 18 | hex 'b' = Just 11

 19 | hex 'c' = Just 12

 20 | hex 'd' = Just 13

 21 | hex 'e' = Just 14

 22 | hex 'f' = Just 15

 23 | hex _ = Nothing

 26 | dec : Char -> Maybe Int

 27 | dec '0' = Just 0

 28 | dec '1' = Just 1

 29 | dec '2' = Just 2

 30 | dec '3' = Just 3

 31 | dec '4' = Just 4

 32 | dec '5' = Just 5

 33 | dec '6' = Just 6

 34 | dec '7' = Just 7

 35 | dec '8' = Just 8

 36 | dec '9' = Just 9

 37 | dec _ = Nothing

 40 | oct : Char -> Maybe Int

 41 | oct '0' = Just 0

 42 | oct '1' = Just 1

 43 | oct '2' = Just 2

 44 | oct '3' = Just 3

 45 | oct '4' = Just 4

 46 | oct '5' = Just 5

 47 | oct '6' = Just 6

 48 | oct '7' = Just 7

 49 | oct _ = Nothing

 52 | getEsc : String -> Maybe Char

 53 | getEsc "NUL" = Just '\NUL'

 54 | getEsc "SOH" = Just '\SOH'

 55 | getEsc "STX" = Just '\STX'

 56 | getEsc "ETX" = Just '\ETX'

 57 | getEsc "EOT" = Just '\EOT'

 58 | getEsc "ENQ" = Just '\ENQ'

 59 | getEsc "ACK" = Just '\ACK'

 60 | getEsc "BEL" = Just '\BEL'

 61 | getEsc "BS" = Just '\BS'

 62 | getEsc "HT" = Just '\HT'

 63 | getEsc "LF" = Just '\LF'

 64 | getEsc "VT" = Just '\VT'

 65 | getEsc "FF" = Just '\FF'

 66 | getEsc "CR" = Just '\CR'

 67 | getEsc "SO" = Just '\SO'

 68 | getEsc "SI" = Just '\SI'

 69 | getEsc "DLE" = Just '\DLE'

 70 | getEsc "DC1" = Just '\DC1'

 71 | getEsc "DC2" = Just '\DC2'

 72 | getEsc "DC3" = Just '\DC3'

 73 | getEsc "DC4" = Just '\DC4'

 74 | getEsc "NAK" = Just '\NAK'

 75 | getEsc "SYN" = Just '\SYN'

 76 | getEsc "ETB" = Just '\ETB'

 77 | getEsc "CAN" = Just '\CAN'

 78 | getEsc "EM" = Just '\EM'

 79 | getEsc "SUB" = Just '\SUB'

 80 | getEsc "ESC" = Just '\ESC'

 81 | getEsc "FS" = Just '\FS'

 82 | getEsc "GS" = Just '\GS'

 83 | getEsc "RS" = Just '\RS'

 84 | getEsc "US" = Just '\US'

 85 | getEsc "SP" = Just '\SP'

 86 | getEsc "DEL" = Just '\DEL'

 87 | getEsc str = Nothing

 89 | unescape' : List Char -> List Char -> Maybe (List Char)

 90 | unescape' _ [] = pure []

 91 | unescape' escapeChars (x::xs)

 92 |     = assert_total $ if escapeChars `isPrefixOf` (x::xs)

 93 |          then case drop (length escapeChars) (x::xs) of

 94 |                    ('\\' :: xs) => pure $ '\\' :: !(unescape' escapeChars xs)

 95 |                    ('\n' :: xs) => pure !(unescape' escapeChars xs)

 96 |                    ('&' :: xs) => pure !(unescape' escapeChars xs)

 97 |                    ('a' :: xs) => pure $ '\a' :: !(unescape' escapeChars xs)

 98 |                    ('b' :: xs) => pure $ '\b' :: !(unescape' escapeChars xs)

 99 |                    ('f' :: xs) => pure $ '\f' :: !(unescape' escapeChars xs)

100 |                    ('n' :: xs) => pure $ '\n' :: !(unescape' escapeChars xs)

101 |                    ('r' :: xs) => pure $ '\r' :: !(unescape' escapeChars xs)

102 |                    ('t' :: xs) => pure $ '\t' :: !(unescape' escapeChars xs)

103 |                    ('v' :: xs) => pure $ '\v' :: !(unescape' escapeChars xs)

104 |                    ('\'' :: xs) => pure $ '\'' :: !(unescape' escapeChars xs)

105 |                    ('"' :: xs) => pure $ '"' :: !(unescape' escapeChars xs)

106 |                    ('x' :: xs) => case span isHexDigit xs of

107 |                                        ([], rest) => unescape' escapeChars rest

108 |                                        (ds, rest) => pure $ cast !(toHex 1 (reverse ds)) ::

109 |                                                              !(unescape' escapeChars rest)

110 |                    ('o' :: xs) => case span isOctDigit xs of

111 |                                        ([], rest) => unescape' escapeChars rest

112 |                                        (ds, rest) => pure $ cast !(toOct 1 (reverse ds)) ::

113 |                                                              !(unescape' escapeChars rest)

114 |                    xs => case span isDigit xs of

115 |                               ([], (a :: b :: c :: rest)) =>

116 |                                 case getEsc (fastPack [a, b, c]) of

117 |                                      Just v => Just (v :: !(unescape' escapeChars rest))

118 |                                      Nothing => case getEsc (fastPack [a, b]) of

119 |                                                      Just v => Just (v :: !(unescape' escapeChars (c :: rest)))

120 |                                                      Nothing => unescape' escapeChars xs

121 |                               ([], (a :: b :: [])) =>

122 |                                 case getEsc (fastPack [a, b]) of

123 |                                      Just v => Just (v :: [])

124 |                                      Nothing => unescape' escapeChars xs

125 |                               ([], rest) => unescape' escapeChars rest

126 |                               (ds, rest) => Just $ cast (cast {to=Int} (fastPack ds)) ::

127 |                                               !(unescape' escapeChars rest)

128 |          else Just $ x :: !(unescape' escapeChars xs)

129 |   where

130 |     toHex : Int -> List Char -> Maybe Int

131 |     toHex _ [] = Just 0

132 |     toHex m (d :: ds)

133 |         = pure $ !(hex (toLower d)) * m + !(toHex (m*16) ds)

135 |     toOct : Int -> List Char -> Maybe Int

136 |     toOct _ [] = Just 0

137 |     toOct m (d :: ds)

138 |         = pure $ !(oct (toLower d)) * m + !(toOct (m*8) ds)

141 | unescape : Nat -> String -> Maybe String

142 | unescape hashtag x = let escapeChars = '\\' :: replicate hashtag '#' in

143 |                        fastPack <$> (unescape' escapeChars (unpack x))