<commit_before>;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
;;;
;;; --- File devices.
;;;

(in-package :io.zeta-streams)

(deftype file-direction ()
  '(member :input :output :io))

(deftype file-if-exists ()
  '(member :default :error :error-if-symlink :unlink :overwrite))

(deftype file-if-does-not-exist ()
  '(member :default :error :create))

(defmethod initialize-instance :after ((device file-device)
                                       &key filename (direction :input)
                                       (if-exists :default) (if-does-not-exist :default)
                                       truncate append nonblocking (extra-flags 0)
                                       (mode #o666))
  (when (and (eql :error if-exists)
             (eql :error if-does-not-exist))
    (error 'program-error))
  (let ((flags 0))
    (setf (values flags if-exists if-does-not-exist)
          (process-file-direction direction flags if-exists if-does-not-exist))
    (setf (values flags if-exists if-does-not-exist)
          (process-file-flags direction flags if-exists if-does-not-exist
                              truncate append nonblocking extra-flags))
    (setf (filename-of device) (copy-seq filename)
          (direction-of device) direction
          (if-exists-of device) if-exists
          (if-does-not-exist-of device) if-does-not-exist)
    (device-open device :filename filename :flags flags
                 :mode mode :if-exists if-exists
                 :if-does-not-exist if-does-not-exist)))

(defmethod device-open ((device file-device) &key filename flags mode
                        if-exists if-does-not-exist &allow-other-keys)
  (declare (ignore if-does-not-exist))
  (labels ((handle-error (c)
             (posix-file-error c filename "opening"))
           (try-unlink ()
             (handler-case
                 (nix:unlink filename)
               (nix:posix-error (c) (handle-error c))))
           (try-open (&optional (retry-on-unlink t))
             (handler-case
                 (nix:open filename flags mode)
               (nix:eexist (c)
                 (cond ((and retry-on-unlink (eql :unlink if-exists))
                        (try-unlink) (try-open nil))
                       (t (handle-error c))))
               (nix:posix-error (c)
                 (handle-error c))
               (:no-error (fd) fd))))
    (let ((fd (try-open)))
      (%set-fd-nonblock-mode fd t)
      (setf (input-handle-of device) fd
            (output-handle-of device) fd)
      (when (logtest flags nix:o-append)
        (setf (position-of device) (device-length device)))))
  (values device))

(defun process-file-direction (direction flags if-exists if-does-not-exist)
  (macrolet ((add-flags (&rest %flags)
               `(setf flags (logior flags ,@%flags))))
    (ecase direction
      (:input
       (add-flags nix:o-rdonly)
       (check-type if-exists (member nil :error-if-symlink))
       (check-type if-does-not-exist (member nil :error))
       (when (eql :default if-does-not-exist) (setf if-does-not-exist :error)))
      (:output
       (add-flags nix:o-wronly)
       (check-type if-exists file-if-exists)
       (check-type if-does-not-exist file-if-does-not-exist)
       (when (eql :default if-exists) (setf if-exists :overwrite))
       (when (eql :default if-does-not-exist) (setf if-does-not-exist :create)))
      (:io
       (add-flags nix:o-rdwr)
       (check-type if-exists file-if-exists)
       (check-type if-does-not-exist file-if-does-not-exist)
       (when (eql :default if-exists) (setf if-exists :overwrite))
       (when (eql :default if-does-not-exist) (setf if-does-not-exist :create))))
    (values flags if-exists if-does-not-exist)))

(defun process-file-flags (direction flags if-exists if-does-not-exist
                           truncate append nonblocking extra-flags)
  (macrolet ((add-flags (&rest %flags)
               `(setf flags (logior flags ,@%flags))))
    (case if-exists
      (:error
       (unless (eql :input direction) (add-flags nix:o-excl)))
      (:error-if-symlink
       (add-flags nix:o-nofollow)
       (setf if-exists :overwrite)))
    (case if-does-not-exist
      (:create (add-flags nix:o-creat)))
    (cond
      (truncate
       (unless (eql :input direction) (add-flags nix:o-trunc)))
      (append
       (when (eql :output direction) (add-flags nix:o-append)))
      (nonblocking
       (add-flags nix:o-nonblock))
      (extra-flags
       (add-flags extra-flags))))
  (values flags if-exists if-does-not-exist))

(defmethod device-close ((device file-device))
  (ignore-errors (nix:close (input-handle-of device)))
  (setf (input-handle-of device) nil
        (output-handle-of device) nil)
  (values device))

(defmethod device-position ((device file-device))
  (position-of device))

(defmethod (setf device-position) (position (device file-device) &key (from :start))
  (ecase from<commit_msg>Small improvement to DEVICE-OPEN for FILE-DEVICEs.<commit_after>;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
;;;
;;; --- File devices.
;;;

(in-package :io.zeta-streams)

(deftype file-direction ()
  '(member :input :output :io))

(deftype file-if-exists ()
  '(member :default :error :error-if-symlink :unlink :overwrite))

(deftype file-if-does-not-exist ()
  '(member :default :error :create))

(defmethod initialize-instance :after ((device file-device)
                                       &key filename (direction :input)
                                       (if-exists :default) (if-does-not-exist :default)
                                       truncate append nonblocking (extra-flags 0)
                                       (mode #o666))
  (when (and (eql :error if-exists)
             (eql :error if-does-not-exist))
    (error 'program-error))
  (let ((flags 0))
    (setf (values flags if-exists if-does-not-exist)
          (process-file-direction direction flags if-exists if-does-not-exist))
    (setf (values flags if-exists if-does-not-exist)
          (process-file-flags direction flags if-exists if-does-not-exist
                              truncate append nonblocking extra-flags))
    (setf (filename-of device) (copy-seq filename)
          (direction-of device) direction
          (if-exists-of device) if-exists
          (if-does-not-exist-of device) if-does-not-exist)
    (device-open device :filename filename :flags flags
                 :mode mode :if-exists if-exists
                 :if-does-not-exist if-does-not-exist)))

(defmethod device-open ((device file-device) &key filename flags mode
                        if-exists if-does-not-exist)
  (declare (ignore if-does-not-exist))
  (labels ((handle-error (c)
             (posix-file-error c filename "opening"))
           (try-unlink ()
             (handler-case
                 (nix:unlink filename)
               (nix:posix-error (c) (handle-error c))))
           (try-open (&optional (retry-on-unlink t))
             (handler-case
                 (nix:open filename flags mode)
               (nix:eexist (c)
                 (cond ((and retry-on-unlink (eql :unlink if-exists))
                        (try-unlink) (try-open nil))
                       (t (handle-error c))))
               (nix:posix-error (c)
                 (handle-error c))
               (:no-error (fd) fd))))
    (let ((fd (try-open)))
      (%set-fd-nonblock-mode fd t)
      (setf (input-handle-of device) fd
            (output-handle-of device) fd)
      (when (logtest flags nix:o-append)
        (setf (position-of device) (device-length device)))))
  (values device))

(defun process-file-direction (direction flags if-exists if-does-not-exist)
  (macrolet ((add-flags (&rest %flags)
               `(setf flags (logior flags ,@%flags))))
    (ecase direction
      (:input
       (add-flags nix:o-rdonly)
       (check-type if-exists (member nil :error-if-symlink))
       (check-type if-does-not-exist (member nil :error))
       (when (eql :default if-does-not-exist) (setf if-does-not-exist :error)))
      ((:output :io)
       (add-flags (if (eql :io direction) nix:o-rdwr nix:o-wronly))
       (check-type if-exists file-if-exists)
       (check-type if-does-not-exist file-if-does-not-exist)
       (when (eql :default if-exists) (setf if-exists :overwrite))
       (when (eql :default if-does-not-exist) (setf if-does-not-exist :create))))
    (values flags if-exists if-does-not-exist)))

(defun process-file-flags (direction flags if-exists if-does-not-exist
                           truncate append nonblocking extra-flags)
  (macrolet ((add-flags (&rest %flags)
               `(setf flags (logior flags ,@%flags))))
    (case if-exists
      (:error
       (unless (eql :input direction) (add-flags nix:o-excl)))
      (:error-if-symlink
       (add-flags nix:o-nofollow)))
    (case if-does-not-exist
      (:create (add-flags nix:o-creat)))
    (cond
      (truncate
       (unless (eql :input direction) (add-flags nix:o-trunc)))
      (append
       (when (eql :output direction) (add-flags nix:o-append)))
      (nonblocking
       (add-flags nix:o-nonblock))
      (extra-flags
       (add-flags extra-flags))))
  (values flags if-exists if-does-not-exist))

(defmethod device-close ((device file-device))
  (ignore-errors (nix:close (input-handle-of device)))
  (setf (input-handle-of device) nil
        (output-handle-of device) nil)
  (values device))

(defmethod device-position ((device file-device))
  (position-of device))

(defmethod (setf device-position) (position (device file-device) &key (from :start))
  (ecase from
{'fraction_non_alphanumeric': 0.14394018070412296, 'fraction_numerical': 0.0010385294423096896, 'mean_word_length': 2.149117069980379, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 10, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '207741', 'n_tokens_mistral': 3091, 'n_tokens_neox': 3008, 'n_words': 747}