(library (sph list extra)
  (export
    any->list
    any->list-s
    first-if-single
    integer->list
    length-greater-one?
    length-one?
    produce-controlled
    true->list-s)
  (import
    (sph)
    (sph list))

  (define (first-if-single a)
    "list -> any/list
     give the first element of a list if the list has only one element, otherwise give the list"
    (if (or (null? a) (not (null? (tail a)))) a (first a)))

  (define-syntax-rule (any->list-s a)
    ; "like \"any->list\" but as syntax"
    (if (list? a) a (list a)))

  (define-syntax-rule (true->list-s a)
    ; "like \"any->list-s\" but results in \"a\" if \"a\" is not true"
    (if a (any->list-s a) a))

  (define (true->list a)
    "any -> list/false
     wraps a true non-list argument in a list"
    (if a (any->list a) a))

  (define (integer->list a)
    "any -> any/list
     wrap the argument in a list, but only if it is an integer. otherwise give the argument"
    (if (integer? a) (list a) a))

  (define (length-one? a)
    "list -> boolean
     test if list length equals one"
    (if (null? a) #f (null? (tail a))))

  (define (length-greater-one? a)
    "list -> boolean
     true if list length is greater than one.
     has-multiple-elements?"
    (if (null? a) #f (not (null? (tail a)))))

  #;(produce-controlled
    ((unquote list) ((unquote map) (unquote map)) (1 2) (3 4))
    (((1 3) (1 4)) ((2 3) (2 4))))

  (define (produce-controlled f mappers . lists)
    "{any ... -> any} (procedure:{procedure:{any -> any} list -> list} ...) any/list ... -> list
     experimental.
     apply \"f\" to each ordered combination of elements from one or multiple lists, the cartesian product,
     and return the results in a list.
     the combinations passed to \"f\" are obtained by nested application of the procedures in the second argument list.
     there should be as many lists as mappers.
     accepts multiple lists, multiple mappers and non-list arguments.
     example:
       (produce-controlled f (f1 f2 f3) (1 2) (4 5) (6 7))
     is equivalent to
       (f1 (lambda (a) (f2 (lambda (b) (f3 (lambda (c) (f a b c)) (6 7))) (4 5))) (1 2))"
    (let loop ((rest-mappers mappers) (rest-lists (map any->list lists)) (a (list)))
      (if (null? rest-mappers) (apply f a)
        ( (first rest-mappers)
          (let ((tail-mappers (tail rest-mappers)) (tail-lists (tail rest-lists)))
            (l e (loop tail-mappers tail-lists (append a e))))
          (first rest-lists))))))