file-io.toc

(add-ns st (git-dependency "https://github.com/Toccata-Lang/stream.git"
                           "stream.toc"
                           :sha "4aa15f9"))

(inline C "

typedef struct {
  int open;
  FILE *fd;} fileDescStruct;

void close_file(void *ptr) {
  fileDescStruct *fileDesc = (fileDescStruct *)ptr;
  if (fileDesc->open && fileDesc->fd) {
    fclose(fileDesc->fd);
    fileDesc->fd = NULL;
  }
  free(fileDesc);
#ifdef CHECK_MEM_LEAK
  __atomic_fetch_add(&free_count, 1, __ATOMIC_ACQ_REL);
#endif
}

Value *makeFileStruct(FILE *fd) {
  fileDescStruct *fdStruct = (fileDescStruct *)my_malloc(sizeof(fileDescStruct));
  fdStruct->fd = fd;
  fdStruct->open = 1;
  Value *opaque = opaqueValue(fdStruct, close_file);
  return(opaque);
}
")

(defn fopen-read [file-path]
  (assert (instance? String file-path))

  (inline C (maybe-of Opaque) "
    String *arg0Str;
    arg0Str = nullTerm(file_path_0);

    FILE* fd = fopen(arg0Str->buffer, \"r\");
    dec_and_free((Value *)arg0Str, 1);
    if (fd == NULL) {
      return(nothing);
    } else {
      fseek(fd, 0, SEEK_SET);
      Value *opaque = makeFileStruct(fd);
      Value *mo = maybe((Vector *)0, (Value *)0, opaque);
      return(mo);
    }
"))

(defn read* [fileDesc]
  (assert (instance? Opaque fileDesc))

  ;; private function. Use 'blocking-read' instead
  (inline C String "
  fileDescStruct *fileDesc = (fileDescStruct *)((Opaque *)fileDesc_0)->ptr;
  if (feof(fileDesc->fd)) {
    dec_and_free(fileDesc_0, 1);
    return((Value *)malloc_string(0));
  }

// TODO: Figure out how to have a new type of buffer to avoid extra copy operation
  char buffer[5005];
  if (feof(fileDesc->fd)) {
    dec_and_free(fileDesc_0, 1);
    return((Value *)malloc_string(0));
  } else {
    int64_t byte_count = fread(buffer, 1, 5000, fileDesc->fd);
    String *strVal = malloc_string(byte_count);
    strncpy(strVal->buffer, buffer, byte_count);
    dec_and_free(fileDesc_0, 1);
    return((Value *)strVal);
  }
"))

(defn eof? [fileDesc]
  (assert (instance? Opaque fileDesc))

  (inline C Maybe "
  fileDescStruct *fileDesc = (fileDescStruct *)((Opaque *)fileDesc_0)->ptr;
  dec_and_free(fileDesc_0, 1);
  if (!feof(fileDesc->fd)) {
    return(nothing);
  } else {
    Value *mv = maybe((Vector *)0, (Value *)0, (Value *)nothing);
    return(mv);
  }
"))

(defn fopen-write [file-path]
  (assert (instance? String file-path))

  (inline C (maybe-of Opaque) "
    String *arg0Str;
    arg0Str = nullTerm(file_path_0);

    FILE* fd = fopen(arg0Str->buffer, \"wb\");
    dec_and_free((Value *)arg0Str, 1);
    if (fd == NULL) {
      return(nothing);
    } else {
      fileDescStruct *fdStruct = (fileDescStruct *)my_malloc(sizeof(fileDescStruct));
      fdStruct->open = 1;
      fdStruct->fd = fd;
      Value *opaque = opaqueValue(fdStruct, close_file);
      Value *mo = maybe((Vector *)0, (Value *)0, opaque);
      return(mo);
    }
"))

(defn write* [file-desc str-buffer]
  (assert (instance? Opaque file-desc))
  (assert (instance? String str-buffer))

  ;; private function. Use 'write' instead
  (inline C Integer "
  char *buffer;
  int64_t len;

  fileDescStruct *fileDesc = (fileDescStruct *)((Opaque *)file_desc_0)->ptr;
  if (str_buffer_1->type == StringBufferType) {
    buffer = ((String *)str_buffer_1)->buffer;
    len = ((String *)str_buffer_1)->len;
  } else if (str_buffer_1->type == SubStringType) {
    buffer = ((SubString *)str_buffer_1)->buffer;
    len = ((SubString *)str_buffer_1)->len;
  }
  Value *result = integerValue(fwrite(buffer, 1, len, fileDesc->fd));
  dec_and_free(file_desc_0, 1);
  dec_and_free(str_buffer_1, 1);
  return(result);
"))

(defn close* [file-desc]
  (assert (instance? Opaque file-desc))

  ;; private function. Use 'close' instead
  (inline C Integer "
  fileDescStruct *fileDesc = (fileDescStruct *)((Opaque *)file_desc_0)->ptr;
  fclose(fileDesc->fd);
  dec_and_free(file_desc_0, 1);
  return(integerValue(1));
"))

(defprotocol FileProto
  (write [_ str-buffer])
  (read [_])
  (blocking-read [_])
  (close [_]))

(deftype InputFile [file-desc path]
  (assert (instance? Opaque file-desc))

  Stringable
  (string-list [_] (list "<InputFile " path ">"))

  Collection
  (empty? [_]
    (eof? file-desc))

  Container
  (extract [_]
    (read* file-desc))

  Seqable
  (first [x]
    (or (and (empty? x)
             (maybe nothing))
        (maybe (extract x))))

  (rest [x]
    x)

  st/AsStream
  (st/stream [fd]
    (st/stream (lazy-list fd)))

  FileProto
  (close [_]
    (close* file-desc)))

(deftype OutputFile [file-desc path]
  Stringable
  (string-list [_] (list "<OutputFile " path ">"))

  FileProto
  (write [_ str-buffer] (write* file-desc str-buffer))
  (close [_] (close* file-desc)))

(defn file-out [path]
  (map (fopen-write path)
       (fn [file-desc]
         (OutputFile file-desc path))))

(defn file-in [path]
  (map (fopen-read path)
       (fn [file-desc]
         (InputFile file-desc path))))

(defn file-sink [s path]
  (map (file-out path)
       (fn [out-file]
         (st/sink s (fn [x]
                      (either (and (instance? st/StreamEnd x)
                                   (maybe (close out-file)))
                              (write out-file x)))))))

(defn slurp [fileName]
  (assert (instance? String fileName))

  (inline C String
   "String *arg0Str = nullTerm(fileName_0);

  FILE *file = fopen(arg0Str->buffer, \"r\");
  if (file == NULL) {
    dec_and_free((Value *)arg0Str, 1);
    String *strVal = malloc_string(0);
    return((Value *)strVal);
  } else {
    fseek(file, 0, SEEK_END);
    int64_t buffSize = ftell(file);
    fseek(file, 0, SEEK_SET);
    String *strVal = malloc_string(buffSize);
    fread(strVal->buffer, 1, buffSize, file);
    fclose(file);
    dec_and_free((Value *)arg0Str, 1);
    return((Value *)strVal);
  }\n"))

(inline C "char stdinBuffer[5005];\n")

(defn reset-stdin []
  (inline C Maybe "
  stdinBuffer[0] = 0;
  return(nothing);\n"))

(def _ (reset-stdin))

(defn read-stdin []
  (inline C String "
// TODO: Figure out how to have a new type of buffer to avoid extra copy operation
  if (stdinBuffer[0] == 0) {
    fgets(stdinBuffer, 5000, stdin);
    int bytesRead = strlen(stdinBuffer);
    if (bytesRead > 0)
      stdinBuffer[bytesRead - 1] = 0;
  }
  return(stringValue(stdinBuffer));
"))

(def stdin
  (st/Stream nothing
             (fn [_]
               (maybe (read-stdin)))
             (fn [_]
               (reset-stdin)
               nothing)
             (fn [_] nothing)))

(defprotocol SendStr
  (send-str [x agnt]))

(extend-type String
  SendStr
  (send-str [s agnt]
    (send agnt (fn [_] (pr* s)))))

(extend-type st/StreamEnd
  SendStr
  (send-str [x _]
    (str x)))

(defn stdout [s]
  (let [stdout-agent (agent 0)]
    (st/sink s (fn [x]
                 (maybe (send-str x stdout-agent))))))