; head [-n count | -c bytes] [file...]: the first lines (10) or bytes of
; each file, or of the input (- or none); with more than one file each
; comes after a ==> name <== line. The bytes go as they are: a last line
; without its newline stays without one.

(def usage "usage: head [-n count | -c bytes] [file...]")
(def opt (fn (opts letter default) (fold (fn (v o) (letv (l val) o (if (= l letter) val v))) default opts)))
(def has (fn (opts letter) (> (length (filter (fn (o) (letv (l val) o (= l letter))) opts)) 0)))
(def whole (re-compile "^[0-9][0-9]*$"))
(def is-stdin (fn (src) (and (= (type-of src) "string") (= src "-"))))
(def opened (fn (name) (if (= name "-") "-" (file-open name))))
(def next-line (fn (src) (if (is-stdin src) (in-line) (file-line src))))
(def next-bytes (fn (src n) (if (is-stdin src) (in-read n) (file-read src n))))

; -5, the old way, is -n 5
(def args (if (and (> (length ARGS) 0) (> (byte-len (nth ARGS 0)) 1) (= (byte-sub (nth ARGS 0) 0 1) "-")
                   (not (is-nil (re-match whole (byte-sub (nth ARGS 0) 1)))))
            (list-concat (list "-n" (byte-sub (nth ARGS 0) 1)) (tail ARGS))
            ARGS))

(def lines (fn (src n)
  (iterate (fn (left)
             (if (<= left 0) (list)
               (let ((l (next-line src)))
                 (if (is-nil l) (list) (do (out-write l) (- left 1))))))
           n)))

(def some-bytes (fn (src n)
  (iterate (fn (left)
             (if (<= left 0) (list)
               (let ((b (next-bytes src (math-min left 65536))))
                 (if (is-nil b) (list) (do (out-write b) (- left (byte-len b)))))))
           n)))

(letv (opts files bad) (getopt args "n:c:")
  (let ((count (opt opts "n" "10")) (bytes (opt opts "c" "")))
    (cond ((not (= bad "")) (do (err-write "head: bad option -" bad "\n" usage "\n") (exit-status 1)))
          ((or (is-nil (re-match whole count)) (and (not (= bytes "")) (is-nil (re-match whole bytes))))
           (do (err-write "head: the count is a number\n") (exit-status 1)))
          (else
            (let ((names (if (= (length files) 0) (list "-") files)) (many (> (length files) 1)))
              ; (status headers-written)
              (letv (st shown)
                    (fold (fn (acc name)
                            (letv (st shown) acc
                              (let ((src (opened name)))
                                (if (and (= (type-of src) "string") (not (is-stdin src)))
                                  (do (err-write "head: " name ": " src "\n") (tuple 1 shown))
                                  (do (if many (out-write (if (> shown 0) "\n" "") "==> " name " <==\n") #f)
                                      (if (= bytes "") (lines src (number count)) (some-bytes src (number bytes)))
                                      (if (is-stdin src) #f (file-close src))
                                      (tuple st (+ shown 1)))))))
                          (tuple 0 0) names)
                (exit-status st)))))))