Coverage report: /home/ellis/comp/core/lib/dat/toml.lisp

Kind	Covered	All	%
expression	0	584	0.0
branch	0	42	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;; dat/toml.lisp --- TOML

2

3

;; TOML de/serialization for Lisp.

4

5

;;; Commentary:

6

7

;; This code was originally based on https://github.com/sheepduke/clop which

8

;; provides a TOML parser using the ESRAP package.

9

10

;; ref: https://toml.io/en/v1.0.0

11

12

;; grammar: https://raw.githubusercontent.com/toml-lang/toml/1.0.0/toml.abnf

13

14

#|

15

* TOML is case-sensitive.

16

* A TOML file must be a valid UTF-8 encoded Unicode document.

17

* Whitespace means tab (0x09) or space (0x20).

18

* Newline means LF (0x0A) or CRLF (0x0D 0x0A).

19

|#

20

21

;;; Code:

22

(in-package :dat/toml)

23

24

;;; Vars

25

(defvar *+inf* :+inf

26

"The value of +inf when decoding TOML.")

27

28

(defvar *-inf* :-inf

29

"The value of -inf when decoding TOML.")

30

31

(defvar *+nan* :+nan

32

"The value of +nan when decoding TOML.")

33

34

(defvar *-nan* :-nan

35

"The value of -nan when decoding TOML.")

36

37

(defclass toml-object (ast) ())

38

39

(defmethod print-object ((self toml-object) stream)

40

(print-unreadable-object (self stream :type t)

41

(format stream "~A" (car (ast self)))))

42

43

(defclass toml-table (toml-object) ())

44

45

(defclass toml-document (toml-object) ())

46

47

;;; Read

48

(defun toml-peek-char (stream expected &key skip-ws)

49

(when (equal (peek-char skip-ws stream nil) expected)

50

(read-char stream)))

51

52

(defun toml-read-char (stream expected &key skip-ws)

53

(declare (optimize (speed 3) (debug 0)))

54

(if (toml-peek-char stream expected :skip-ws skip-ws)

55

t

56

(error "TOML error: unexpected ~s~%expected ~A" (read-char stream) expected)))

57

58

(defun toml-read (stream &optional (eof-error-p t) eof-value)

59

(let ((c (peek-char t stream eof-error-p :eof)))

60

(case c

61

(:eof eof-value)

62

(#\[ (toml-read-table stream)) ;; arrays are values only

63

(#\# (toml-read-comment stream) (toml-read stream eof-error-p eof-value))

64

(t (toml-read-pair stream)))))

65

66

(defun toml-read-table (stream)

67

(toml-read-char stream #\[ :skip-ws t) ; [

68

(let ((ret (toml-read-header stream)))

69

(loop while (or (toml-read-comment stream) (toml-peek-bare-char stream))

70

do (push (toml-read-pair stream) ret))

71

(make-instance 'toml-table :ast (nreverse ret))))

72

73

(defun toml-read-header (stream)

74

(let ((c (peek-char t stream nil nil))

75

(ret))

76

(case c

77

;; array-table

78

(#\[ (read-char stream)

79

(push (list (toml-read-key stream)) ret)

80

(toml-read-char stream #\]))

81

(t (push (toml-read-key stream) ret)))

82

(toml-read-char stream #\])

83

ret))

84

85

(defun toml-bare-char-p (c)

86

(or (digit-char-p c) (sb-unicode:alphabetic-p c) (char= #\- c) (char= #\_ c)))

87

88

(defun toml-peek-bare-char (stream)

89

(let ((c (peek-char t stream nil nil)))

90

(and c (toml-bare-char-p c))))

91

92

(defun toml-read-bare-key (stream)

93

(with-output-to-string (s)

94

(loop for c = (peek-char t stream nil nil)

95

while (and c (toml-bare-char-p c))

96

do (write-char (read-char stream) s))

97

s))

98

99

(defun toml-read-string (stream)

100

"TOML supports basic, multi-line basic, literal, and multi-line literal

101

strings. All strings are UTF-8."

102

(let ((q (read-char stream)))

103

(with-output-to-string (s)

104

(if (eql q (peek-char t stream nil nil)) ;; 2 quotes

105

(if (eql q (peek-char t stream nil nil)) ;; 3 quotes (multi-line)

106

(progn

107

;; first we consume the first 2 multi-line quote chars

108

(read-sequence (make-string 2) stream)

109

(loop for c = (read-char stream nil nil)

110

while c

111

if (eql q c)

112

do (let ((c1 (read-char stream nil nil))

113

(c2 (read-char stream nil nil)))

114

(if (char= q c1 c2) ;; 3 quotes

115

(return s)

116

(progn

117

(write-char c s)

118

(write-char c1 s)

119

(write-char c2 s))))

120

else do (write-char c s)))

121

;; empty string (2 quotes)

122

(progn

123

(read-char stream nil nil) ;; q

124

s))

125

(loop for c = (read-char stream nil nil)

126

while c

127

if (eql q c)

128

return s

129

else do (write-char c s))))))

130

131

(defun toml-read-simple-string (stream)

132

"Read a single-quoted string."

133

(let ((q (read-char stream)))

134

(with-output-to-string (s)

135

(loop for c = (read-char stream nil nil)

136

until (or (eql c q) (not c))

137

do (write-char c s))

138

s)))

139

140

(defun toml-read-key (stream)

141

"TOML supports bare, quoted, and dotted keys."

142

(let ((c (peek-char t stream nil nil)))

143

(case c

144

;; quoted

145

((or #\" #\')

146

(let ((key (toml-read-simple-string stream)))

147

(if (toml-peek-char stream #\.)

148

(cons key (toml-read-key stream))

149

key)))

150

;; bare/dotted

151

(t (let ((key (toml-read-bare-key stream)))

152

(unless (sequence:emptyp key)

153

(if (toml-peek-char stream #\.)

154

(cons key (toml-read-key stream))

155

key)))))))

156

157

(defun toml-read-pair (stream)

158

(when-let ((key (toml-read-key stream)))

159

(toml-read-char stream #\= :skip-ws t)

160

(cons key (toml-read-value stream))))

161

162

(defun toml-read-value (stream)

163

(let ((c (peek-char t stream nil nil)))

164

(case c

165

(#\{ (toml-read-inline-table stream))

166

((or #\" #\') (toml-read-string stream))

167

(#\[ (toml-read-array stream))

168

(#\t (toml-read-true stream))

169

(#\f (toml-read-false stream))

170

(t (toml-read-number-or-datetime stream)))))

171

172

(defun toml-read-inline-table (stream)

173

(toml-read-char stream #\{ :skip-ws t) ; {

174

(let ((ret))

175

(loop

176

(toml-peek-char stream #\, :skip-ws t)

177

(if (toml-peek-char stream #\} :skip-ws t)

178

(return ret)

179

(if-let ((pair (toml-read-pair stream)))

180

(push pair ret)

181

(return (nreverse ret)))))))

182

183

(defun toml-read-array (stream)

184

(toml-read-char stream #\[ :skip-ws t)

185

(let ((ret))

186

(loop

187

(if (progn (toml-peek-char stream #\, :skip-ws t)

188

(toml-peek-char stream #\] :skip-ws t))

189

(return (coerce ret 'vector))

190

(push (toml-read-value stream) ret)))))

191

192

(defun toml-read-true (stream)

193

(let ((s (make-string 4)))

194

(read-sequence s stream)

195

(if (equal s "true")

196

t

197

(error "TOML error: expected 'true', got ~A" s))))

198

199

(defun toml-read-false (stream)

200

(let ((s (make-string 5)))

201

(read-sequence s stream)

202

(if (equal s "false")

203

t

204

(error "TOML error: expected 'false', got ~A" s))))

205

206

(defun toml-read-number-or-datetime (stream)

207

(let ((c (peek-char t stream nil nil)))

208

(case c

209

(#\+ (read-char stream) (toml-read-positive stream))

210

(#\- (read-char stream) (toml-read-negative stream))

211

(#\n (toml-read-nan stream))

212

(#\i (toml-read-inf stream))

213

(t (let ((n (read stream)))

214

(if (stringp n)

215

;; junk allowed for parsing time values

216

(if-let ((%n (ignore-errors (parse-number n))))

217

%n

218

;; if we can't parse as a number try it as a datetime

219

(toml-parse-datetime stream))

220

n))))))

221

222

(defun toml-read-positive (stream)

223

(let ((c (peek-char t stream nil nil)))

224

(case c

225

(#\i (toml-read-inf stream) *+inf*)

226

(#\n (toml-read-nan stream) *+nan*)

227

(t (abs (parse-number (read stream)))))))

228

229

(defun toml-read-negative (stream)

230

(let ((c (peek-char t stream nil nil)))

231

(case c

232

(#\i (toml-read-inf stream) *-inf*)

233

(#\n (toml-read-nan stream) *-nan*)

234

(t (- (parse-number (read stream)))))))

235

236

(defun toml-read-nan (stream)

237

(let ((s (make-string 3)))

238

(read-sequence s stream)

239

(if (equal s "nan")

240

:nan

241

(error "TOML error: expected 'nan', got ~A" s))))

242

243

(defun toml-read-inf (stream)

244

(let ((s (make-string 3)))

245

(read-sequence s stream)

246

(if (equal s "inf")

247

:inf

248

(error "TOML error: expected 'inf', got ~A" s))))

249

250

(defun toml-read-comment (stream)

251

(loop while (toml-peek-char stream #\# :skip-ws t)

252

do (read-line stream)))

253

254

;; TODO 2024-12-23: may include spaces, can't do a simple read :C

255

(defun toml-parse-datetime (str)

256

(or (ignore-errors (parse-timestring (ppcre:regex-replace " " "T" str)))

257

(toml-parse-datetime-local str)))

258

259

(defmethod toml-parse-datetime-local (str)

260

(let* ((delimeter (sequence:elt str 10))

261

(splits (split-sequence delimeter str)))

262

(append (with-input-from-string (s (car splits)) (toml-parse-date-local s))

263

(with-input-from-string (s (cadr splits)) (toml-parse-time-local (cadr splits))))))

264

265

(defun toml-parse-date-local (value)

266

"Return a plist with :year :month :date."

267

(let* ((*default-timezone* +utc-zone+)

268

(timestamp (parse-timestring value)))

269

(list :year (timestamp-year timestamp)

270

:month (timestamp-month timestamp)

271

:day (timestamp-day timestamp))))

272

273

(defun toml-parse-time-local (value)

274

"Return a plist with :hour :minute :second."

275

(let* ((*default-timezone* +utc-zone+)

276

(timestamp (parse-timestring value)))

277

(list :hour (timestamp-hour timestamp)

278

:minute (timestamp-minute timestamp)

279

:second (timestamp-second timestamp)

280

:microsecond (timestamp-microsecond timestamp))))

281

282

;; TODO 2024-12-24: traverse?

283

(defmethod unwrap ((self toml-document))

284

(mapcar 'ast (ast self)))

285

286

;;; Serde

287

288

;; TODO 2023-12-23:

289

;; (deserialize "[test]" :toml)

290

;; (serialize '("test") :toml)

291

292

(defmethod serialize ((table toml-table) (format (eql :toml)) &key (style :alist))

293

(loop for k in (ast table)

294

collect (cons k (serialize (cdr k) format :style style))))

295

296

(defun toml-read-document (stream)

297

(make-instance 'toml-document

298

:ast

299

(loop for x = (toml-read stream nil nil)

300

while x

301

collect x)))

302

303

(defmethod deserialize ((from pathname) (format (eql :toml)) &key)

304

(with-open-file (f from)

305

(toml-read-document f)))

306

307

(defmethod deserialize ((from string) (format (eql :toml)) &key)

308

(with-input-from-string (s from)

309

(toml-read-document s)))

310

311

(defmethod deserialize ((from stream) (format (eql :toml)) &key)

312

(with-open-stream (s from)

313

(toml-read-document s)))