(lambda (xml-pathname output-pathname)
  ;; Fix MusicXML tied notation information.
  ;;
  ;; Inputs:
  ;;
  ;;   input 1 = xml-pathname
  ;;   input 2 = output-pathname
  ;;
  ;; Output filename:
  ;;
  ;;   original-name_fixed_tied.musicxml
  ;;
  ;; Purpose:
  ;;
  ;;   This function reads an uncompressed MusicXML file and fixes
  ;;   missing <tied> notation tags according to existing <tie> tags.
  ;;
  ;; Rule:
  ;;
  ;;   If a <note> has:
  ;;     <tie type="start"/>
  ;;   then the same <note> should also have:
  ;;     <tied type="start"/>
  ;;
  ;;   If a <note> has:
  ;;     <tie type="stop"/>
  ;;   then the same <note> should also have:
  ;;     <tied type="stop"/>
  ;;
  ;; Notes:
  ;;
  ;;   Use an uncompressed .xml or .musicxml file.
  ;;   This does not handle .mxl directly.

  (labels
      ((fixed-pathname (xml-path out-path)
         ;; Use the original XML filename and append a fixed suffix.
         ;; The output directory is taken from output-pathname.
         (let* ((original-name (pathname-name xml-path))
                (new-name
                 (format nil "~A_fixed_tied" original-name)))
           (make-pathname
            :name new-name
            :type "musicxml"
            :defaults out-path)))

       (read-file-to-string (path)
         (with-open-file
             (in path
                 :direction :input)
           (with-output-to-string (s)
             (loop for line = (read-line in nil nil)
                   while line
                   do (format s "~A~%" line)))))

       (write-string-to-file (text path)
         (with-open-file
             (out path
                  :direction :output
                  :if-exists :supersede
                  :if-does-not-exist :create)
           (format out "~A" text)))

       (contains-string-p (text pattern)
         (not (null (search pattern text :test #'char-equal))))

       (find-next (pattern text start)
         (search pattern text :start2 start :test #'char-equal))

       (substring-safe (text start end)
         (cond
           ((and start
                 end
                 (>= start 0)
                 (>= end start)
                 (<= end (length text)))
            (subseq text start end))
           (t
            "")))

       (note-has-tie-start-p (note-block)
         (or
          (contains-string-p note-block "<tie type=\"start\"")
          (contains-string-p note-block "<tie type='start'")))

       (note-has-tie-stop-p (note-block)
         (or
          (contains-string-p note-block "<tie type=\"stop\"")
          (contains-string-p note-block "<tie type='stop'")))

       (note-has-tied-start-p (note-block)
         (or
          (contains-string-p note-block "<tied type=\"start\"")
          (contains-string-p note-block "<tied type='start'")))

       (note-has-tied-stop-p (note-block)
         (or
          (contains-string-p note-block "<tied type=\"stop\"")
          (contains-string-p note-block "<tied type='stop'")))

       (indentation-before (text pos)
         ;; Return the whitespace between the previous newline and pos.
         (let ((i (- pos 1))
               (start 0))
           (loop while (and (>= i 0)
                            (not (char= (char text i) #\Newline)))
                 do (setf i (- i 1)))
           (setf start (+ i 1))
           (let ((j start))
             (loop while (and (< j pos)
                              (or (char= (char text j) #\Space)
                                  (char= (char text j) #\Tab)))
                   do (setf j (+ j 1)))
             (subseq text start j))))

       (make-tied-lines (need-start need-stop base-indent)
         ;; Stop first, then start, for a middle tied note.
         (let ((lines ""))
           (when need-stop
             (setf lines
                   (concatenate
                    'string
                    lines
                    base-indent
                    "  <tied type=\"stop\"/>"
                    (string #\Newline))))
           (when need-start
             (setf lines
                   (concatenate
                    'string
                    lines
                    base-indent
                    "  <tied type=\"start\"/>"
                    (string #\Newline))))
           lines))

       (insert-before (text pos insert-text)
         (concatenate
          'string
          (subseq text 0 pos)
          insert-text
          (subseq text pos)))

       (fix-one-note-block (note-block)
         ;; Return:
         ;;   fixed-note-block, added-start, added-stop, changed
         (let* ((has-tie-start (note-has-tie-start-p note-block))
                (has-tie-stop (note-has-tie-stop-p note-block))
                (has-tied-start (note-has-tied-start-p note-block))
                (has-tied-stop (note-has-tied-stop-p note-block))
                (need-start (and has-tie-start
                                 (not has-tied-start)))
                (need-stop (and has-tie-stop
                                (not has-tied-stop)))
                (added-start 0)
                (added-stop 0)
                (changed nil)
                (fixed note-block))

           (when need-start
             (setf added-start 1))

           (when need-stop
             (setf added-stop 1))

           (when (or need-start need-stop)
             (setf changed t)

             (let* ((notations-start
                     (find-next "<notations" fixed 0))
                    (notations-end
                     (find-next "</notations>" fixed 0)))

               (cond
                 ((and notations-start notations-end)
                  (let* ((base-indent
                          (indentation-before fixed notations-end))
                         (insert-text
                          (make-tied-lines
                           need-start
                           need-stop
                           base-indent)))
                    (setf fixed
                          (insert-before fixed notations-end insert-text))))

                 (t
                  (let* ((note-end
                          (find-next "</note>" fixed 0))
                         (base-indent
                          (if note-end
                              (indentation-before fixed note-end)
                              "    "))
                         (child-indent
                          (concatenate 'string base-indent "  "))
                         (tied-lines
                          (make-tied-lines
                           need-start
                           need-stop
                           child-indent))
                         (insert-text
                          (concatenate
                           'string
                           base-indent
                           "<notations>"
                           (string #\Newline)
                           tied-lines
                           base-indent
                           "</notations>"
                           (string #\Newline))))
                    (when note-end
                      (setf fixed
                            (insert-before fixed note-end insert-text))))))))

           (list fixed added-start added-stop changed)))

       (fix-all-note-blocks (xml-text)
         ;; Return:
         ;;   fixed-xml, note-count, added-start, added-stop, changed-notes
         (let ((pos 0)
               (out "")
               (note-count 0)
               (added-start-total 0)
               (added-stop-total 0)
               (changed-note-total 0))

           (loop
             for note-start = (find-next "<note" xml-text pos)
             while note-start
             do
               (let* ((note-open-end
                       (position #\> xml-text :start note-start))
                      (note-end
                       (and note-open-end
                            (find-next "</note>" xml-text note-open-end))))

                 (cond
                   ((and note-open-end note-end)
                    (setf out
                          (concatenate
                           'string
                           out
                           (substring-safe xml-text pos note-start)))

                    (let* ((note-block
                            (substring-safe
                             xml-text
                             note-start
                             (+ note-end (length "</note>"))))
                           (result
                            (fix-one-note-block note-block))
                           (fixed-note-block (first result))
                           (added-start (second result))
                           (added-stop (third result))
                           (changed (fourth result)))

                      (incf note-count)

                      (setf added-start-total
                            (+ added-start-total added-start))

                      (setf added-stop-total
                            (+ added-stop-total added-stop))

                      (when changed
                        (incf changed-note-total))

                      (setf out
                            (concatenate
                             'string
                             out
                             fixed-note-block))

                      (setf pos
                            (+ note-end (length "</note>")))))

                   (t
                    (setf out
                          (concatenate
                           'string
                           out
                           (substring-safe xml-text pos (length xml-text))))
                    (setf pos (length xml-text))))))

           (when (< pos (length xml-text))
             (setf out
                   (concatenate
                    'string
                    out
                    (substring-safe xml-text pos (length xml-text)))))

           (list out
                 note-count
                 added-start-total
                 added-stop-total
                 changed-note-total))))

    ;; Main process.
    (let* ((xml-text (read-file-to-string xml-pathname))
           (outpath (fixed-pathname
                     xml-pathname
                     output-pathname))
           (result (fix-all-note-blocks xml-text))
           (fixed-xml (first result))
           (note-count (second result))
           (added-start-count (third result))
           (added-stop-count (fourth result))
           (changed-note-count (fifth result)))

      (write-string-to-file fixed-xml outpath)

      (format nil
              "Fixed MusicXML written to:~%~A~%~%Notes scanned: ~A~%Notes changed: ~A~%Added tied start: ~A~%Added tied stop: ~A"
              outpath
              note-count
              changed-note-count
              added-start-count
              added-stop-count))))