; Author: Juergen Lorenz ; ju (at) jugilo (dot) de
;
; Copyright (c) 2016-2019, Juergen Lorenz
; All rights reserved.
; 
; Redistribution and use in source and binary forms, with or without
; modification, are permitted provided that the following conditions are
; met:
; 
; Redistributions of source code must retain the above copyright
; notice, this list of conditions and the following dispasser.
; 
; Redistributions in binary form must reproduce the above copyright
; notice, this list of conditions and the following dispasser in the
; documentation and/or other materials provided with the distribution.
; 
; Neither the name of the author nor the names of its contributors may be
; used to endorse or promote products derived from this software without
; specific prior written permission. 
; 
; 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 COPYRIGHT
; HOLDERS 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.

(module pipes (pipes pipe pipe* flip*)
  (import scheme
          (only (chicken base) case-lambda print error))

;;;; (pipe x (fn . xs) ...)
;;;; ----------------------
;;;; sequencing curried combinations

(define-syntax pipe
  (syntax-rules ()
    ((_ x) x)
    ((_ x (fn . xs))
     (fn x . xs))
    ((_ x (fn . xs) (gn . ys) ...)
     (pipe (fn x . xs) (gn . ys) ...))))

(define-syntax pipe*
  (syntax-rules ()
    ((_ (fn . xs) ...)
     (lambda (x)
       (pipe x (fn . xs) ...)))))

;;; (flip* proc)
;;; --------
;;; multi argument version of flip, which can be used in pipe
(define (flip* proc) ; ok
  (lambda args
    (if (null? args)
      (proc)
      (apply proc (append (cdr args)
                          (list (car args)))))))

;;; (pipes sym ..)
;;; -------------------------
;;; documentation procedure
(define pipes
  (let ((als '(
    (pipes
      procedure:
      (pipes sym ..)
      "documentation procedure")
    (flip*
      procedure:
     (flip* proc)
     "multi argument version of flip, which can be used in pipes")
    (pipe
      macro:
      (pipe x (fn . xs) ...)
      "applying x as additional first argument to the partial"
      "combination (fn . xs) and its result iteratively to the"
      "partial combinations at its right")
    (pipe*
      macro:
      (pipe* (fn . xs) ...)
      "pipe as a procedure")
    )))
    (case-lambda
      (()
       (map car als))
      ((sym)
       (let ((pair (assq sym als)))
         (if pair
           (for-each print (cdr pair))
           (error "Not in list"
                  sym
                  (map car als))))))))
) ; pipes