clone url: git://git.m455.casa/sprout
sprout.rkt
1 | #lang racket/base |
2 |
|
3 | (require racket/port |
4 | racket/system |
5 | racket/string |
6 | racket/file |
7 | racket/list |
8 | racket/match) |
9 |
|
10 | (define dir-weed (string-append (path->string (find-system-path 'home-dir)) ".weed/")) |
11 | (define dir-posts (string-append dir-weed "posts/")) |
12 | (define dir-build (string-append dir-weed "build/")) |
13 | (define dirs (list dir-weed dir-posts dir-build)) |
14 |
|
15 | (define rss-file "weed.rss") |
16 | (define rss-file-build (string-append dir-build rss-file)) |
17 |
|
18 | (define config-file "config") |
19 | (define config-file-path (string-append dir-weed config-file)) |
20 |
|
21 | (define config-file-contents |
22 | #<<string-block |
23 | ;; this is the configuration file for your weed. |
24 | ;; |
25 | ;; change these values to your own. |
26 | ;; |
27 | ;; note: Make sure you have a slash at the end of |
28 | ;; the url-base and output-path values. |
29 |
|
30 | ((title "my cool weed") |
31 | (description "shitposts and feels alllll day") |
32 | (url-base "https://example.com/weed/") |
33 | (output-path "user@example.com:/var/www/weed/")) |
34 |
|
35 | ;; Examples of output-path values: |
36 | ;; Local example: "~/public_html/weed/" |
37 | ;; Remote example: "user@example.com:/var/www/weed/" |
38 | ;; Note: Make sure you include the trailing slash |
39 | string-block |
40 | ) |
41 |
|
42 | (define rss-header |
43 | #<<string-block |
44 | <?xml version="1.0" encoding="UTF-8" ?> |
45 | <rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom"> |
46 | <channel> |
47 | <title>~a</title> |
48 | <link>~a</link> |
49 | <description>~a</description> |
50 | <atom:link href="~a" rel="self" type="application/rss+xml" /> |
51 |
|
52 | string-block |
53 | ) |
54 |
|
55 | (define rss-item |
56 | #<<string-block |
57 | <item> |
58 | <title><![CDATA[~a]]></title> |
59 | <guid isPermaLink="false"><![CDATA[~a]]></guid> |
60 | <pubDate>~a</pubDate> |
61 | <description><![CDATA[~a]]></description> |
62 | </item> |
63 |
|
64 | string-block |
65 | ) |
66 |
|
67 | (define rss-footer |
68 | #<<string-block |
69 | </channel> |
70 | </rss> |
71 | string-block |
72 | ) |
73 |
|
74 | (define (config-ref key) |
75 | (with-input-from-file |
76 | config-file-path |
77 | (lambda () (cadr (assq key (read)))))) |
78 |
|
79 | (define (rss-remove-illegal-characters str) |
80 | (string-replace str "]]>" "")) |
81 |
|
82 | (define (clear-screen) |
83 | (let ([clear-screen "\e[2J"] |
84 | [reset-cursor "\e[1;1H"]) |
85 | (display (string-append clear-screen reset-cursor)))) |
86 |
|
87 | (define-syntax-rule (displayln-format str ...) |
88 | (displayln (format str ...))) |
89 |
|
90 | (define-syntax-rule (system-format str ...) |
91 | (system (format str ...))) |
92 |
|
93 | (define (press-enter) |
94 | (display "press enter to continue...") |
95 | (read-line)) |
96 |
|
97 | (define (directory-create str) |
98 | (if (directory-exists? str) |
99 | (displayln-format "directory exists: '~a'. skipping creation." str) |
100 | (begin (make-directory* str) |
101 | (displayln-format "created directory: ~a." str)))) |
102 |
|
103 | (define (file-create str) |
104 | (if (file-exists? str) |
105 | (displayln-format "file exists: '~a'. skipping creation." str) |
106 | (begin (close-output-port (open-output-file str)) |
107 | (displayln-format "created file: ~a." str)))) |
108 |
|
109 | (define (get-editor-fallback) |
110 | (let ([env-editor (getenv "EDITOR")]) |
111 | (if env-editor |
112 | env-editor |
113 | "nano"))) |
114 |
|
115 | (define (get-editor) |
116 | (let ([env-visual (getenv "VISUAL")]) |
117 | (if env-visual |
118 | env-visual |
119 | (get-editor-fallback)))) |
120 |
|
121 | (define (string-cleanup str) |
122 | ((compose |
123 | (lambda (x) (string-replace x #px"\t+" " ")) |
124 | (lambda (x) (string-replace x #px"\\s+" " ")) |
125 | (lambda (x) (string-replace x #px"\\s+$" "")) |
126 | (lambda (x) (string-replace x #px"\n+" " "))) |
127 | str)) |
128 |
|
129 | (define (string-truncate str max-characters) |
130 | (if (>= (length (string->list str)) max-characters) |
131 | (if (equal? max-characters 0) |
132 | "..." |
133 | (let ([str-list (string->list str)]) |
134 | (string-cleanup |
135 | (string-append |
136 | (string (car str-list)) |
137 | (string-truncate (list->string (cdr str-list)) (- max-characters 1)))))) |
138 | (string-cleanup str))) |
139 |
|
140 | (define (list-paginate lst groups-of-n) |
141 | (if (null? lst) |
142 | lst |
143 | (if (>= (length lst) groups-of-n) |
144 | (cons (take lst groups-of-n) |
145 | (list-paginate (list-tail lst groups-of-n) groups-of-n)) |
146 | (cons lst (list-paginate '() groups-of-n))))) |
147 |
|
148 | ;; string-trim removes a trailing "\n" that (system ...) adds |
149 | (define (shell-command str) |
150 | (string-trim |
151 | (with-output-to-string |
152 | (lambda () (system str))))) |
153 |
|
154 | (define (make-filename) |
155 | (string-append (shell-command "date +'%Y-%m-%d'") "_" |
156 | (shell-command "date +'%H-%M-%S'") ".txt")) |
157 |
|
158 | (define (make-title filename) |
159 | (rss-remove-illegal-characters |
160 | (string-truncate (file->string filename) 50))) |
161 |
|
162 | (define (make-guid filename) |
163 | ((compose (lambda (x) (string-replace x ".txt" "")) |
164 | (lambda (x) (string-replace x dir-posts ""))) |
165 | filename)) |
166 |
|
167 | (define (make-date filename) |
168 | (let* ([date-split (string-split filename "_")] |
169 | [ymd (string-replace (car date-split) dir-posts "")] |
170 | [hms ((compose (lambda (x) (string-replace x "-" ":")) |
171 | (lambda (x) (string-replace x ".txt" ""))) |
172 | (cadr date-split))] |
173 | [ymd-hms (string-append ymd " " hms)]) |
174 | (shell-command (format "date -Rd'~a'" ymd-hms)))) |
175 |
|
176 | (define (make-description filename) |
177 | ((compose |
178 | (lambda (x) (string-replace x #px"\n$" "</p>")) |
179 | (lambda (x) (string-replace x #px"^" "<p>")) |
180 | (lambda (x) (string-replace x "\n\n" "</p><p>")) |
181 | rss-remove-illegal-characters) |
182 | (file->string filename))) |
183 |
|
184 | ;; commands |
185 | ;; ========================================= |
186 | (define (quit) |
187 | (clear-screen) |
188 | (displayln "bye bye! <3") |
189 | (exit 0)) |
190 |
|
191 | (define (publish) |
192 | (let* ([posts (directory-list dir-posts)] |
193 | [remote-location (string-append (config-ref 'output-path) rss-file)]) |
194 | (if (> (length posts) 0) |
195 | (begin (clear-screen) |
196 | (system-format "rsync -av --delete ~a ~a" rss-file-build remote-location) |
197 | (displayln "weed published!") |
198 | (press-enter)) |
199 | (begin (displayln "woops! no posts to publish!") |
200 | (press-enter))))) |
201 |
|
202 | (define (build-rss) |
203 | (let ([posts (directory-list dir-posts)]) |
204 | (if (> (length posts) 0) |
205 | (let* ([posts-as-strings (map path->string posts)] |
206 | [posts-full-paths (map (lambda (x) (string-append dir-posts x)) |
207 | posts-as-strings)] |
208 | [header (format rss-header |
209 | (config-ref 'title) |
210 | (config-ref 'url-base) |
211 | (config-ref 'description) |
212 | (string-append (config-ref 'url-base) rss-file))]) |
213 | ;; write header to file |
214 | (display-to-file header rss-file-build #:exists 'truncate) |
215 | ;; write items to file |
216 | (for ([file posts-full-paths]) |
217 | (let* ([title (make-title file)] |
218 | [guid (make-guid file)] |
219 | [date (make-date file)] |
220 | [description (make-description file)] |
221 | [item (format rss-item title guid date description)]) |
222 | (display-to-file item rss-file-build #:exists 'append))) |
223 | ;; write footer to file |
224 | (display-to-file rss-footer rss-file-build #:exists 'append) |
225 | (begin (displayln "finished building rss feed!") |
226 | (press-enter))) |
227 | (begin (displayln "no posts. skipping rss build...") |
228 | (press-enter))))) |
229 |
|
230 | (define (delete-post-prompt filename) |
231 | (let ([title (make-title filename)]) |
232 | (clear-screen) |
233 | (displayln-format "WARNING: are you sure you want to delete '~a'? [y/n]" title) |
234 | (display "> ") |
235 | (let ([input (string-downcase (read-line))]) |
236 | (if (equal? input "y") |
237 | (delete-file filename) |
238 | (begin (displayln-format "cancelled deletion of '~a'" title) |
239 | (press-enter)))))) |
240 |
|
241 | (define (delete-post number) |
242 | (if (and (> (length (directory-list dir-posts)) 0) |
243 | (>= number 0) |
244 | (< number (length (directory-list dir-posts)))) |
245 | (let* ([posts-as-strings (map path->string (directory-list dir-posts))] |
246 | [posts-full-paths (map (lambda (x) (string-append dir-posts x)) |
247 | posts-as-strings)] |
248 | [filename (list-ref posts-full-paths number)]) |
249 | (delete-post-prompt filename)) |
250 | (begin (displayln "woops!") |
251 | (press-enter)))) |
252 |
|
253 | (define (settings) |
254 | (system-format "~a ~a" (get-editor) config-file-path)) |
255 |
|
256 | (define (edit-post number) |
257 | (if (and (> (length (directory-list dir-posts)) 0) |
258 | (>= number 0) |
259 | (< number (length (directory-list dir-posts)))) |
260 | (let* ([posts-as-strings (map path->string (directory-list dir-posts))] |
261 | [posts-full-paths (map (lambda (x) (string-append dir-posts x)) |
262 | posts-as-strings)] |
263 | [filename (list-ref posts-full-paths number)]) |
264 | (system-format "~a ~a" (get-editor) filename)) |
265 | (begin (displayln "woops!") |
266 | (press-enter)))) |
267 |
|
268 | (define (create-post) |
269 | (let ([filename (string-append dir-posts (make-filename))]) |
270 | (system-format "~a ~a" (get-editor) filename))) |
271 |
|
272 | ;; interface utils |
273 | ;; ================================= |
274 | ;; credit for wonderful cool symbols: |
275 | ;; http://coolsymbols123.blogspot.com/2011/05/msn-nickname-decoration.html |
276 | (define (draw-header) |
277 | (for ([i (list "(¯`·._.·[ (sprout) ]·._.·´¯)" |
278 | "h: help | q: quit")]) |
279 | (displayln i))) |
280 |
|
281 | (define (draw-help) |
282 | (clear-screen) |
283 | (for ([line (list "c: create a post" |
284 | "e <n>: edit <nth> post" |
285 | "d <n>: delete <nth> post" |
286 | "b: build an rss feed from your posts" |
287 | "p: publish your posts" |
288 | "s: change settings")]) |
289 | (displayln line)) |
290 | (newline) |
291 | (press-enter)) |
292 |
|
293 | ;; TODO: implement pagination using string-paginate |
294 | (define (draw-posts) |
295 | (let* ([posts (directory-list dir-posts)] |
296 | [number-of-posts (length posts)]) |
297 | (if (equal? number-of-posts 0) |
298 | (displayln "you don't have any posts.") |
299 | (for ([i (map number->string (range number-of-posts))] |
300 | [file (map path->string posts)]) |
301 | (let ([post-title (make-title (string-append dir-posts file))]) |
302 | (displayln (string-append i ". " post-title))))))) |
303 |
|
304 | (define (prompt-input) |
305 | (display "> ") |
306 | (let ([input (string-downcase (read-line))]) |
307 | (match (string-split input) |
308 | [(list "e" (app string->number (? number? x))) (edit-post x)] |
309 | [(list "d" (app string->number (? number? x))) (delete-post x)] |
310 | [(list "s") (settings)] |
311 | [(list "h") (draw-help)] |
312 | [(list "c") (create-post)] |
313 | [(list "b") (build-rss)] |
314 | [(list "p") (publish)] |
315 | [(list "q") (quit)] |
316 | [_ (begin (displayln "not an option") |
317 | (press-enter))]))) |
318 |
|
319 | (define (draw-interface) |
320 | (clear-screen) |
321 | (draw-header) |
322 | (newline) |
323 | (draw-posts) |
324 | (newline) |
325 | (prompt-input) |
326 | (draw-interface)) |
327 |
|
328 | ;; setup |
329 | ;; ================================= |
330 | (define (setup) |
331 | (for ([i dirs]) |
332 | (directory-create i)) |
333 | (display-to-file config-file-contents config-file-path #:exists 'truncate) |
334 | (displayln (format "created ~a" config-file-path)) |
335 | (displayln "finished setup!") |
336 | (press-enter) |
337 | (draw-interface)) |
338 |
|
339 | (define (prompt-to-setup) |
340 | (clear-screen) |
341 | (displayln "it looks like you haven't set up your weed yet.") |
342 | (displayln "would you like to set it up now? [y/n]") |
343 | (display "> ") |
344 | (let ([input (read-line)]) |
345 | (if (equal? (string-downcase input) "y") |
346 | (setup) |
347 | (begin (newline) |
348 | (displayln "cancelled setup."))))) |
349 |
|
350 | (define (main) |
351 | (if (and (andmap directory-exists? dirs) |
352 | (file-exists? config-file-path)) |
353 | (draw-interface) |
354 | (prompt-to-setup))) |
355 |
|
356 | (main) |
357 |
|