commit 9e2db7b073ec8f5efc39c7f57b0a0b28f0b40933 from: mtmn date: Sun Aug 23 21:02:21 2026 UTC fix tests and file parsing, add license commit - bf5177b65a99d5e54854d1582bed66cd26a1b191 commit + 9e2db7b073ec8f5efc39c7f57b0a0b28f0b40933 blob - bd5958dd78c5d3c24a0377bfa5e02d9c0ec13c79 blob + 12eb1fd97f8fe1a0dfca57d4d536a28209f7b8f7 --- Makefile +++ Makefile @@ -22,7 +22,7 @@ build/mcol.so: $(SOURCES) tools/build.ss $(SCHEME) --libdirs $(LIBDIR) --compile-imported-libraries --program tools/build.ss test: - MCOL_INPUT="$(INPUT)" $(RUN) test/test.ss + $(RUN) test/test.ss install: build/mcol.so install -d "$(DESTDIR)$(BINDIR)" "$(DESTDIR)$(LIBEXECDIR)/lib/mcol" \ @@ -45,7 +45,7 @@ help: @printf '%s\n' \ 'make tui Run the ANSI terminal browser' \ 'make build Compile the Chez Scheme program' \ - 'make test Run fixture and repository tests' \ + 'make test Run fixture and demo tests' \ 'make install Install mcol and its manual' \ 'make uninstall Remove installed files' \ 'make clean Remove generated artifacts' \ blob - /dev/null blob + a3a75596d444e0e8f8f8ac573fff05562e86c7ac (mode 644) --- /dev/null +++ LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2026 mtmn + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. blob - 73d03f6f42c37dd0d01d033814130591f837d5a8 blob + 14e6c56e3ed6701066aae734fe37cd43cda677dd --- README.md +++ README.md @@ -2,13 +2,13 @@ Terminal browser for an MPD release archive, written in Chez Scheme. -The input directory must contain `all.txt`. Its non-empty lines are -slash-separated release paths, read as: +mcol scans dated release lists and builds its release list from their +slash-separated paths, read as: - `artist/album` - `label/artist/release` (or a longer label/artist/release path) -Parent paths are not counted as releases. mcol scans the catalog and recognized +Blank lines and parent paths are not counted as releases. mcol scans recognized dated lists without a date cutoff: - `YEAR/MONTH/dailies/YYYY-MM-DD.txt`, or historical `DD_MM_YYYY.txt` @@ -16,11 +16,6 @@ dated lists without a date cutoff: - `YEAR/dailies/stdin_playlist_YYYYMMDD*.txt` as a fallback when no daily exists - `YEAR/MONTH/1_..._....txt` through `YEAR/MONTH/4_..._....txt` for weekly lists -`MONTH` is a full English month name. Multiple session playlists for a date are -merged. Weekly and daily totals are compared in the Weeks view, never combined. -Files below `mixes/` or `labels/` are ignored. `--strict` rejects malformed -filenames in recognized daily and weekly locations. - ## Run Requires Chez Scheme 10.4 or newer. Playback requires `mpc`. @@ -32,7 +27,7 @@ make tui INPUT=/path/to/releases Input is chosen from `--input`, then `MCOL_INPUT`, then the current directory: ```sh -export MCOL_INPUT=~/src/mtmn.name/releases +export MCOL_INPUT=/path/to/releases make tui ``` @@ -50,10 +45,12 @@ a artists s search r random play p play release q queue release nn next page pp prev page b back ? help / filter +x exit ``` Enter a row number to open it. Commands such as `:month 2026-08`, -`:day 2026-08-11`, `:label Warp`, `:artist Autechre`, and `:search Autechre` +`:day 2026-08-11`, `:label Warp`, `:artist Autechre`, `:release Label/Artist/Release`, and +`:search Autechre` are also accepted. `r` prompts for a random-release count (default: 5). Use `p 4 5 2` to append @@ -64,7 +61,7 @@ them without changing playback. ```sh make build -make test INPUT=/path/to/releases +make test make install # /usr/local make install PREFIX=~/.local ``` blob - 63a094f0efcff0274c7d0b113ca7eb84f699559e blob + 7c7972f063378a9abe92944ab1d65489f697428e --- bin/mcol.ss +++ bin/mcol.ss @@ -6,6 +6,7 @@ (define (usage port) (display "Usage: mcol [--input PATH] [--strict]\n" port) (display "Input: --input PATH, then MCOL_INPUT, then the current directory.\n" port) + (display "PATH is scanned for recognized dated daily, session, and weekly release lists.\n" port) (display "Runs the interactive ANSI terminal browser. Set NO_COLOR=1 to disable color.\n" port)) (define arguments (cdr (command-line))) blob - a26e5133697c62ba42413cd19c29659bddee9cea blob + 00a8b5821d650fb018b6a35d398931f226d39fc7 --- demo/README.md +++ demo/README.md @@ -6,5 +6,5 @@ Run this small set of release lists from the repositor make tui INPUT=demo ``` -The dated lists demonstrate daily, legacy, session, and weekly activity -sources. mcol derives its browsable release library from these files. +The dated lists demonstrate daily, legacy, session, and weekly sources. mcol +builds its release list from these files. blob - 95e2464c6878a517eb2e5fe7da0f74b22d682ad1 blob + 7379731b83ccd1cc1a32ff103eb6d085a7d17ac8 --- doc/mcol.1 +++ doc/mcol.1 @@ -7,25 +7,22 @@ mcol \- browse an MPD release archive .RB [ \-\-strict ] .SH DESCRIPTION .B mcol -is a terminal browser for a directory of release lists. -The directory must contain an -.I all.txt -catalog. Each non-empty line is a slash-separated release path. Two-part -paths are interpreted as artist/album; paths with three or more parts are -interpreted as label/artist/release, with any remaining parts retained in the -release name. Parent paths are not counted as releases. +is a terminal browser for a directory of dated release lists. It builds its +release list from recognized files. Each non-empty line is one +slash-separated release path. Two-part paths are interpreted as artist/album; +paths with three or more parts are interpreted as label/artist/release, with +any remaining parts retained in the release name. Blank lines and parent paths +are not counted as releases. .PP The input directory comes from .BR \-\-input , .BR MCOL_INPUT , or the current directory, in that order. -The catalog and recognized dated lists are scanned without a date cutoff. +Recognized dated lists are scanned without a date cutoff. Playback uses .BR mpc (1). .SH ARCHIVE LAYOUT -In addition to -.IR all.txt , -mcol recognizes these text-list locations beneath the input directory: +mcol recognizes these dated text-list locations beneath the input directory: .TP .I YEAR/MONTH/dailies/YYYY-MM-DD.txt Daily additions, where MONTH is a full English month name. The historical @@ -41,8 +38,7 @@ Session playlists. Multiple playlists for a date are only when no daily list exists for that date. .TP .I YEAR/MONTH/1_..._....txt through YEAR/MONTH/4_..._....txt -Weekly lists. Weekly and daily totals are shown side by side and are not -combined. +Weekly lists. .PP Other text files, including files below directories named .IR mixes blob - 346232c998df4635eafb80515b5c8c5a405e7d4a blob + 48c89f1ba7d2310515cb27fa3f798c06fe4257fd --- src/mcol/core.sls +++ src/mcol/core.sls @@ -4,7 +4,10 @@ summarize normalize-path days-in-month - report-ref) + report-ref + string-prefix? + string-suffix? + unlabeled-artist-album) (import (chezscheme)) (define-record-type entry (fields normalized components)) (define-record-type source (fields path kind date period-start period-end entries)) @@ -77,8 +80,6 @@ (and year month day (<= 1 month 12) (<= 1 day (days-in-month year month)))) (define (date-string year month day) (format "~4,'0d-~2,'0d-~2,'0d" year month day)) - (define (date<=? a b) - (or (string=? a b) (string cdr] [else #f])) + (define unlabeled-artist-album "(artist / album)") (define (path-join left right) (cond [(string=? left "") right] @@ -160,7 +162,6 @@ (substring file 0 (- (string-length file) 4)) file)]) (cond - [(string=? relative "all.txt") (values 'catalog #f #f #f #f)] [(or (< (length parts) 2) (string=? (car parts) "mixes")) (values 'ignored #f #f #f #f)] [else (let ([year (integer-safe (car parts))]) @@ -218,8 +219,6 @@ (define (scan-database root . options) (unless (file-directory? root) (error 'scan-database "input is not a directory" root)) - (unless (file-regular? (path-join root "all.txt")) - (error 'scan-database "input does not contain all.txt" root)) (let ([strict? (and (pair? options) (car options))]) (let loop ([files (sort (lambda (a b) (string - cdr] - [else #f])) + (define field report-ref) (define (entry->item item) (let ([parts (entry-components item)]) (cond @@ -356,6 +349,16 @@ table)) (define (canonical-days canonical) (map (lambda (date) (file-summary (hashtable-ref canonical date #f))) (sorted-keys canonical))) + (define (dated-catalog canonical database) + (append (fold-left (lambda (entries date) + (append entries + (source-entries (hashtable-ref canonical date #f)))) + '() + (sorted-keys canonical)) + (fold-left (lambda (entries item) + (append entries (source-entries item))) + '() + (sources-of-kind database 'weekly)))) (define (expected-month-days period) (let ([year (string->number (substring period 0 4))]) (days-in-month year (string->number (substring period 5 7))))) @@ -405,8 +408,8 @@ (hashtable-set! counts (car parts) (+ 1 (hashtable-ref counts (car parts) 0)))] [(= (length parts) 2) (hashtable-set! counts - "(artist / album)" - (+ 1 (hashtable-ref counts "(artist / album)" 0)))]))) + unlabeled-artist-album + (+ 1 (hashtable-ref counts unlabeled-artist-album 0)))]))) (terminal-entries (source-entries (hashtable-ref canonical date #f))))) (table-keys canonical)) (sort (lambda (a b) @@ -420,10 +423,10 @@ (map (lambda (item) (let* ([row (file-summary item)] [daily-total (fold-left (lambda (sum day) - (if (and (date<=? (source-period-start item) + (if (and (string<=? (source-period-start item) (field day 'date)) - (date<=? (field day + (string<=? (field day 'date) (source-period-end item))) (+ sum @@ -436,12 +439,8 @@ (sources-of-kind database 'weekly))) (define (summarize database) (let* ([canonical (canonical-sources database)] - [days (canonical-days canonical)]) - (let* ([catalog-sources (sources-of-kind database 'catalog)] - [catalog-source (and (pair? catalog-sources) (car catalog-sources))] - [catalog (if catalog-source - (source-entries catalog-source) - '())]) + [days (canonical-days canonical)] + [catalog (dated-catalog canonical database)]) (let-values ([(leaves single two three) (leaf-counts catalog)]) (object (cons 'current (object (cons 'paths (length (unique-entries catalog))) @@ -457,4 +456,4 @@ (cons 'days days) (cons 'months (aggregate-months days)) (cons 'weeks (weekly-summary database days)) - (cons 'labels (label-summary canonical)))))))) + (cons 'labels (label-summary canonical))))))) blob - 42ac9878c65171a6ebc00b799178faead66c7330 blob + aed87331336bdae87ea7b7e8eafcdc103b6f5a0c --- src/mcol/tui.sls +++ src/mcol/tui.sls @@ -28,12 +28,7 @@ (display "[2J") (display esc) (display "[H")) - (define (field object - key) - (report-ref object key)) - (define (string-prefix? prefix text) - (and (<= (string-length prefix) (string-length text)) - (string=? prefix (substring text 0 (string-length prefix))))) + (define field report-ref) (define (fmt number) (format "~:d" (or number 0))) (define (string-contains? text query) @@ -45,11 +40,6 @@ [(> (+ at (string-length query)) (string-length text)) #f] [(string=? query (substring text at (+ at (string-length query)))) #t] [else (loop (+ at 1))])))) - (define (string-suffix? suffix text) - (and (<= (string-length suffix) (string-length text)) - (string=? - suffix - (substring text (- (string-length text) (string-length suffix)) (string-length text))))) (define (trim-newlines text) (let loop ([end (string-length text)]) (if (and (> end 0) (memv (string-ref text (- end 1)) '(#\newline #\return))) @@ -590,7 +580,7 @@ (define (view-label) (let* ([matches? (lambda (item) - (if (string=? value "(artist / album)") + (if (string=? value unlabeled-artist-album) (string=? (field item 'type) "artist-album") @@ -827,7 +817,7 @@ [(and (string=? verb "artist") (not (string=? argument ""))) (open 'artist argument)] [(and (string=? verb "release") (not (string=? argument ""))) (open 'release argument)] [(and (string=? verb "search") (not (string=? argument ""))) (open 'search argument)] - [else (set! status-message (string-append "unknown command: " input))]))) + [else (status! (string-append "unknown command: " input) #t)]))) (define (string-index text character) (let loop ([at 0]) (cond @@ -863,9 +853,9 @@ (let ([count (string->number answer)]) (cond [(or (not count) (not (integer? count)) (<= count 0)) - (set! status-message "random play expects a positive number")] + (status! "random play expects a positive number" #t)] [(> count (length search-items)) - (set! status-message (format "only ~a releases available" (length search-items)))] + (status! (format "only ~a releases available" (length search-items)) #t)] [else (play-releases (random-releases count))]))]))] [(string=? verb "p") (batch-release-action "p" arguments play-releases)] [(string=? verb "q") (batch-release-action "q" arguments queue-releases)] @@ -875,7 +865,7 @@ (let ([needle (get-line (current-input-port))]) (cond [(eof-object? needle) (set! running? #f)] - [(string=? needle "") (set! status-message "search query cannot be empty")] + [(string=? needle "") (status! "search query cannot be empty" #t)] [else (open 'search needle)]))] [(string=? input "nn") (set! page (+ page 1))] [(string=? input "pp") (set! page (max 0 (- page 1)))] @@ -891,8 +881,8 @@ (<= 1 number (length current-actions)) (row-action (list-ref current-actions (- number 1)))) ((row-action (list-ref current-actions (- number 1)))) - (set! status-message "no selectable row with that number")))] - [else (set! status-message (string-append "unknown input: " input))])))) + (status! "no selectable row with that number" #t)))] + [else (status! (string-append "unknown input: " input) #t)])))) (dynamic-wind (lambda () (display esc) blob - a13565512953dcf6c09df4dc49b0a90e039ce9a5 blob + 165a4525ba0b0223d72675436d2236c62af10e0c --- test/test.ss +++ test/test.ss @@ -51,7 +51,6 @@ (define (fixture-test) (let ([root (format "/tmp/mcol-test-~a" (time-nanosecond (current-time)))]) (mkdir-p root) - (write-lines root "all.txt" '("Label/Artist/Release" "Artist/Album" "Solo")) (write-lines root "2026/may/dailies/2026-05-02.txt" '("Label" "Label/Artist" "Label/Artist/Release/" "Artist" "Artist/Album" "." "")) @@ -72,14 +71,14 @@ (field current 'labelReleases)) "three-part classification") - (check (= 1 + (check (= 4 (field current 'artistAlbums)) - "two-part classification") - (check (= 1 + "two-part dated records are catalogued") + (check (= 0 (field current 'single)) - "single classification") + "no undated catalog-only records") (check (= 3 (length days)) "all dated sources scanned") (check (string=? "2026-05-20" (field (cadr days) @@ -97,10 +96,10 @@ (length (field (car days) 'items))) "day exposes selectable releases") - (check (= 3 + (check (= 5 (length (field report 'catalog))) - "catalog exposes terminal records") + "catalog is derived from dated records") (check (= 2 (field (caddr days) 'additions)) @@ -119,22 +118,20 @@ (check (= 29 (days-in-month 2024 2)) "leap year") (check (= 28 (days-in-month 2025 2)) "common year")) -(define (repository-test) - (let ([root (or (getenv "MCOL_INPUT") ".")]) - (when (file-exists? (string-append root "/all.txt")) - (let* ([report (summarize (scan-database root))] - [current (field report - 'current)]) - (check (= 48572 - (field current - 'paths)) - "repository paths") - (check (= 7057 - (field current - 'roots)) - "repository roots"))))) +(define (demo-test) + (let* ([report (summarize (scan-database "demo"))] + [current (field report 'current)]) + (check (= 10 (field current 'paths)) "demo paths") + (check (= 0 (field current 'roots)) "demo roots") + (check (= 2 (field current 'artistAlbums)) "demo artist-albums") + (check (= 8 (field current 'labelReleases)) "demo label-releases") + (check (= 10 (field current 'terminalAdditions)) "demo terminal additions") + (check (= 6 (length (field report 'days))) "demo days") + (check (= 3 (length (field report 'months))) "demo months") + (check (= 2 (length (field report 'weeks))) "demo weeks") + (check (= 9 (length (field report 'labels))) "demo labels"))) (utility-test) (fixture-test) -(repository-test) +(demo-test) (format #t "mcol: ~a checks passed~%" checks)