Commit Diff


commit - /dev/null
commit + 9c4862a918e2a3801571ae2566d37289990d4a10
blob - /dev/null
blob + 3101d2ee3ad22f43ae19dc8eaf32df0243c80af6 (mode 644)
--- /dev/null
+++ .gitignore
@@ -0,0 +1,2 @@
+\#*
+aoc
\ No newline at end of file
blob - /dev/null
blob + bcff3d39538141658fb175b2dd3a51c7b849cbea (mode 644)
--- /dev/null
+++ aoc-test.asd
@@ -0,0 +1,4 @@
+(defsystem "aoc-test"
+  :class :package-inferred-system
+  :pathname "t"
+  :depends-on ("aoc-test/all"))
blob - /dev/null
blob + 4f5cc9bbfc282d4201deba3980a29d24891dbeb8 (mode 644)
--- /dev/null
+++ 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)))
blob - /dev/null
blob + 7d14b1f98774cb709c4b247977b243eec526eeb1 (mode 755)
--- /dev/null
+++ 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)
blob - /dev/null
blob + 524ebc736fef4bf40ef2c128efa97bf73cceacd1 (mode 644)
--- /dev/null
+++ 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))))
blob - /dev/null
blob + 2bf81d9d9e3aac98879b9a786c59d4e6152def24 (mode 644)
--- /dev/null
+++ 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)))))
blob - /dev/null
blob + d0383017de7bdd34a479c77ce4d3ee580e1c3fb8 (mode 644)
--- /dev/null
+++ 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))
blob - /dev/null
blob + 70161420ae9faf7d1e73083916561d2d702ec2c5 (mode 644)
--- /dev/null
+++ 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))))