Gauche:SXML:SXPath:sxpathのwrapper

yamasushi(2013/03/22 11:38:23 UTC)sxpathのwrapperを書いてみました。$マクロで使うときのために、sxpath*などを用意しました。

; if-sxpath , if-car-sxpath が名前空間を渡せないので作った補助
(define-module sxpath-helper
  (use sxml.sxpath :prefix sxml:)
  (export 
    sxpath 
    if-car-sxpath 
    if-sxpath 
    car-sxpath
    sxpath*
    if-car-sxpath* 
    if-sxpath*
    car-sxpath*
    )
)
(select-module sxpath-helper)

;返り値を拡張する
; ok?....これに失敗すると返り値は#f
; fが関数でないなら#f
(define (if-*fn$ f ok? :optional (trans identity) )
  (and (procedure? f)
    (^ arg
      (let1 r (apply f arg)
        (and r (ok? r) (trans r) ) ) ) ) )

(define if-listfn$     (cut if-*fn$ <> pair? ) )
(define if-car-listfn$ (cut if-*fn$ <> pair? car    ) )
(define if-stringfn$   (cut if-*fn$ <> (complement string-null?) ) )

(define (sxpath . arg)
  (guard [e [else (pretty-print e) ] ]
    (apply sxml:sxpath arg)
  ))

(define (if-sxpath xpath :optional (ns '()))
  (if-listfn$ (sxpath xpath ns) ) )

(define (if-car-sxpath xpath :optional (ns '()))
  (if-car-listfn$ (sxpath xpath ns) ) )

(define (car-sxpath xpath :optional (ns '()))
  (car-listfn$ (sxpath xpath ns) ) )

(define (sxpath*        xpath ns sxml) ((sxpath        xpath ns) sxml ) )
(define (if-sxpath*     xpath ns sxml) ((if-sxpath     xpath ns) sxml ) )
(define (if-car-sxpath* xpath ns sxml) ((if-car-sxpath xpath ns) sxml ) )
(define (car-sxpath*    xpath ns sxml) ((car-sxpath    xpath ns) sxml ) )

Tags: sxml.sxpath, SXML, SXPath