Ben / Nujel

;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; Contains various io routines for standalone Nujel runtimes

(defn file/copy (source-path destination-path)
      "Copy a file from SOURCE-PATH to DESTINATION-PATH"
      (spit destination-path (slurp source-path)))

(defn file/read (path)
      "Read in a file using the Nujel reader"
      (read (file/load path)))

(defn file/read/single (path)
      "Read a single value from a file"
      (car (file/read path)))

(defn file/eval (path environment)
       "Evaluate a Nujel source file in the current context"
       (eval-in (or environment root-closure)
                (cons 'do (read (file/read path)))))

(defn file/eval-module (path args)
       "Evaluate a Nujel source file in the current context"
       (def mod-name (module/resolve-string (cat (path/without-extension path)) (cwd)))
       (def mod (module/load mod-name))
       (when-not (= :environment (:type-name mod))
                 (return mod))
       (def exports (ref mod :exports))
       (when-not exports (exception (fmt "Couldn't load {path} as a module since it has no exports")))
       (when (:has? exports :main)
         ((ref exports :main) args)))


(defn file/file? (filename)
       (ref (file/stat filename) :regular-file?))

(defn file/dir? (filename)
       (ref (file/stat filename) :directory?))

(defn directory/read-relative (path)
      (map (ls path)
           (fn (a) (cat path "/" a))))

(def directory/read-recursive
  (let*
    (defn directory/read-recursive/fn (A)
          (if (file/dir? A)
              (directory/read-recursive A)
              A))

    (defn directory/read-recursive (path)
          (flatten (filter (map (directory/read-relative path)
                                directory/read-recursive/fn)
                           identity)))))

(defn load (filename)
  (try (fn (err)
         (print/error err)
         #f)
       (file/eval filename)
       (pfmtln "Loaded {filename}")
       #t))

(defn slurp/buffer (pathname)
      "Read the entirety of PATHNAME and return it as a string if possible, otherwise return #nil."
      (def fh (file/open-input* pathname))
      (when-not fh (return #nil))
      (try (fn ()
               (file/close* fh)
               (return #nil))
           (file/seek* fh 0 2)
           (def size (file/tell* fh))
           (file/seek* fh 0 0)
           (def buf (buffer/allocate size))
           (file/read* fh buf size)
           (file/close* fh)
           (return buf)))
(def file/read/buffer slurp/buffer)

(defn slurp (pathname)
      "Read the entirety of PATHNAME and return it as a string if possible, otherwise return #nil."
      (buffer->string (slurp/buffer pathname)))
(def file/read slurp)

(defn spit (pathname content)
      "Read the entirety of PATHNAME and return it as a string if possible, otherwise return #nil."
      (def fh (file/open-output* pathname :replace))
      (when-not fh (return #f))

      (try (fn ()
               (file/close* fh)
               (return #f))
           (file/write* fh content)
           (file/close* fh))
      (return #t))

(defn file/write (content pathname)
      "Writes CONTENT into PATHNAME"
      (spit pathname content))

(def stdin (make-input-port stdin*))
(defn current-input-port () stdin)
 (defn current-input-port! (nport) (set! stdin nport))

(def stdout (make-output-port stdout*))
(defn current-output-port () stdout)
(defn current-output-port! (nport) (set! stdout nport))

(def stderr (make-output-port stderr*))
(defn current-error-port () stderr)
(defn current-error-port! (nport) (set! stderr nport))

(defn newline (port)
      "Print a single line feed character"
      ((or port stdout) 'block-write "\r\n")
      #nil)

(defn print (v port)
      "Display V on the standard output port"
      (write/raw v (or port stdout) #t)
      #nil)

(defn error (v port)
      "Prints v on the standard error port"
      (print v stderr)
      #nil)

(defn read-line/raw (port buf)
      "Reads in a line of user input and returns it"
      (def i 0)
      (def c 0)
      (def view (:u8 buf))
      (while #t
             (while (>= i (:length buf))
                    (:length! (+ 128 (:length buf))))
             (set! c (port 'char-read))
             (when (= c :end-of-file)
                   (return (if (zero? i) #nil i)))
             (when (= c #\lf)
                   (return i))
             (set! view i c)
             (set! i (inc i))))

(defn read-line ()
      "Reads in a line of user input and returns it"
      (def buf (buffer/allocate 128))
      (def len (read-line/raw stdin buf))
      (and len (buffer->string buf len)))
(def input read-line)

(defn readline (prompt)
      "Read a line of input in a user friendly way after writing PROMPT"
      (stdout 'block-write (or prompt ""))
      (stdout 'flush-output)
      (read-line))

(defn popen/trim (cmd)
  "Run CMD using popen and return the trimmed stdout"
  (trim (cdr (popen cmd))))

(defn module/loader/filesystem (name)
      (def name-string (:string name))
      (when-not (= (ref name-string 0) #\/) (return #nil)) ; Paths have to start with a /
      (when (= System/OS 'Windows) (set! name-string (:cut name-string 1)))
      (def module-path (fmt "{}.nuj" name-string))
      (def source (file/read module-path))
      (when-not source (return #nil))
      (def expr (list 'module
                      `(def *module* ~name)
                      `(def *module-path* ~(path/dirname module-path))
                      (cons do (read source))))
      (def mod (bytecode-eval* (compile* expr root-closure) root-closure))
      (return mod))