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 root (if (= (ref path 0) #\/) "" (cwd)))
      (def mod-name (module/resolve-string (cat (path/without-extension path)) root))
      (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))

(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))