0 | module Language.JSON.String.Tokens
 1 |
 2 | import Data.List
 3 | import Data.String.Extra
 4 | import Text.Token
 5 |
 6 | %default total
 7 |
 8 | public export
 9 | data JSONStringTokenKind
10 |   = JSTQuote
11 |   | JSTChar
12 |   | JSTSimpleEscape
13 |   | JSTUnicodeEscape
14 |
15 | public export
16 | JSONStringToken : Type
17 | JSONStringToken = Token JSONStringTokenKind
18 |
19 | public export
20 | Eq JSONStringTokenKind where
21 |   (==) JSTQuote JSTQuote = True
22 |   (==) JSTChar JSTChar = True
23 |   (==) JSTSimpleEscape JSTSimpleEscape = True
24 |   (==) JSTUnicodeEscape JSTUnicodeEscape = True
25 |   (==) _ _ = False
26 |
27 | private
28 | charValue : String -> Char
29 | charValue x = case index 0 x of
30 |                    Nothing => '\NUL'
31 |                    Just c  => c
32 |
33 | private
34 | simpleEscapeValue : String -> Char
35 | simpleEscapeValue x
36 |   = case index 1 x of
37 |          Nothing => '\NUL'
38 |          Just c => case c of
39 |                         '"'  => '"'
40 |                         '\\' => '\\'
41 |                         '/'  => '/'
42 |                         'b'  => '\b'
43 |                         'f'  => '\f'
44 |                         'n'  => '\n'
45 |                         'r'  => '\r'
46 |                         't'  => '\t'
47 |                         _    => '\NUL'
48 |
49 | private
50 | unicodeEscapeValue : String -> Char
51 | unicodeEscapeValue x = fromHex (drop 2 $ fastUnpack x) 0
52 |   where hexVal : Char -> Int
53 |         hexVal c = if c >= 'A'
54 |                       then ord c - ord 'A' + 10
55 |                       else ord c - ord '0'
56 |
57 |         fromHex : List Char -> Int -> Char
58 |         fromHex       [] acc = chr acc
59 |         fromHex (h :: t) acc = fromHex t (hexVal h + 16 * acc)
60 |
61 | public export
62 | TokenKind JSONStringTokenKind where
63 |   TokType JSTQuote = ()
64 |   TokType JSTChar = Char
65 |   TokType JSTSimpleEscape = Char
66 |   TokType JSTUnicodeEscape = Char
67 |
68 |   tokValue JSTQuote = const ()
69 |   tokValue JSTChar = charValue
70 |   tokValue JSTSimpleEscape = simpleEscapeValue
71 |   tokValue JSTUnicodeEscape = unicodeEscapeValue
72 |