; cut -b list [-n] | -c list | -f list [-d delim] [-s] [file...]: the
; bytes (-b), characters (-c, UTF-8) or fields (-f, split by delim, a tab
; when none) of each line that the list names: 1,3-5,7- and -2, from 1, in
; the order of the line. A line without the delimiter goes whole with -f,
; or not at all with -s. -n is taken (bytes are never split here).

(def usage "usage: cut -b list [-n] | -c list | -f list [-d delim] [-s] [file...]")
(def has (fn (opts letter) (> (length (filter (fn (o) (letv (l val) o (= l letter))) opts)) 0)))
(def opt (fn (opts letter default) (fold (fn (v o) (letv (l val) o (if (= l letter) val v))) default opts)))
(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 strip (fn (l) (if (and (> (byte-len l) 0) (= (byte-at l (- (byte-len l) 1)) 10)) (byte-sub l 0 (- (byte-len l) 1)) l)))

; the list as (low high) ranges, high 0 for the end; nil when it does not read
(def range-re (re-compile "^([0-9]*)(-([0-9]*))?$" "E"))
(def part (fn (s m i) (let ((g (nth m i))) (if (is-nil g) "" (letv (a b) g (byte-sub s a b))))))
(def parse-list (fn (spec)
  (let ((pieces (str-split "," spec)))
    (let ((ranges (map (fn (p)
                         (let ((m (re-match range-re p)))
                           (if (or (is-nil m) (= p "") (= p "-")) (list)
                             (let ((lo (part p m 1)) (dash (not (is-nil (nth m 2)))) (hi (part p m 3)))
                               (let ((l (if (= lo "") 1 (number lo))))
                                 (tuple l (cond ((not dash) l) ((= hi "") 0) (else (number hi)))))))))
                       pieces)))
      (if (> (length (filter (fn (r) (or (is-nil r) (letv (l h) r (or (= l 0) (and (> h 0) (< h l)))))) ranges)) 0)
        (list) ranges)))))

; the ranges in order and joined where they meet, so that each is taken
; once from the line, in its order; high 0 is the end
(def far (fn (h) (if (= h 0) 9e15 h)))
(def merged (fn (ranges)
  (fold (fn (acc r)
          (letv (l h) r
            (if (= (length acc) 0) (list r)
              (letv (pl ph) (nth acc (- (length acc) 1))
                (if (<= l (+ (far ph) 1))
                  (list-append (slice acc 0 (- (length acc) 1)) (tuple pl (if (> (far h) (far ph)) h ph)))
                  (list-append acc r))))))
        (list) (list-sort ranges (fn (a b) (letv (al ah) a (letv (bl bh) b (- al bl))))))))
(def slice (fn (l i j) (map (fn (k) (nth l k)) (range i j))))
(def list-concat-all (fn (ls) (fold (fn (acc l) (list-concat acc l)) (list) ls)))

; the byte where character k (from 0) starts, walking from the character
; idx at byte pos; past the end, the end
(def lead-len (fn (b) (cond ((< b 128) 1) ((= (u32-and b 224) 192) 2) ((= (u32-and b 240) 224) 3) ((= (u32-and b 248) 240) 4) (else 1))))
(def skip-to (fn (line pos idx k)
  (letv (p i)
        (iterate (fn (st) (letv (p i) st (if (or (>= i k) (>= p (byte-len line))) (list)
                                          (tuple (math-min (byte-len line) (+ p (lead-len (byte-at line p)))) (+ i 1)))))
                 (tuple pos idx))
    p)))

(def cut-line (fn (line mode ranges delim only)
  (cond ((= mode "b")
         (str-join "" (map (fn (r) (letv (l h) r (byte-sub line (math-min (byte-len line) (- l 1)) (math-min (byte-len line) (far h)))))
                           ranges)))
        ((= mode "c")
         (letv (pieces pos idx)
               (fold (fn (st r)
                       (letv (pieces pos idx) st
                         (letv (l h) r
                           (let ((from (skip-to line pos idx (- l 1))))
                             (if (= h 0) (tuple (list-append pieces (byte-sub line from)) (byte-len line) 9e15)
                               (let ((to (skip-to line from (- l 1) h)))
                                 (tuple (list-append pieces (byte-sub line from to)) to h)))))))
                     (tuple (list) 0 0) ranges)
           (str-join "" pieces)))
        ((< (byte-find line delim) 0) (if only (list) line))
        (else
          (let ((fs (str-split delim line)))
            (str-join delim (list-concat-all (map (fn (r) (letv (l h) r (slice fs (math-min (length fs) (- l 1)) (math-min (length fs) (far h)))))
                                                  ranges))))))))

(letv (opts files bad) (getopt ARGS "b:c:f:d:sn")
  (let ((modes (filter (fn (l) (has opts l)) (list "b" "c" "f"))) (delim (opt opts "d" "\t")))
    (cond ((not (= bad "")) (do (err-write "cut: bad option -" bad "\n" usage "\n") (exit-status 1)))
          ((not (= (length modes) 1)) (do (err-write usage "\n") (exit-status 1)))
          ((not (= (byte-len delim) 1)) (do (err-write "cut: the delimiter is one character\n") (exit-status 1)))
          (else
            (let ((mode (nth modes 0)))
              (let ((ranges (let ((r (parse-list (opt opts mode "")))) (if (is-nil r) r (merged r)))))
                (if (is-nil ranges) (do (err-write "cut: a list is 1,3-5,7- and -2, counting from 1\n") (exit-status 1))
                  (exit-status
                    (fold (fn (st name)
                            (let ((src (opened name)))
                              (if (and (= (type-of src) "string") (not (is-stdin src)))
                                (do (err-write "cut: " name ": " src "\n") 1)
                                (do (iterate (fn (k)
                                               (let ((l (next-line src)))
                                                 (if (is-nil l) (list)
                                                   (let ((out (cut-line (strip l) mode ranges delim (has opts "s"))))
                                                     (do (if (is-nil out) #f (out-write out "\n")) k)))))
                                             0)
                                    (if (is-stdin src) #f (file-close src))
                                    st))))
                          0 (if (= (length files) 0) (list "-") files))))))))))