clone url: git://git.m455.casa/fa
src/fa.fnl
| 1 | #!/usr/bin/env fennel |
| 2 | |
| 3 | ;; For debugging ----------------------;; |
| 4 | ;; (local view (require :fennelview)) |
| 5 | ;; (global pp (fn [x] (print (view x)))) |
| 6 | ;; ------------------------------------;; |
| 7 | |
| 8 | (local lume (require :lume)) |
| 9 | (local home (os.getenv "HOME")) |
| 10 | |
| 11 | (local program-name "fa") |
| 12 | (local program-version "0.5.0") |
| 13 | (local program-file (.. home "/." program-name)) |
| 14 | |
| 15 | ;; Not in use (yet?) |
| 16 | ;; This gets lowercased by (get-day) |
| 17 | ;; (local day-fmt "%a") |
| 18 | |
| 19 | (local event-symbol "!") |
| 20 | |
| 21 | (local keyword-today "today") |
| 22 | |
| 23 | (local cmds-help |
| 24 | {:human "help" |
| 25 | :long "--help" |
| 26 | :short "-h"}) |
| 27 | (local cmds-version |
| 28 | {:human "version" |
| 29 | :long "--version" |
| 30 | :short "-v"}) |
| 31 | (local cmd-init "init") |
| 32 | (local cmd-add "add") |
| 33 | (local cmd-rm "rm") |
| 34 | (local cmd-ls "ls") |
| 35 | (local cmd-notify "notify") |
| 36 | |
| 37 | (local newline "\n") |
| 38 | (local double-newline "\n\n") |
| 39 | (local space " ") |
| 40 | (local indent-2 " ") |
| 41 | |
| 42 | (local messages |
| 43 | {:usage |
| 44 | (string.format "For usage, type '%s %s'." program-name cmds-help.human) |
| 45 | |
| 46 | :program-version |
| 47 | (string.format "AGPLv3 -- %s" program-version) |
| 48 | |
| 49 | :file-already-exists |
| 50 | (string.format "A file or directory named '%s' already exists." program-file) |
| 51 | |
| 52 | :date-already-exists |
| 53 | (.. "The following event already exists in your agenda:" newline |
| 54 | "%s %s" newline |
| 55 | "Choose one of the options below:" newline |
| 56 | "1. Replace the old event" newline |
| 57 | "2. Add the event to the existing date" newline |
| 58 | "3. Cancell even creation" newline |
| 59 | "> ") |
| 60 | |
| 61 | :file-doesnt-exist |
| 62 | (string.format "%s doesn't exist. Try running '%s %s' (without the quotation marks)." |
| 63 | program-file |
| 64 | program-name |
| 65 | cmd-init) |
| 66 | |
| 67 | :cancelling-date-creation |
| 68 | "Cancelling date creation" |
| 69 | |
| 70 | :not-an-option |
| 71 | "Error: '%s' is not an option." |
| 72 | |
| 73 | :date-format |
| 74 | (.. "Error: Date format must be mmdd" newline |
| 75 | "Example: 1231 \"The last day of december\"") |
| 76 | |
| 77 | :key-doesnt-exist |
| 78 | "The date '%s' wasn't found in your agenda." |
| 79 | |
| 80 | :sub-key-doesnt-exist |
| 81 | "The item '%s' on %s wasn't found in your agenda." |
| 82 | |
| 83 | :agenda-empty |
| 84 | "There is nothing in your agenda." |
| 85 | |
| 86 | :initialized |
| 87 | (string.format "Successfully created %s" program-file) |
| 88 | |
| 89 | :added |
| 90 | "Added '%s' to your agenda." |
| 91 | |
| 92 | :removed |
| 93 | "Removed '%s' from your agenda."}) |
| 94 | |
| 95 | (fn key-exists? [tbl key] |
| 96 | (if (= (type tbl) :table) |
| 97 | (let [tbl-keys (lume.keys tbl)] |
| 98 | (if (lume.any tbl-keys #(= key $1)) |
| 99 | true |
| 100 | false)) |
| 101 | false)) |
| 102 | |
| 103 | (fn get-date [] |
| 104 | (os.date "%m%d")) |
| 105 | |
| 106 | ;; Not in use (yet?) |
| 107 | ;; (fn get-day [] |
| 108 | ;; (string.lower (os.date day-fmt))) |
| 109 | |
| 110 | (fn file-exists? [str] |
| 111 | (let [file-in (io.open str :r)] |
| 112 | (if file-in |
| 113 | (file-in:close) |
| 114 | false))) |
| 115 | |
| 116 | (fn file->table [str] |
| 117 | (if (file-exists? str) |
| 118 | (with-open [file-in (io.open str :r)] |
| 119 | (lume.deserialize (file-in:read :*all))) |
| 120 | nil)) |
| 121 | |
| 122 | (fn table->file [str tbl] |
| 123 | (if (file-exists? str) |
| 124 | (with-open [file-out (io.open str :w)] |
| 125 | (file-out:write (lume.serialize tbl))) |
| 126 | nil)) |
| 127 | |
| 128 | (fn create-prefix [seq key] |
| 129 | (if (> (# seq) 1) |
| 130 | (string.format "%s. " key) |
| 131 | "")) |
| 132 | |
| 133 | (fn print-format [str ...] |
| 134 | (print (string.format str ...))) |
| 135 | |
| 136 | (fn init/create-file [] |
| 137 | (with-open [file-out (io.open program-file :w)] |
| 138 | (file-out:write (lume.serialize [])) |
| 139 | (print messages.initialized))) |
| 140 | |
| 141 | (fn init [] |
| 142 | (if (file-exists? program-file) |
| 143 | (print messages.file-already-exists) |
| 144 | (init/create-file))) |
| 145 | |
| 146 | (fn add/add-event [date event-str] |
| 147 | (let [tbl (file->table program-file)] |
| 148 | (if (key-exists? tbl date) |
| 149 | (tset tbl date (+ 1 (length (. tbl date))) event-str) |
| 150 | (tset tbl date [event-str])) |
| 151 | (table->file program-file tbl) |
| 152 | (print-format messages.added event-str))) |
| 153 | |
| 154 | (fn add [date-str event-str] |
| 155 | (if (file-exists? program-file) |
| 156 | (let [date (if (= date-str keyword-today) (get-date) date-str)] |
| 157 | (add/add-event date event-str)) |
| 158 | (print messages.file-doesnt-exist))) |
| 159 | |
| 160 | (fn rm [date-str event-str] |
| 161 | (if (file-exists? program-file) |
| 162 | (let [tbl (file->table program-file) |
| 163 | date (if (= date-str keyword-today) (get-date) date-str) |
| 164 | events-seq (. tbl date) |
| 165 | events-seq-index (tonumber event-str) |
| 166 | date-exists? (key-exists? tbl date) |
| 167 | event-exists? (key-exists? events-seq events-seq-index)] |
| 168 | (match [date-exists? event-exists? event-str] |
| 169 | ;; If only the date is given |
| 170 | [true false nil] |
| 171 | (do (tset tbl date nil) |
| 172 | (table->file program-file tbl) |
| 173 | (print-format messages.removed date)) |
| 174 | |
| 175 | ;; If date and event exist |
| 176 | [true true] |
| 177 | (let [event (. events-seq events-seq-index)] |
| 178 | (table.remove events-seq events-seq-index) |
| 179 | (if (= (# events-seq) 0) |
| 180 | (do (tset tbl date nil) |
| 181 | (table->file program-file tbl) |
| 182 | (print-format messages.removed event)) |
| 183 | (do (tset tbl date events-seq) |
| 184 | (table->file program-file tbl) |
| 185 | (print-format messages.removed event)))) |
| 186 | |
| 187 | ;; If date exists, but event doesn't |
| 188 | [true false] |
| 189 | (print-format messages.sub-key-doesnt-exist event-str date) |
| 190 | |
| 191 | ;; If date doesn't exist |
| 192 | [false] |
| 193 | (print-format messages.key-doesnt-exist date))) |
| 194 | (print messages.file-doesnt-exist))) |
| 195 | |
| 196 | (fn notify [] |
| 197 | (if (file-exists? program-file) |
| 198 | (when (key-exists? (file->table program-file) (get-date)) |
| 199 | (io.write event-symbol)) |
| 200 | (print messages.file-doesnt-exist))) |
| 201 | |
| 202 | (fn ls/print-seq [events-seq] |
| 203 | (let [keys (lume.keys events-seq)] |
| 204 | ;; Keys are used here instead of the sequence values, so the keys |
| 205 | ;; print out in order |
| 206 | (each [_ key (pairs keys)] |
| 207 | (let [event (. events-seq key) |
| 208 | event-prefix (create-prefix events-seq key)] |
| 209 | (print-format "%s%s" event-prefix event))))) |
| 210 | |
| 211 | (fn ls/ls-date [date-str] |
| 212 | (if (file-exists? program-file) |
| 213 | (let [tbl (file->table program-file) |
| 214 | date (if (= date-str keyword-today) (get-date) date-str)] |
| 215 | (when (key-exists? tbl date) |
| 216 | (let [events-seq (. tbl date)] |
| 217 | (ls/print-seq events-seq)))) |
| 218 | (print messages.file-doesnt-exist))) |
| 219 | |
| 220 | (fn ls/print-seq [events-seq date] |
| 221 | (let [[first-event] events-seq |
| 222 | [first-key & rest-keys] (lume.keys events-seq) |
| 223 | first-event-prefix (create-prefix events-seq first-key)] |
| 224 | (print-format "%s%s" first-event-prefix first-event) |
| 225 | ;; The rest-keys is used here instead of a rest-events, so the |
| 226 | ;; keys for the underlying table in the sequence don't restart at 1 |
| 227 | (each [_ key (pairs rest-keys)] |
| 228 | (let [event (. events-seq key) |
| 229 | padding (string.rep " " (+ 1 (# date)))] |
| 230 | (print-format "%s %s. %s" padding key event))))) |
| 231 | |
| 232 | (fn ls/sort-and-print-tbl [tbl tbl-keys] |
| 233 | (table.sort tbl-keys) |
| 234 | (each [_ date (pairs tbl-keys)] |
| 235 | ;; Print the date without trailing newline character |
| 236 | (io.write (string.format "%s: " date)) |
| 237 | (let [events-seq (. tbl date)] |
| 238 | (ls/print-seq events-seq date)))) |
| 239 | |
| 240 | (fn ls [date-str] |
| 241 | (if (file-exists? program-file) |
| 242 | (if date-str |
| 243 | (ls/ls-date date-str) |
| 244 | (let [tbl (file->table program-file) |
| 245 | tbl-keys (lume.keys tbl) |
| 246 | tbl-length (# tbl-keys)] |
| 247 | (if (> tbl-length 0) |
| 248 | (ls/sort-and-print-tbl tbl tbl-keys) |
| 249 | (print messages.agenda-empty)))) |
| 250 | (print messages.file-doesnt-exist))) |
| 251 | |
| 252 | (fn help [] |
| 253 | (print |
| 254 | (.. "Usage:\n" |
| 255 | " fa <command> [<arg>] [<arg>]\n" |
| 256 | "\n" |
| 257 | "Commands:\n" |
| 258 | " init - Creates your agenda.\n" |
| 259 | " add <mmdd|today> \"Quoted text\" - Adds an event to your agenda.\n" |
| 260 | " rm <mmdd|today> - Removes a given date from your agenda.\n" |
| 261 | " rm <mmdd|today> [<number>] - Removes an event from given date from your agenda.\n" |
| 262 | " ls [<mmdd|today>] - Lists the events on the given date.\n" |
| 263 | " ls - Lists all dates and their events.\n" |
| 264 | " notify - Displays a \"!\" if an event exists today.\n" |
| 265 | " version - Prints the current version of fa.\n" |
| 266 | "\n" |
| 267 | "Examples:\n" |
| 268 | " fa init\n" |
| 269 | " fa add 1231 \"Sherry's birthday\"\n" |
| 270 | " fa add today \"Sherry's birthday\"\n" |
| 271 | " fa rm 1231\n" |
| 272 | " fa rm 1231 3 (See note below)\n" |
| 273 | " fa rm today\n" |
| 274 | " fa rm today 3 (See note below)\n" |
| 275 | " fa ls today\n" |
| 276 | " fa ls 1231\n" |
| 277 | " fa ls\n" |
| 278 | " fa notify\n" |
| 279 | " fa version\n" |
| 280 | "\n" |
| 281 | "Note: You may need to run 'fa ls' to see which number correlates to which event.\n"))) |
| 282 | |
| 283 | (fn process-args [arg-tbl] |
| 284 | (match arg-tbl |
| 285 | [cmd-add date-str event-str nil] |
| 286 | (add date-str event-str) |
| 287 | |
| 288 | [cmd-rm date-str event-str nil] |
| 289 | (rm date-str event-str) |
| 290 | |
| 291 | [cmd-rm date-str nil] |
| 292 | (rm date-str) |
| 293 | |
| 294 | [cmd-ls date-str nil] |
| 295 | (ls date-str) |
| 296 | |
| 297 | [cmd-ls nil] |
| 298 | (ls) |
| 299 | |
| 300 | ([cmd nil] ? (or (= cmd cmds-help.human) |
| 301 | (= cmd cmds-help.long) |
| 302 | (= cmd cmds-help.short))) |
| 303 | (help) |
| 304 | |
| 305 | ([cmd nil] ? (or (= cmd cmds-version.human) |
| 306 | (= cmd cmds-version.long) |
| 307 | (= cmd cmds-version.short))) |
| 308 | (print messages.program-version) |
| 309 | |
| 310 | [cmd-init nil] |
| 311 | (init) |
| 312 | |
| 313 | [cmd-notify nil] |
| 314 | (notify) |
| 315 | |
| 316 | _ (print messages.usage))) |
| 317 | |
| 318 | (fn main [arg-tbl] |
| 319 | (process-args arg-tbl)) |
| 320 | |
| 321 | (main arg) |