0 | -- SPDX-FileCopyrightText: 2021 The toml-idr developers
 1 | --
 2 | -- SPDX-License-Identifier: MPL-2.0
 3 |
 4 | module Language.TOML.Lexer
 5 |
 6 | import Text.Lexer
 7 | import Text.Token
 8 |
 9 | import public Language.TOML.Tokens
10 |
11 | %default total
12 |
13 | private
14 | nonZeroDigit : Lexer
15 | nonZeroDigit = range '1' '9'
16 |
17 | private
18 | floatLit : Lexer
19 | floatLit
20 |   = let sign     = oneOf "+-"
21 |         whole    = is '0' <|> nonZeroDigit <+> many (opt (is '_') <+> digit)
22 |         frac     = the Lexer $ is '.' <+> digit <+> many (opt (is '_') <+> digit)
23 |         exp      = the Lexer $ like 'e' <+> opt (oneOf "+-") <+> digits
24 |         constant = exact "nan" <|> exact "inf" in
25 |         opt sign <+> (
26 |             whole <+> ((frac <+> opt exp) <|> exp)
27 |             <|> constant)
28 |
29 | private
30 | sepIntLit : Lexer
31 | sepIntLit = opt (oneOf "+-") <+> nonZeroDigit <+> many (is '_' <|> digit)
32 |
33 | private
34 | sepBaseLit : (pre : String) -> (digit : Lexer) -> Lexer
35 | sepBaseLit pre digit =
36 |     exact pre
37 |     <+> digit
38 |     <+> many (opt (is '_') <+> digit)
39 |
40 | private
41 | integerLit : Lexer
42 | integerLit =
43 |     (sepBaseLit "0x" hexDigit
44 |     <|> sepBaseLit "0o" octDigit
45 |     <|> sepBaseLit "0b" binDigit
46 |     <|> sepIntLit) <+> reject (oneOf ".eE")
47 |
48 | private
49 | bareKey : Lexer
50 | bareKey = some (alphaNum <|> is '_' <|> is '-')
51 |
52 | -- TODO doesn't handle single quoted strings or escapes yet
53 | private
54 | basicStringLit : Lexer
55 | basicStringLit = quote (is '"') (escape (is '\\') any <|> isNot '\\')
56 |
57 | private
58 | tomlTokenMap : TokenMap TOMLToken
59 | tomlTokenMap = toTokenMap $
60 |     [
61 |         (newline, TTPunct NewLine),
62 |         (lineComment (is '#'), TTIgnored),
63 |         (spaces, TTIgnored),
64 |         (is ',', TTPunct Comma),
65 |         (is '.', TTPunct Dot),
66 |         (is '=', TTPunct Equal),
67 |         (is '[', TTPunct $ Square Open),
68 |         (is ']', TTPunct $ Square Close),
69 |         (is '{', TTPunct $ Curly Open),
70 |         (is '}', TTPunct $ Curly Close),
71 |         (exact strTrue <|> exact strFalse, TTBoolean),
72 |         (integerLit, TTInt),
73 |         (floatLit, TTFloat),
74 |         -- TODO: other string types
75 |         (Language.TOML.Lexer.basicStringLit, TTString Basic),
76 |         (bareKey, TTBare)
77 |     ]
78 |
79 | export
80 | lexTOML : String -> Maybe (List (WithBounds TOMLToken))
81 | lexTOML str =
82 |     case lex tomlTokenMap str of
83 |         (tokens, (_, _, "")) => Just tokens
84 |         _ => Nothing
85 |