about summary refs log tree commit diff stats
diff options
context:
space:
mode:
-rwxr-xr-xfff.scm250
-rw-r--r--test-fff.scm23
-rw-r--r--test.fff2
3 files changed, 1 insertions, 274 deletions
diff --git a/fff.scm b/fff.scm deleted file mode 100755 index 8f5ec22..0000000 --- a/fff.scm +++ /dev/null
@@ -1,250 +0,0 @@
1#!/bin/sh
2#| -*- scheme -*-
3exec guile -e main -s "$0" "$@"
4
5Flat Fuck Format
6--- a new configuration format, because who doesn't need that?
7
8Copyright (C) 2023 Case Duckworth <acdw@acdw.net>
9
10Everyone is permitted to do whatever with this software, without
11limitation. This software comes without any warranty whatsoever,
12but with two pieces of advice:
13
14- Don't hurt yourself.
15- Make good choices.
16
17Commentary:
18
19This script will convert files defined in the Flat Fuck Format (fff) into json.
20It will not convert anything back to fff. fff is explicitly made to be as
21simple as possible, and exclusively human-written. If a machine writes your
22configuration, ... use a better configuration format. Or make your program
23scriptable!
24
25FLAT FUCK FORMAT : Specification
26|#
27!#
28
29(define-module (fff)
30 #:use-module (ice-9 peg)
31 #:use-module (ice-9 match)
32 #:use-module (srfi srfi-11)
33 #:version (0 1 0)
34 #:export (fff
35 fff?
36 fff/comments?
37 fff->scm))
38
39
40;;; PEG Grammar
41
42(define-peg-pattern fff all
43 (and (* (or WHITESPACE NEWLINE))
44 (* (or comment
45 object
46 array
47 item
48 blanks))
49 (* NEWLINE)
50 (not-followed-by peg-any)))
51
52(define-peg-pattern comment all
53 (and (+ HASH) (* WHITESPACE)
54 (* (and (not-followed-by NEWLINE)
55 peg-any))))
56
57(define-peg-pattern object all
58 (and name
59 (+ object-item)))
60
61(define-peg-pattern array all
62 (and name
63 (+ array-item)))
64
65(define-peg-pattern item all
66 (and object-item
67 (* NEWLINE)))
68
69(define-peg-pattern object-item body
70 (and key (* WHITESPACE)
71 COLON (* WHITESPACE)
72 (or ref val)
73 (? NEWLINE)))
74
75(define-peg-pattern array-item body
76 (and (* WHITESPACE)
77 COLON (* WHITESPACE)
78 (or ref val)
79 (? NEWLINE)))
80
81(define-peg-pattern name all
82 (and key COLON COLON (* WHITESPACE) NEWLINE))
83
84(define-peg-pattern key body
85 (+ (and (not-followed-by COLON)
86 nonl)))
87
88(define-peg-pattern val all
89 (and (* nonl)))
90
91(define-peg-pattern ref all
92 (and AT key))
93
94(define-peg-pattern escaped body
95 (and BACKSLASH (or (and NEWLINE (* WHITESPACE))
96 peg-any)))
97
98(define-peg-pattern blanks none
99 (+ NEWLINE))
100
101(define-peg-pattern nonl body
102 (or escaped
103 (and (not-followed-by NEWLINE)
104 peg-any)))
105
106(define-peg-pattern NEWLINE none
107 (or "\r\n" "\r" "\n"))
108
109(define-peg-pattern WHITESPACE none
110 (or " " "\t"))
111
112(define-peg-pattern BACKSLASH none "\\")
113
114(define-peg-pattern COLON none ":")
115
116(define-peg-pattern HASH none "#")
117
118(define-peg-pattern AT none "@")
119
120
121;;; Utility functions
122
123(define (ensure-nested-list x)
124 (if (list? (car x))
125 x
126 (list x)))
127
128(define (atom? x)
129 (and (not (null? x))
130 (not (pair? x))
131 (not (vector? x))))
132
133(define (car-safe x)
134 (if (pair? x)
135 (car x)
136 #f))
137
138
139;;; Parameters
140
141(define fff/comments?
142 (make-parameter #f))
143
144(define fff/dupes?
145 (make-parameter #f))
146
147
148;;; FFF -> Scheme structures
149
150(define (fff? x)
151 (and (pair? x)
152 (eq? (car x) 'fff)))
153
154(define (fff->scm str)
155 (let ((tree (peg:tree (match-pattern fff str))))
156 (if (fff? tree)
157 (fff-ref-resolve (fff-tree->ref-tree tree))
158 #f)))
159
160(define (fff-tree->ref-tree tree)
161 (let loop ((xs (cdr tree))
162 (it '()))
163 (if (null? xs)
164 (reverse it)
165 (loop (cdr xs)
166 (match (car xs)
167 (`(object (name ,name) ,pairs)
168 (cons (cons name
169 (map fff-pair->scm
170 (ensure-nested-list pairs)))
171 it))
172 (`(array (name ,name) ,values)
173 (cons (cons name
174 (list->vector (map fff-value->scm
175 (ensure-nested-list values))))
176 it))
177 (`(item . ,pair)
178 (cons (fff-pair->scm pair)
179 it))
180 (`(comment ,comment)
181 (if (fff/comments?)
182 (cons (car xs) it)
183 it))
184 (_ it))))))
185
186(define* (fff-ref-resolve tree #:optional environment keep-dupes?)
187 (define dupes '())
188 (define env (append (or environment '())
189 '(("true" . #t)
190 ("false" . #f)
191 ("null" . null))))
192 (filter (lambda (x)
193 (if (or keep-dupes?
194 (fff/dupes?))
195 #t
196 (not (member (or (car-safe x) x)
197 dupes))))
198 (let loop ((xs tree)
199 (v? #f)
200 (it '()))
201 (if (null? xs)
202 ((if v? list->vector identity)
203 (reverse it))
204 (begin
205 (loop (cdr xs)
206 v?
207 (cons (let ((x (car xs)))
208 (cond
209 ((procedure? x)
210 (let-values (((resval reskey)
211 (x (append env tree))))
212 (set! env (cons reskey env))
213 (set! dupes (cons reskey dupes))
214 (list (cons reskey resval))))
215 ((atom? x)
216 (set! env (cons x env))
217 x)
218 ((procedure? (cdr x))
219 (set! dupes (cons (car x) dupes))
220 (let ((resolved
221 (cons (car x)
222 (cdr ((cdr x)
223 (append env tree))))))
224 (set! env (cons resolved env))
225 resolved))
226 ((atom? (cdr x))
227 (set! env (cons x env))
228 x)
229 ((vector? (cdr x))
230 (let ((vl (vector->list (cdr x))))
231 (set! env (cons (fff-ref-resolve vl env #f)
232 env))
233 (cons (car x)
234 (loop vl #t '()))))
235 (else ; object
236 (set! env (cons (fff-ref-resolve x env #t)
237 env))
238 (cons (car x) ; not tail-recursive!
239 (loop (cdr x) #f '())))))
240 it)))))))
241
242(define (fff-pair->scm pair)
243 (cons (car pair) (fff-value->scm (cadr pair))))
244
245(define (fff-value->scm val)
246 (match val
247 (`(val ,v) v)
248 (`(ref ,r) (lambda (alist)
249 (values (assoc-ref alist r)
250 r)))))
diff --git a/test-fff.scm b/test-fff.scm deleted file mode 100644 index f1cf746..0000000 --- a/test-fff.scm +++ /dev/null
@@ -1,23 +0,0 @@
1(use-modules (ice-9 format)
2 (ice-9 peg)
3 (ice-9 textual-ports)
4 (fff))
5
6(define (read-file file)
7 (call-with-input-file file get-string-all))
8
9(define (test-parse input)
10 (let loop ((str "")
11 (num 0)
12 (lst (string-split input #\newline)))
13 (cond
14 ((null? lst) (match-pattern fff str))
15 ((not (match-pattern fff str))
16 (format #t "!!!!!!!!!!!!!!!!!!!!!!!~%~s~%" lst))
17 (else
18 (format #t "~s~%~%" (peg:tree (match-pattern fff str)))
19 (when (match-pattern fff str)
20 (format #t "~s~%" (car lst)))
21 (loop (string-append str "\n" (car lst))
22 (+ num 1)
23 (cdr lst))))))
diff --git a/test.fff b/test.fff index 5df4000..d71e01b 100644 --- a/test.fff +++ b/test.fff
@@ -45,7 +45,7 @@ Capitals::
45Fargo\: the movie: one of the films of all time 45Fargo\: the movie: one of the films of all time
46You can even: escape new lines \ 46You can even: escape new lines \
47 with a backslash. it'll delete all the space preceding the value \ 47 with a backslash. it'll delete all the space preceding the value \
48 on the \#next line so you can have nice hanging indents. \ 48 on the #next line so you can have nice hanging indents. \
49\ (If you need weird spacing ... you can do this weird backslash thing.) 49\ (If you need weird spacing ... you can do this weird backslash thing.)
50 50
51My twitter handle: \@iDontHaveOneLol 51My twitter handle: \@iDontHaveOneLol