commit 9c4862a918e2a3801571ae2566d37289990d4a10
Author: Lukas Henkel <lh@entf.net>
Date: Thu, 30 Nov 2023 21:53:51 +0100
Initial commit
Diffstat:
8 files changed, 344 insertions(+), 0 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -0,0 +1,2 @@
+\#*
+aoc
+\ No newline at end of file
diff --git a/aoc-test.asd b/aoc-test.asd
@@ -0,0 +1,4 @@
+(defsystem "aoc-test"
+ :class :package-inferred-system
+ :pathname "t"
+ :depends-on ("aoc-test/all"))
diff --git a/aoc.asd b/aoc.asd
@@ -0,0 +1,6 @@
+(defsystem "aoc"
+ :class :package-inferred-system
+ :pathname "src"
+ :depends-on ("aoc/main")
+ :in-order-to ((test-op (load-op "aoc-test")))
+ :perform (test-op (o c) (symbol-call :aoc-test :test-all)))
diff --git a/build.lisp b/build.lisp
@@ -0,0 +1,18 @@
+#!/bin/sh
+#|
+exec sbcl --script "build.lisp"
+|#
+(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp"
+ (user-homedir-pathname))))
+ (when (probe-file quicklisp-init)
+ (load quicklisp-init)))
+(push (probe-file #P".") asdf:*central-registry*)
+(ql:quickload :aoc)
+(loop for day from 1 to 25
+ do (handler-case
+ (asdf:load-system (format nil "aoc/day-~A" day))
+ (asdf:missing-component (c)
+ (declare (ignore c)))))
+(sb-ext:save-lisp-and-die "aoc"
+ :toplevel #'aoc:main
+ :executable t)
diff --git a/src/main.lisp b/src/main.lisp
@@ -0,0 +1,131 @@
+(defpackage #:aoc/main
+ (:use #:cl)
+ (:import-from #:alexandria)
+ (:import-from #:local-time)
+ (:import-from #:dexador)
+ (:nicknames #:aoc)
+ (:export
+ #:today
+ #:run-day
+ #:new-day
+ #:main))
+(in-package #:aoc/main)
+
+(defconstant +year+ 2023)
+
+(defvar *system* (asdf:find-system '#:aoc))
+
+(defvar *cookie* nil)
+
+(defun system-pathname (file)
+ (asdf:system-relative-pathname *system* file))
+
+(defun input-pathname (day)
+ (system-pathname (format nil "input/~A.txt" day)))
+
+(defun source-pathname (day)
+ (system-pathname (format nil "src/day-~A.lisp" day)))
+
+(defun test-pathname (day)
+ (system-pathname (format nil "t/day-~A.lisp" day)))
+
+(defun transform-input (input day)
+ (typecase input
+ (pathname
+ (values
+ (open input)
+ #'close))
+ (string
+ (values
+ (make-string-input-stream input)
+ #'close))
+ (stream
+ (values
+ input
+ nil))
+ (null
+ (values
+ (open (input-pathname day))
+ #'close))))
+
+(defun day-fun (day)
+ (let* ((fun (format nil "DAY-~A" day))
+ (package (format nil "AOC/~A" fun))
+ (package (or (find-package package)
+ (progn
+ (asdf:load-system (string-downcase package))
+ (find-package package))))
+ (fun (find-symbol fun package)))
+ (symbol-function fun)))
+
+(defun today ()
+ (local-time:timestamp-day (local-time:now)))
+
+(defun run-day (&optional (day (today)) input)
+ (multiple-value-bind (input cleanup)
+ (transform-input input day)
+ (unwind-protect
+ (funcall (day-fun day) input)
+ (when cleanup
+ (funcall cleanup input)))))
+
+(defun new-day (&optional (day (today)))
+ (let ((input-pathname (input-pathname day))
+ (source-pathname (source-pathname day))
+ (test-pathname (test-pathname day)))
+ (ensure-directories-exist input-pathname)
+ (ensure-directories-exist test-pathname)
+ (unless (probe-file input-pathname)
+ (restart-case
+ (unless *cookie*
+ (error "Advent Of Code cookie is unset"))
+ (use-cookie (cookie)
+ :interactive (lambda ()
+ (format t "Cookie: ")
+ (list (read-line)))
+ (setf *cookie* cookie)))
+ (alexandria:write-string-into-file
+ (dex:get (format nil "https://adventofcode.com/~A/day/~A/input" +year+ day)
+ :cookie-jar (cookie:make-cookie-jar
+ :cookies (list (cookie:make-cookie :name "session"
+ :value *cookie*
+ :domain ".adventofcode.com"))))
+ input-pathname))
+ (values
+ (unless (probe-file source-pathname)
+ (with-open-file (stream source-pathname :direction :output)
+ (let ((fun (make-symbol (format nil "DAY-~A" day)))
+ (package (make-symbol (format nil "AOC/DAY-~A" day)))
+ (*print-case* :downcase))
+ (format stream "~S~%~S~%~%(defun ~A (input)~% )"
+ `(defpackage ,package
+ (:use #:cl #:aoc/utils)
+ (:export
+ ,fun))
+ `(in-package ,package)
+ fun)))
+ ;; return function, makes it easy to jump into the file from Emacs
+ (day-fun day))
+ (unless (probe-file test-pathname)
+ (let ((package (make-symbol (format nil "AOC-TEST/DAY-~A" day)))
+ (*print-case* :downcase))
+ (with-open-file (stream test-pathname :direction :output)
+ (format stream "~S~%~S~%~%(define-test test-day-~A~% ()~% )"
+ `(defpackage ,package
+ (:use #:cl #:lisp-unit2))
+ `(in-package ,package)
+ day))
+ (asdf:load-system "aoc-test/day-1")
+ (symbol-function
+ (find-symbol (format nil "TEST-DAY-~A" day)
+ (find-package package))))))))
+
+(defun main ()
+ (let* ((args (uiop:command-line-arguments))
+ (today (or (first args)
+ (today)))
+ (input (or (and #1=(second args)
+ (parse-namestring #1#))
+ (input-pathname today))))
+ (dolist (task (multiple-value-list (run-day today input)))
+ (format t "~A~%" task))))
diff --git a/src/utils.lisp b/src/utils.lisp
@@ -0,0 +1,85 @@
+(uiop:define-package #:aoc/utils
+ (:use #:cl)
+ (:use-reexport #:alexandria #:serapeum #:split-sequence #:group-by)
+ (:export
+ #:read-input
+ #:read-input-fields
+ #:read-input-match
+ #:char-number
+ #:make-map))
+(in-package #:aoc/utils)
+
+(defun normalize-type (type)
+ (cond
+ ((or (eq type 'string)
+ (null type))
+ 'simple-string)
+ ((eq type 'number)
+ 'integer)
+ (t type)))
+
+(defun wrap-nullable (converter)
+ (lambda (line)
+ (if (= (length line) 0)
+ nil
+ (funcall converter line))))
+
+(defun get-type-converter (type)
+ (wrap-nullable
+ (if (functionp type)
+ type
+ (ecase (normalize-type type)
+ (simple-string #'identity)
+ (integer #'parse-integer)
+ (keyword (compose #'make-keyword #'string-upcase))))))
+
+(defun read-input (input &key (type 'string))
+ (loop with converter = (get-type-converter type)
+ for line = (read-line input nil)
+ while line
+ collect (funcall converter line)))
+
+(defun convert-fields (converters fields)
+ (loop for converter in converters
+ for field = (pop fields)
+ collect (funcall converter field)))
+
+(defun read-input-fields (input field-types &key (delimiter " "))
+ (loop with converters = (mapcar #'get-type-converter
+ field-types)
+ for line = (read-line input nil)
+ while line
+ collect (convert-fields converters
+ (split-sequence delimiter line :test #'string=))))
+
+(defun read-input-match (input regex &key types)
+ (loop with scanner = (ppcre:create-scanner regex)
+ with converters = (and types (mapcar #'get-type-converter types))
+ for line = (read-line input nil)
+ for groups = (and line
+ (multiple-value-bind (match groups)
+ (ppcre:scan-to-strings scanner line)
+ (and match (coerce groups 'list))))
+ while groups
+ collect (if converters
+ (convert-fields converters groups)
+ groups)))
+
+
+(defun char-number (char)
+ (- (char-int char) 48))
+
+(defun make-map (input &key (value #'identity) delimiter)
+ (loop with width = nil
+ with data = nil
+ for row = (read-line input nil)
+ for height from 0
+ while (and row (> (length row) 0))
+ do (let ((fields (mapcar value (if delimiter
+ (split-sequence delimiter row :test #'string=)
+ (coerce row 'list)))))
+ (unless width
+ (setf width (length row)))
+ (push fields data))
+ finally (return (make-array (list height width)
+ :initial-contents (nreverse data)))))
diff --git a/t/all.lisp b/t/all.lisp
@@ -0,0 +1,26 @@
+(defpackage #:aoc-test/all
+ (:use #:cl #:lisp-unit2)
+ (:nicknames #:aoc-test)
+ (:import-from #:aoc-test/utils)
+ (:export
+ #:test-day
+ #:test-all))
+(in-package #:aoc-test/all)
+
+(defun test-day (&optional (day (aoc:today)))
+ (run-tests :package (format nil "AOC-TEST/DAY-~A" day)
+ :run-contexts 'with-summary-context))
+
+;; TODO: the asdf:load-system might not be so great here
+(defun test-all ()
+ (run-tests :tests (nconc
+ (get-tests :package '#:aoc-test/utils)
+ (loop for day from 1 to 25
+ for system = (format nil "aoc-test/day-~A" day)
+ nconc (handler-case
+ (progn
+ (asdf:load-system system)
+ (get-tests :package (string-upcase system)))
+ (asdf:missing-component (c)
+ (declare (ignore c))))))
+ :run-contexts 'with-summary-context))
diff --git a/t/utils.lisp b/t/utils.lisp
@@ -0,0 +1,71 @@
+(uiop:define-package #:aoc-test/utils
+ (:use #:cl)
+ (:mix #:lisp-unit2 #:aoc/utils))
+(in-package #:aoc-test/utils)
+
+(define-test test-read-input
+ ()
+ (with-input-from-string (stream "hello
+world")
+ (assert-equalp '("hello" "world")
+ (read-input stream)))
+ (with-input-from-string (stream "1
+2
+3
+
+3
+2
+1")
+ (assert-equalp '(1 2 3 nil 3 2 1)
+ (read-input stream :type 'integer)))
+ (with-input-from-string (stream "this
+does
+not
+matter")
+ (assert-equalp '(1 1 1 1)
+ (read-input stream :type (lambda (line)
+ (declare (ignore line))
+ 1)))))
+
+(define-test test-read-input-fields
+ ()
+ (with-input-from-string (stream "A 1
+B 2
+C 3
+D
+E 5
+
+G 7")
+ (assert-equalp '(("A" 1)
+ ("B" 2)
+ ("C" 3)
+ ("D" nil)
+ ("E" 5)
+ (nil nil)
+ ("G" 7))
+ (read-input-fields stream '(string integer)))))
+
+(define-test test-read-input-match
+ ()
+ (with-input-from-string (stream "x: 1, y: 2
+x: 3, y: 4
+x: 2, y: 5")
+ (assert-equalp '(("x" 1 "y" 2)
+ ("x" 3 "y" 4)
+ ("x" 2 "y" 5))
+ (read-input-match stream
+ "(\\w+): (\\d+), (\\w+): (\\d+)"
+ :types '(string integer string integer)))))
+
+
+(define-test test-make-map
+ ()
+ (with-input-from-string (stream "12345
+54321
+12345
+54321")
+ (assert-equalp #2A((1 2 3 4 5)
+ (5 4 3 2 1)
+ (1 2 3 4 5)
+ (5 4 3 2 1))
+ (make-map stream :value #'char-number))))
