Carp/core/IO.carp

(system-include "carp_io.h")

(register-type FILE)

(doc IO "is 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 "the standard input file (thin wrapper for the C standard library).")
    (register stdin (Ptr FILE) "stdin")
    (doc      stdout "the standard output file (thin wrapper for the C standard library).")
    (register stdout (Ptr FILE) "stdout")
    (doc      stderr "the standard error file (thin wrapper for the C standard library).")
    (register stderr (Ptr FILE) "stderr")
    (doc      get-char "gets a character from stdin (thin wrapper for getchar() from C standard library).")
    (register get-char (Fn [] Int) "getchar") 
    (doc      fgetc "gets a character from file (thin wrapper for the from C standard library).")
    (register fgetc (Fn [(Ptr FILE)] Int) "fgetc") 
    (doc      EOF "the End-Of-File character as a literal (thin wrapper for the C standard library)")
    (register EOF Int "EOF")
    (private  fopen-)
    (hidden   fopen-)
    (register fopen- (Fn [(Ptr CChar) (Ptr CChar)] (Ptr FILE)) "fopen" )
    (doc      fopen "opens a file for input/output/appending (thin wrapper for the C standard library). Consider using the function IO.open-file instead.")
    (defn     fopen [pathname mode]
      (fopen- (String.cstr pathname) (String.cstr mode)) )
    (doc      fclose "closes a file pointer (thin wrapper for the C standard library).") 
    (register fclose (Fn [(Ptr FILE)] Int)  "fclose")  
    (doc      fclose! "same as (fclose) but to be used as a side effect.") 
    (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 items (thin wrapper for 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! "like fwrite but returns no indicator whether writing to file succeeded. Consider using fwrite instead.")
    (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 from a file into C-String (thin wrapper for fread(cstr, item-size, items-count, file) from 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 a file pointer, i.e. commits every write (thin wrapper for the C standard library).")
    (register fflush (Fn [(Ptr FILE)] Int) "fflush")
    (doc      fflush! "same as (fflush) but to be used as a side effect.")
    (defn     fflush! [file]
      (ignore (fflush file)) )
    (doc      rewind "rewinds a file pointer, i.e. puts input and output stream to beginning (thin wrapper for the C standard library). If you want to verify, that this succeeded, use (fseek stream 0, SEEK_SET) instead. ")
    (register rewind (Fn [(Ptr FILE)] ()) "rewind")
    (private  unlink-)
    (hidden   unlink-)
    (register unlink- (Fn [(Ptr CChar)] Int) "unlink")
    (windows-only
      ; override unlink for windows
      (register unlink- (Fn [(Ptr CChar)] Int) "_unlink"))
    (doc      unlink "unlinks a file, i.e. deletes it (thin wrapper for POSIX api in <unistd.h>).")
    (defn     unlink [file-name]
      (unlink- (String.cstr file-name)) )
    (doc      unlink! "same as (unlink) but to be used as a side effect.")
    (defn     unlink! [file-name]
      (ignore (unlink file-name)) )
    (doc      fseek "sets the position indicator of a file  (thin wrapper for fseek(file, offset, whence) from C standard library).")
    (register fseek (Fn [(Ptr FILE) Int Int] Int) "fseek")
    (doc      fseek! "same as (fseek) but to be used as a side effect.")
    (register fseek! (Fn [(Ptr FILE) Int Int] ()) "fseek")        ; note: (ignore (ffseek ...)) would also work
    (doc      SEEK-SET "to be used with fseek (thin wrapper for the C standard library).")
    (register SEEK-SET Int "SEEK_SET")
    (doc      SEEK-CUR "to be used with fseek (thin wrapper for the C standard library).")
    (register SEEK-CUR Int "SEEK_CUR")
    (doc      SEEK-END "to be used with fseek (thin wrapper for the C standard library).")
    (register SEEK-END Int "SEEK_END")
    (doc      ftell "gets the position indicator of a file (thin wrapper for the C standard library).")
    (register ftell (Fn [(Ptr FILE)] Int) "ftell")
  )

  (doc      println "prints a string ref to stdout, appends a newline.")
  (register println (Fn [(Ref String)] ()))
  (doc      print "prints a string ref to stdout, does not append a newline.")
  (register print (Fn [(Ref String)] ()))
  (doc      errorln "prints a string ref to stderr, appends a newline.")
  (register errorln (Fn [(Ref String)] ()))
  (doc      error "prints a string ref to stderr, does not append a newline.")
  (register error (Fn [(Ref String)] ()))
  (doc      get-line "gets a line from stdin.")
  (register get-line (Fn [] String))
  (doc      fgetc "gets a character from a file pointer (thin wrapper for the C standard library).")
  (register fgetc (Fn [(Ptr FILE)] Char)) ; TODO: check EOF handling (see carp_io.h)!

  (doc open-file "opens a file by name using a mode (e.g. [r]ead, [w]rite, [a]ppend),  [rb] read binary...). See fopen() in the C standard library for a detailed description of valid 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 a file given by name until the End-Of-File character is reached. Please consider using 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 missing file!")
  (register unsafe-read-file (Fn [&String] String))
  (doc  read-file "Reads the content of a file into a (Result String String).\nIt is intended for text files, since the way to determine the length of a String is to use strlen() which probably will be inaccurate for binaries.")
  (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, overwriting it if it already exists.")
  (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 "gets the value of an environment variable (Carp-style wrapper for the C standard library)")
  (defn getenv [s]
    (let [e (getenv- (String.cstr s))]
      (if (null? e)
        (Maybe.Nothing)
        (Maybe.Just (from-cstr e)))))
)

; TODO: document this cool stuff, possibly even include an example!
(defmacro println* [:rest forms]
  `(IO.println %(build-str* forms)))

(defmacro print* [:rest forms]
  `(IO.print %(build-str* forms)))