Carp/core/IO.carp

(system-include "carp_io.h")

(doc FILE
  "An opaque type representing a file handle. Wraps the `FILE` type from"
  "the C standard library.")
(register-type FILE)

(doc IO
  "A module for performing I/O operations. Most functions found in this"
  "module are wrappers around the C standard library.")
(defmodule IO
  (doc Raw
    "Wrappers for functions from the C standard library. Consider using a more"
    "carpesque function from IO when it exists. For detailed documentation please"
    "consult the documentation of your system (e.g. under Linux try"
    "`man fprint`).")
  (defmodule Raw
    (doc stdin
      "A file pointer to the system's standard input file (wraps the C"
      "standard library `stdin`).")
    (register stdin (Ptr FILE) "stdin")

    (doc stdout
      "A FILE pointer to the system's standard output file (wraps the C"
      "standard library `stdout`).")
    (register stdout (Ptr FILE) "stdout")

    (doc stderr
      "A FILE pointer to the system's standard error file (wraps the C"
      "standard library `stderr`).")
    (register stderr (Ptr FILE) "stderr")

    (doc get-char
      "Returns a character from [`stdin`](#stdin)."
      "Wraps `getchar()` from the C standard library.")
    (register get-char (Fn [] Int) "getchar")

    (doc fgetc
      "Returns a character from a given [FILE](#file)."
      "Wraps `fgetc` from the C standard library.")
    (register fgetc (Fn [(Ptr FILE)] Int) "fgetc")

    (doc fputc
      "Writes a character to a [FILE](#file)"
      "Wraps `fputc` from the C standard library.")
    (register fputc (Fn [Int (Ptr FILE)] Int) "fputc")

    (doc EOF
      "A signal indicating the End-Of-File has been reached."
      "Wraps `EOF` from the C standard library")
    (register EOF Int "EOF")

    (private  fopen-)
    (hidden   fopen-)
    (register fopen- (Fn [(Ptr CChar) (Ptr CChar)] (Ptr FILE)) "fopen" )

    (doc fopen
      "Low-level routine to open a file for input/output/appending."
      "Wraps `fopen` from the C standard library."
      "Consider using the function [IO.open-file](#open-file) instead.")
    (defn fopen [pathname mode]
      (fopen- (String.cstr pathname) (String.cstr mode)))

    (doc fclose
      "Closes the [FILE](#file) associated with the given file pointer."
      "Returns an integer indicating success or failure."
      "Wraps `fclose` from the C standard library.")
    (register fclose (Fn [(Ptr FILE)] Int)  "fclose")

    (doc fclose!
      "Closes a file via [`fclose`](#fclose), but discards the result,"
      "making this function appropriate for use as a side effect in"
      "`do` forms")
    (defn fclose! [file]
      (ignore (fclose file)) )

    (private  fwrite-)
    (hidden   fwrite-)
    (register fwrite- (Fn [(Ptr CChar) Int Int (Ptr FILE)] Int) "fwrite")

    (doc fwrite
      "Writes a C-string to a file and returns the number of written bytes."
      "Wraps `fwrite` from the C standard library."
      "Consider using [`write-file`](#write-file) instead.")
    (defn fwrite [data item-size items-count file]
      (fwrite- (String.cstr data) item-size items-count file))

    (doc fwrite!
      "Writes a C-string to a file using [`fwrite`](#fwrite), but discards the result,"
      "making this function appropriate for use as a side effect in"
      "`do` forms.")
    (defn fwrite! [data item-size items-count file]
      (ignore (fwrite data item-size items-count file)) )

    (private  fread-)
    (hidden   fread-)
    (register fread- (Fn [a Int Int (Ptr FILE)] Int) "fread")

    (doc fread
      "Reads a given numebr of bytes from a file into C-String."
      "Wraps `fread` from the C standard library."
      "Consider using [`read-file`](#read-file) or"
      "[`unsafe-read-file`](#unsafe-read-file) instead.")
    (defn fread [file-name item-size items-count file]
      (fread- (String.cstr file-name) item-size items-count file))

    (doc fflush
      "Flushes buffered data associated with a given [FILE](#file) pointer."
      "For files in write mode, writes all buffered data to the file."
      "For files in read mode, discards all unused data in the buffer."
      "If the FILE pointer is NULL, flushes all open ouput streams."
      "Returns an integer indicating success or failure."
      "Wraps `fflush` from the C standard library.")
    (register fflush (Fn [(Ptr FILE)] Int) "fflush")

    (doc fflush!
      "Flushes buffered data via [`fflush`](#fflush)"
      ", but discards the result, making this function appropraite for use as"
      "a side effect in `do` forms.")
    (defn fflush! [file]
      (ignore (fflush file)))

    (doc rewind
      "Sets the stream position indicator associated with a [FILE](#file)"
      "pointer back to the beginning of the file."
      "Wraps `rewind` from the C standard library."
      "To verify that resetting the position succeeded,"
      "use [`fseek`](#fseek) instead.")
    (register rewind (Fn [(Ptr FILE)] ()) "rewind")

    (private  unlink-)
    (hidden   unlink-)
    (register unlink- (Fn [(Ptr CChar)] Int) "unlink")
    ; override unlink for windows
    (windows-only
      (register unlink- (Fn [(Ptr CChar)] Int) "_unlink"))

    (doc unlink
      "Removes the named link to a file from the filesystem."
      "If this is the last link to the file, and no process has the file open,"
      "deletes the underlying file."
      "If the argument designates a symbolic link, deletes the link only."
      "Returns an integer indicating success or failure."
      "Wraps `unlink` from the POSIX api in <unistd.h>)."
      "See the POSIX API documentation for more information.")
    (defn unlink [file-name]
      (unlink- (String.cstr file-name)))

    (doc unlink!
      "Deletes a file link via [`unlink`](#unlink), but discards the result,"
      "making this function appropriate for use as a side effect in"
      "`do` forms.")
    (defn unlink! [file-name]
      (ignore (unlink file-name)))

    (doc fseek
      "Sets the position indicator of a [FILE](#file) based on a given"
      "reference position and offset. The position indicator will be set to an"
      "offset number of bytes from the reference position."
      "Valid reference positions are [`SEEK-SET`](#seek-set),"
      "[`SEEK-CUR`](#seek-cur), and [`SEEK-END`](#seek-end)."
      ""
      "Returns an integer indicating success or failure."
      "Wraps `fseek` from the C standard library.")
    (register fseek (Fn [(Ptr FILE) Int Int] Int) "fseek")

    (doc fseek!
      "Sets the position indicator of a [FILE](#file) via `fseek`,"
      "but discards the result, making this function appropriate for use"
      "as a side effect in `do` forms.")
    (register fseek! (Fn [(Ptr FILE) Int Int] ()) "fseek") ; note: (ignore (ffseek ...)) would also work

    (doc SEEK-SET
      "When passed to [`fseek`](#fseek) designates the reference position"
      "as the beginning of the file."
      "Wrpas `SEEK_SET` from the C standard library.")
    (register SEEK-SET Int "SEEK_SET")

    (doc SEEK-CUR
      "When passed to [`fseek`](#fseek) designates the reference position"
      "as the current position in the file."
      "Wraps `SEEK_CUR` from the C standard library.")
    (register SEEK-CUR Int "SEEK_CUR")

    (doc SEEK-END
      "When passed to [`fseek`](#fseek), designates the reference position"
      "as the end of a [FILE](#file) (EOF)."
      "Wraps `SEEK_END` from the C standard library.")
    (register SEEK-END Int "SEEK_END")

    (doc ftell
      "Returns the current value of the position indicator of a [FILE](#file)"
      "Wraps `ftell` from the C standard library.")
    (register ftell (Fn [(Ptr FILE)] Int) "ftell")

    (doc feof
      "Returns true if the position indicator for the given [FILE](#file)"
      "is at the end of file [`EOF`](#eof)."
      "Wraps `feof` from the C standard library.")
    (register feof (Fn [(Ptr FILE)] Bool) "feof")

    (doc ferror
      "Returns true if an error indicator is set for the"
      "given [FILE](#file)."
      "Wraps `ferror` from the C standard library.")
    (register ferror (Fn [(Ptr FILE)] Bool) "ferror")
  )

  (doc println
    "Prints a String ref to [`stdout`](#stdout), appends a newline.")
  (register println (Fn [(Ref String)] ()))

  (doc print
    "Prints a String ref to [`stdout`](#stdout).")
  (register print (Fn [(Ref String)] ()))

  (doc errorln
    "Prints a String ref to [`stderr`](#stderr), appends a newline.")
  (register errorln (Fn [(Ref String)] ()))

  (doc error "Prints a String ref to [`stderr`](#stderr).")
  (register error (Fn [(Ref String)] ()))

  (doc get-line
    "Gets one line of input from [`stdin`](#stdin).")
  (register get-line (Fn [] String))

  (doc fgetc
    "Gets a single character from a [FILE](#file) pointer."
    "Wraps `fgetc` from the C standard library.")
  (defn fgetc [file]
    (let [char (IO.Raw.fgetc file)]
      (if (IO.Raw.feof file)
          (Result.Error @"couldn't read char from file, EOF reached")
          (if (IO.Raw.ferror file)
              (Result.Error @"error while reading char from file")
              (Result.Success (Char.from-int char))))))

  (doc open-file
    "Opens a [FILE](#file) with the given name using a designated mode"
    "(e.g. [r]ead, [w]rite, [a]ppend),  [rb] read binary...)."
    "See `fopen` from the C standard library for a description of valid mode parameters.")
  (defn open-file [filename mode]
    (let [ptr (IO.Raw.fopen filename mode)]
      (if (null? ptr)
        (Result.Error (System.error-text))
        (Result.Success ptr) )))

  (doc read->EOF
    "Reads bytes from a named [FILE](#file) until the [End-Of-File](#eof) is reached."
    "Consider using [read-file](#read-file) instead, even though this works fine for"
    "UTF-8 encoded input files.")
  (defn read->EOF [filename]
    (let [file? (IO.open-file filename "rb")]
      (match file?
        (Result.Error x) (Result.Error x)
        (Result.Success f) (let [c (zero)
                                 r []]
                             (do
                               (while (do
                                   (set! c (IO.Raw.fgetc f))
                                   (/= c IO.Raw.EOF))
                                 (set! r (Array.push-back r (Byte.from-int c))))
                               (IO.Raw.fclose! f)
                               (Result.Success (String.from-bytes &r)))))))

  (doc unsafe-read-file
    "Returns the contents of a file passed as argument as a string."
    "Note: there is no way to distinguish the output for an empty file"
    "and a nonexistent file!")
  (register unsafe-read-file (Fn [&String] String))

  (doc read-file
    "Reads the contents of a text [FILE](#file) into a (Result String String)."
    ""
    "If a binary file is passed as input, the resulting string length is"
    "likely to be inaccurate.")
  (defn read-file [filename]
    (let [  finput?  (open-file filename "rb") ]
      (if (Result.error? &finput?)
        (Result.Error (fmt "Failed to open file='%s', error='%s'" filename &(Result.unsafe-from-error finput?) ))
        (let [  finput  (Result.unsafe-from-success finput?)
                length  (do
                            (IO.Raw.fseek! finput 0 IO.Raw.SEEK-END)
                            (let-do [flength (IO.Raw.ftell finput)]
                              (IO.Raw.rewind finput)
                              flength ))
                buffer  (String.allocate length \0 )  ]
          (if (not (String.allocated? &buffer))
            (do
              (IO.Raw.fclose! finput)
              (Result.Error (fmt "Failed to open buffer with size=%d from file='%s'" length filename)) )
            (let [  bytes-read  (IO.Raw.fread &buffer 1 length finput)
                    nop1        (IO.Raw.fclose! finput)  ]
              (if (not (Int.= bytes-read length))
                (Result.Error (fmt "Error: file='%s' has length=%d but bytes-read=%d" filename length bytes-read))
                (Result.Success buffer)  )))))))

  (doc write-file
    "Writes a String into a text [FILE](#file), overwriting it"
    "if it already exists."
    ""
    "Returns a (Result Bool String) indicating success or failure.")
  (defn write-file [content file-name]
    (let [  fOut?        (open-file file-name "wb") ; open as binary so line breaks don't multiply on Windows
            bytes2write  (String.length content) ]
      (if (Result.error? &fOut?)
        (Result.Error (fmt "error='%s' opening file='%s'" &(Result.unsafe-from-error fOut?) file-name))
        (let-do [  fOut           (Result.unsafe-from-success fOut?)
                   bytes-written  (IO.Raw.fwrite content 1 bytes2write fOut) ]
          (IO.Raw.fclose! fOut)
          (if (Int.= bytes-written bytes2write)
            (Result.Success true)
            (Result.Error (fmt "only %d of %d bytes were written" bytes-written bytes2write)))))))

  (private getenv-)
  (hidden getenv-)
  (doc getenv- "gets the value of an environment variable (thin wrapper for the C standard library)")
  (register getenv- (Fn [(Ptr CChar)] (Ptr CChar)) "getenv")

  (doc getenv
    "Returns the value of an environment variable."
    "Wraps `getenv` from the C standard library.")
  (defn getenv [s]
    (let [e (getenv- (String.cstr s))]
      (if (null? e)
        (Maybe.Nothing)
        (Maybe.Just (from-cstr e)))))
)

; TODO(#1445): document this cool stuff, possibly even include an example!
(doc println*
  "Prints any number of values to [`stdout`](#stdout), using their"
  "`str` implementations. Appends final a newline to the output."
  ""
  "```"
  "(println* \"I caught \" 4 \"carp!\")"
  "=> I caught 4 carp!"
  "```")
(defmacro println* [:rest forms]
  `(IO.println %(build-str* forms)))

(doc print*
  "Prints any number of values to [`stdout`](#stdout), using thier"
  "`str` implementations."
  ""
  "```"
  "(print* \"I caught \" 4 \"carp \")"
  "(print* \"yesterday\")"
  "=> I caught 4 carp yesterday"
  "```")
(defmacro print* [:rest forms]
  `(IO.print %(build-str* forms)))