Coverage report: /development/source/library/org/datagraph/spocq-shard/src/core/encoding/csv.lisp

Kind	Covered	All	%
expression	0	301	0.0
branch	0	36	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-

2

3

(in-package :org.datagraph.spocq.implementation)

4

5

;;; simple csv parser

6

7

;;; see

8

;;; https://tools.ietf.org/html/rfc4180

9

10

(defparameter *csv-bnf* "

11

[[1]] file ::= (header EOL)? filerecords?

12

[[1a]] filerecords ::= record filerecords?

13

[[2]] header :== name (COMMA header)?

14

[[3]] record :== recordfields EOL

15

[[3a]] recordfields ::= field (COMMA recordfields)?

16

[[4]] name :== field

17

[[5]] field ::= escaped | nonescaped

18

[[6]] escaped ::= WS* DQUOTE1 escapedtextdata* DQUOTE2 WS*

19

//[[6a]] escapedtextdata ::= TEXTDATA | COMMA | CR | LF | DQUOTEDQUOTE

20

[[6a]] escapedtextdata ::= TEXTDATA | COMMA | WS | DQUOTEDQUOTE

21

[[6b]] DQUOTEDQUOTE ::= DQUOTE1 DQUOTE2

22

[[6c]] DQUOTE1 ::= DQUOTE

23

[[6d]] DQUOTE2 ::= DQUOTE

24

[[7]] nonescaped ::= TEXTDATA*

25

// COMMA = %x2C

26

// CR = %x0D

27

// DQUOTE = %x22

28

// LF = %x0A

29

[[12]] EOL ::= (CR LF) | CR | LF

30

//[[13]] TEXTDATA = %x20-21 | %x23-2B | %x2D-7E

31

")

32

;;; nb. the rfc4180 bnf with the optional terminating EOL is ambiguous beyond repair.

33

;;; it allows a single zero lenght field on the last line without an EOL.

34

35

36

(defpackage :org.datagraph.csv

37

(:use :common-lisp

38

:org.datagraph.spocq.implementation

39

:de.setf.utility)

40

(:nicknames :odcsv)

41

(:shadow :input-reference :input-eof?)

42

(:export

43

:*comma*

44

"file-Constructor"

45

"filerecords-Constructor"

46

"header-Constructor"

47

"record-Constructor"

48

"recordfields-Constructor"

49

"name-Constructor"

50

"field-Constructor"

51

"escaped-Constructor"

52

"nonescaped-Constructor"

53

"TEXTDATA-Constructor"

54

"CRLF-Constructor"

55

"WS-Constructor")

56

(:import-from :spocq.i

57

:*csv-bnf*))

58

59

(defparameter odcsv:*comma* #\,)

60

61

(defun odcsv::|file-Constructor| (EOL filerecords header)

62

(declare (ignore EOL))

63

(if header

64

(cons header filerecords)

65

filerecords))

66

67

(defun odcsv::|filerecords-Constructor| (filerecords record)

68

(cons record filerecords))

69

70

(defun odcsv::|header-Constructor| (COMMA header name)

71

(declare (ignore COMMA))

72

(cons name header))

73

74

(defun odcsv::|record-Constructor| (EOL recordfields)

75

(declare (ignore EOL))

76

recordfields)

77

78

(defun odcsv::|recordfields-Constructor| (COMMA field record)

79

(declare (ignore COMMA))

80

(cons field record))

81

82

(defun odcsv::|name-Constructor| (field)

83

field)

84

85

(defun odcsv::|field-Constructor| (escaped nonescaped)

86

(or escaped nonescaped))

87

88

(defun odcsv::|escaped-Constructor| (DQUOTE1 DQUOTE2 escapedtextdata* &optional ws)

89

(declare (ignore DQUOTE1 DQUOTE2 ws))

90

(map 'string #'identity (reverse escapedtextdata*)))

91

92

(defun odcsv::|escapedtextdata-Constructor| (COMMA DQUOTEDQUOTE TEXTDATA WS)

93

(or COMMA DQUOTEDQUOTE TEXTDATA WS))

94

95

(defun odcsv::|DQUOTEDQUOTE-Constructor| (DQUOTE1 DQUOTE2)

96

(declare (ignore DQUOTE1 DQUOTE2))

97

#\")

98

99

(defun odcsv::|EOL-Constructor| (CR LF)

100

(declare (ignore CR LF))

101

nil)

102

103

(defun odcsv::|EOF-Constructor| (EOL)

104

(declare (ignore EOL))

105

nil)

106

107

(defun odcsv::|nonescaped-Constructor| (textdata*)

108

(trim-string-whitespace (map 'string #'identity (reverse textdata*))))

109

110

(macrolet ((def-char-constructors (&rest names)

111

`(progn ,@(loop for name in names collect `(defun ,name (c) c)))))

112

(def-char-constructors

113

ORG.DATAGRAPH.CSV::|COMMA-Constructor|

114

ORG.DATAGRAPH.CSV::|CR-Constructor|

115

ORG.DATAGRAPH.CSV::|DQUOTE1-Constructor|

116

ORG.DATAGRAPH.CSV::|DQUOTE2-Constructor|

117

ORG.DATAGRAPH.CSV::|LF-Constructor|

118

ORG.DATAGRAPH.CSV:|TEXTDATA-Constructor|

119

ORG.DATAGRAPH.CSV:|WS-Constructor|))

120

121

(defun odcsv::is-dquote (x)

122

(eql x #\"))

123

124

(defun odcsv::is-cr (x)

125

(eql x #\return))

126

127

(defun odcsv::is-lf (x)

128

(eql x #\linefeed))

129

130

(defun odcsv::is-comma (x)

131

(eql x odcsv:*comma*))

132

133

(defun odcsv::is-textdata (x)

134

(and (characterp x)

135

(not (eql x odcsv:*comma*))

136

(let ((code (char-code x)))

137

(or (<= #x20 code #x21) ;; exclude control (cr, lf)

138

(<= #x23 code #x2B) ;; exclude " and ,

139

(<= #x2D code #x7E) ;; ... exclude delete

140

(<= #x80 code) ;; allow utf-8

141

(and (= code #x2c) (not (eql #\, odcsv:*comma*)))

142

))))

143

144

(defun odcsv::is-ws (x)

145

(find x #(#\space #\tab #\return #\linefeed)))

146

147

148

(defparameter *parse-csv.initial-line* nil)

149

150

(defgeneric parse-csv (string &key start end start-name separator)

151

(:method (string &key (start 0 s-s) (end (length string) e-s) (start-name 'odcsv::|file|)

152

((:separator odcsv:*comma*) odcsv:*comma*))

153

(let ((*max-input-index* 0)

154

(atnp:*atn-term* nil)

155

(*parse-csv.initial-line* nil))

156

(when (or s-s e-s)

157

(setf string (subseq string start end)))

158

(multiple-value-bind (result index success)

159

                            (funcall 'odcsv::|file-Parser| string :start-name start-name)

160

(if success

161

(values result string index)

162

(flet ((_aref (array index)

163

                      (when (and (integerp index) (< index (length array))) (aref array index))))

164

(spocq.e::message-syntax-error :expression string

165

                                              :token (_aref string index)

166

:byte-offset index

167

:line-offset nil))))))

168

(:method ((pathname pathname) &rest args)

169

(with-open-file (stream pathname :direction :input)

170

(apply #'parse-csv stream args)))

171

172

(:method ((stream stream) &key (start 0) end (separator odcsv:*comma*) start-name)

173

(declare (ignore start-name))

174

(labels ((parse-csv-header (stream)

175

(let ((line (read-csv-line stream :separator separator)))

176

(when line

177

                    (spocq.i::parse-csv line :start-name 'odcsv::|header| :separator separator))))

178

(parse-csv-line (stream)

179

(let ((line (read-csv-line stream)))

180

(when line

181

                    (spocq.i::parse-csv line :start-name 'odcsv::|recordfields| :separator separator)))))

182

(let* ((header (parse-csv-header stream)))

183

(values (loop for count from 0

184

for line = (parse-csv-line stream)

185

until (or (null line) (and end (>= count end)))

186

when (>= count start)

187

collect line)

188

header)))))

189

190

(defun parse-csv-header (line &key (separator odcsv:*comma*))

191

"given a prospective separator, verify/replace it and use that value

192

to split the string. suppress double quotes at the same time"

193

(setf separator (find-csv-separator line separator))

194

(values (split-string line (vector separator #\"))

195

separator))

196

197

(defun find-csv-separator (line separator &key (separators '(#\, #\; #\tab #\|)))

198

(cond ((position separator line)

199

separator)

200

((loop for separator in separators

201

when (find separator line)

202

return separator))

203

(t separator)))

204

205

(defun read-csv-line (stream &key (separator odcsv:*comma*))

206

"read and return a single - possibly continued, 'csv' line

207

if this is the first line and the separator is not found, try to pick a new one"

208

(let ((lines ()))

209

(loop (let ((line (read-line stream nil nil)))

210

(unless *parse-csv.initial-line*

211

(setf *parse-csv.initial-line* line)

212

(setf separator (find-csv-separator line separator))

213

(setq odcsv:*comma* separator))

214

(unless line (return))

215

(when lines (push (load-time-value (make-string 1 :initial-element #\newline)) lines))

216

(push line lines)

217

(let ((comma (position separator line))

218

(dquote (position #\" line)))

219

(when (and (null (rest lines)) (evenp (count dquote line))) (return))

220

(when (and dquote (if comma (> comma dquote) t)) (return)))))

221

(when lines

222

(string-trim #(#\return #\newline #\space)

223

                    (if (rest lines) (apply #'concatenate 'string (reverse lines)) (first lines))))))

224

225

(defun csv-variable-name (name)

226

(loop with new-name = (trim-string-whitespace name)

227

for to-replace in '(#\space #\/ #\. #\-)

228

do (setq new-name (substitute #\_ to-replace new-name))

229

finally (return new-name)))

230

231

#+(or)

232

((spocq.i::parse-csv #p"/opt/dydra/bin/datagraph_nexperia/nexperia/SPIDER-Datahub-views.csv")

233

(spocq.i::parse-csv #p"/root/imports/Contacts.csv")

234

)

235

236

237

238

(defun odcsv::input-reference (index)

239

(when (< index (length ATN-PARSER::*ATN-INPUT))

240

(aref ATN-PARSER::*ATN-INPUT index)))

241

(defun odcsv::input-eof? (index)

242

(>= index (length ATN-PARSER::*ATN-INPUT)))

243

244

#+(or)

245

(

246

(in-package :odcsv)

247

(bnfp:compile-atn-system spocq.i::*csv-bnf*

248

:execute t :compile nil

249

:token-package (find-package :spocq.s)

250

:source-package (find-package :odcsv)

251

                           :source-pathname #p"/development/source/library/org/datagraph/spocq-dev/src/core/encoding/csv-grammar.lisp"

252

:input-function 'odcsv::input-reference

253

:input-eof-function 'odcsv::input-eof?

254

:ambiguous nil

255

:trace nil)

256

(load (compile-file #p"/development/source/library/org/datagraph/spocq-dev/src/core/encoding/csv-grammar.lisp"

257

:output-file "csv-grammar.fasl"))

258

259

260

(bnfp:compile-atn-system spocq.i::*csv-bnf*

261

:execute t :compile nil

262

:token-package (find-package :spocq.s)

263

:source-package (find-package :odcsv)

264

:source-pathname #p"/tmp/csv-grammar.lisp"

265

:input-function 'odcsv::input-reference

266

:input-eof-function 'odcsv::input-eof?

267

:ambiguous nil

268

:trace nil)

269

(load (compile-file #p"/tmp/csv-grammar.lisp"

270

:output-file "csv-grammar.fasl"))

271

272

(spocq.i::parse-csv "asdf,qwer

273

274

1, 2

275

")

276

277

(spocq.i::parse-csv "asdf,qwer

278

279

1,\"2,

280

3\"

281

")

282

283

(spocq.i::parse-csv "1,\"2,

284

3\"

285

" :start-name 'odcsv::|record|)

286

(spocq.i::parse-csv "1,\"2,3\"

287

" :start-name 'odcsv::|record|)

288

(spocq.i::parse-csv "\"2,3\"\"\",4

289

" :start-name 'odcsv::|file|)

290

(spocq.i::parse-csv "\"2,3\"\"\",4

291

" :start-name 'odcsv::|record|)

292

(spocq.i::parse-csv "\"2,3\"" :start-name 'odcsv::|field|)

293

294

(spocq.i::parse-csv

295

  "47212.5,ASHLAND,KS,67831,112111,Partnership,Unanswered,Unanswered,Unanswered,,4,04/15/2020,\" Farm Credit of Western Oklahoma, ACA\",KS - 01"

296

:start-name 'odcsv::|recordfields|)

297

(spocq.i::parse-csv

298

  "47212.5,ASHLAND,KS,67831,112111,Partnership,Unanswered,Unanswered,Unanswered,,4,04/15/2020,\"Farm Credit of Western Oklahoma ACA\",KS - 01"

299

:start-name 'odcsv::|recordfields|)

300

301

(spocq.i::parse-csv

302

"2020,\" Farm, 1 2 3\",KS - 01"

303

:start-name 'odcsv::|recordfields|)

304

305

)