A small guile/scheme script for reading translation memery in TMX format

tmx-read.scm

;; -*- geiser-scheme-implementation: guile -*
;;
;; Reading TMX (translation memory)
;;
;; Copyright (c) 2017 Vee Satayamas.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;; ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE FOUNDATION OR CONTRIBUTORS
;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;; POSSIBILITY OF SUCH DAMAGE.


(use-modules (srfi srfi-26))
(use-modules (sxml simple))
(use-modules (ice-9 pretty-print))

(define (read-xml file-path)
  (call-with-input-file file-path
    (lambda (port)
      (xml->sxml port))))

(define (select-children-by-tag node tag)
  (let* ((children (cddr node))
         (non-text-children (filter list? children))
         (eq-tag? (lambda (node)
                    (eq? tag (car node)))))
    (filter eq-tag? non-text-children)))

(define (tuv->text tuv)
  (let* ((segments (select-children-by-tag tuv 'seg))
         (texts (map (cut cadr <>) segments)))
    (car texts)))

(define (tmx->textpairs tmx)
  (let* ((body (car (select-children-by-tag tmx 'body)))
         (tu-nodes (select-children-by-tag body 'tu))
         (tuv-pairs (map (cut select-children-by-tag <> 'tuv)
                         tu-nodes)))
    (map (cut map tuv->text <>) tuv-pairs)))

(define (read-tmx file-path)
  (let* ((xml (read-xml file-path))
         (tmx (caddr xml)))
    (tmx->textpairs tmx)))

; (display (vector-ref (list->vector (read-tmx "th.mozillaorg.tmx")) 18))