(defun read-string (str)
  (flow str (mapcar (relate '(#\[ #\] #\,) '(#\( #\) #\space))) read))

(defun read-input (: (name "input"))
  (flow name file-get-lines (mapcar read-string)))

(defun ladd (n sn)
  (tree-case sn
    ((a b) ^(,(ladd n a) ,b))
    (m (+ n m))))

(defun radd (sn n)
  (tree-case sn
    ((a b) ^(,a ,(radd b n)))
    (m (+ m n))))

(defun explode (sn)
  (tree-case sn
    ((((((a b) x) y) z) w) ^((((0 ,(ladd b x)) ,y) ,z) ,w))
    (((((x (a b)) y) z) w) ^((((,(radd x a) 0) ,(ladd b y)) ,z) ,w))
    ((((y ((a b) x)) z) w) ^(((,(radd y a) (0 ,(ladd b x))) ,z) ,w))
    ((((y (x (a b))) z) w) ^(((,y (,(radd x a) 0)) ,(ladd b z)) ,w))
    (((z (((a b) x) y)) w) ^((,(radd z a) ((0 ,(ladd b x)) ,y)) ,w))
    (((z ((x (a b)) y)) w) ^((,z ((,(radd x a) 0) ,(ladd b y))) ,w))
    (((z (y ((a b) x))) w) ^((,z (,(radd y a) (0 ,(ladd b x)))) ,w))
    (((z (y (x (a b)))) w) ^((,z (,y (,(radd x a) 0))) ,(ladd b w)))
    ((w ((((a b) x) y) z)) ^(,(radd w a) (((0 ,(ladd b x)) ,y) ,z)))
    ((w (((x (a b)) y) z)) ^(,w (((,(radd x a) 0) ,(ladd b y)) ,z)))
    ((w ((y ((a b) x)) z)) ^(,w ((,(radd y a) (0 ,(ladd b x))) ,z)))
    ((w ((y (x (a b))) z)) ^(,w ((,y (,(radd x a) 0)) ,(ladd b z))))
    ((w (z (((a b) x) y))) ^(,w (,(radd z a) ((0 ,(ladd b x)) ,y))))
    ((w (z ((x (a b)) y))) ^(,w (,z ((,(radd x a) 0) ,(ladd b y)))))
    ((w (z (y ((a b) x)))) ^(,w (,z (,(radd y a) (0 ,(ladd b x))))))
    ((w (z (y (x (a b))))) ^(,w (,z (,y (,(radd x a) 0)))))
    (else else)))

(defun splt (sn)
  (tree-case sn
    ((a b)
     (let ((as (splt a))
           (bs (splt b)))
       (cond
         ((neq a as) ^(,as ,b))
         ((neq b bs) ^(,a ,bs))
         (t sn))))
    (m (if (< m 10)
         m
         (let* ((x (trunc m 2))
                (y (- m x)))
           ^(,x ,y))))))

(defun reduce (sn)
  (let (sn*)
    (while* (neq sn* sn)
      (while* (neq sn* sn)
        (shift sn* sn (explode sn)))
      (shift sn* sn (splt sn)))
    sn))

(defun add (sn0 sn1)
  (reduce (list sn0 sn1)))

(defun mag (sn)
  (tree-case sn
    ((a b) (+ (* 3 (mag a)) (* 2 (mag b))))
    (m m)))

(defun solve-one (: (name :))
  (flow name read-input (reduce-left add) mag))

(defun solve-two (: (name :))
  (flow name read-input (comb @1 2)
    (mappend [juxt [chain [apf add] mag]
                   [chain [apf [flipargs add]] mag]])
    find-max))