path: root/stdlib/source/lux/world/file.lux

(.module:
  [lux #*
   [control
    ["." monad (#+ Monad do)]
    ["ex" exception (#+ Exception exception:)]
    [concurrency
     ["." promise (#+ Promise)]]
    [security
     ["." integrity (#+ Dirty)]
     ["." capability (#+ Capability)]]]
   [data
    ["." maybe]
    ["." error (#+ Error) ("error/." Functor<Error>)]
    ["." text
     format]
    [collection
     ["." array (#+ Array)]
     ["." list ("list/." Functor<List>)]]]
   [time
    ["." instant (#+ Instant)]
    ["." duration]]
   [world
    ["." binary (#+ Binary)]]
   ["." io (#+ IO) ("io/." Functor<IO>)]
   [host (#+ import:)]
   [platform
    [compiler
     ["." host]]]])

(type: #export Path Text)

(type: #export (Can-Open ! capability)
  (Capability Path (! (Error (capability !)))))

(do-template [<capability> <input> <output>]
  [(type: #export (<capability> !)
     (Capability <input> (! (Error <output>))))]

  [Can-Edit   [Binary] Any]
  [Can-Delete []       Any]
  )

(type: #export (Can-Query ! o)
  (Capability [] (! (Error o))))

(type: #export (Can-Modify ! i)
  (Capability [i] (! (Error Any))))

(`` (signature: #export (File !)
      (~~ (do-template [<name> <output>]
            [(: (Can-Query ! <output>)
                <name>)]

            [size          Nat]
            [last-modified Instant]
            [can-execute?  Bit]
            [content       (Dirty Binary)]
            ))

      (: (Can-Open ! File)
         move)

      (~~ (do-template [<name> <input>]
            [(: (Can-Modify ! <input>)
                <name>)]

            [modify     Instant]
            [over-write Binary]
            ))

      (: (Can-Edit !)
         append)

      (: (Can-Delete !)
         delete)
      ))

(signature: #export (Directory !)
  (: (Can-Query ! (List (File !)))
     files)

  (: (Can-Query ! (List (Directory !)))
     directories)

  (: (Can-Delete !)
     discard))

(`` (signature: #export (System !)
      (~~ (do-template [<name> <capability>]
            [(: (Can-Open ! <capability>)
                <name>)]

            [file             File]
            [create-file      File]
            [directory        Directory]
            [create-directory Directory]
            ))

      (: Text
         separator)
      ))

(def: (async-file file)
  (-> (File IO) (File Promise))
  (`` (structure
       (~~ (do-template [<name>]
             [(def: <name> (|>> (:: file <name>) promise.future))]

             [size] [last-modified] [can-execute?] [content]
             [modify] [over-write]
             [append]
             [delete]))

       (def: move (|>> (:: file move) (io/map (error/map async-file)) promise.future)))))

(def: (async-directory directory)
  (-> (Directory IO) (Directory Promise))
  (`` (structure (~~ (do-template [<name> <async>]
                       [(def: <name> (|>> (:: directory <name>)
                                          (io/map (error/map (list/map <async>)))
                                          promise.future))]

                       [files       async-file]
                       [directories async-directory]))

                 (def: discard (|>> (:: directory discard) promise.future)))))

(def: #export (async system)
  (-> (System IO) (System Promise))
  (`` (structure
       (~~ (do-template [<name> <async>]
             [(def: <name> (|>> (:: system <name>) (io/map (error/map <async>)) promise.future))]

             [file             async-file]
             [create-file      async-file]
             [directory        async-directory]
             [create-directory async-directory]))

       (def: separator (:: system separator)))))

(def: #export (un-nest System<!> file)
  (All [!] (-> (System !) Path (Maybe [Path Text])))
  (case (text.last-index-of (:: System<!> separator) file)
    #.None
    #.None
    
    (#.Some last-separator)
    (let [[parent temp] (maybe.assume (text.split last-separator file))
          [_ child] (maybe.assume (text.split (text.size (:: System<!> separator)) temp))]
      (#.Some [parent child]))))

(def: #export (nest System<!> [parent child])
  (All [!] (-> (System !) [Path Text] Path))
  (format parent (:: System<!> separator) child))

(do-template [<name>]
  [(exception: #export (<name> {file Path})
     (ex.report ["Path" file]))]

  [cannot-create-file]
  [cannot-find-file]
  [cannot-delete-file]

  [cannot-create-directory]
  [cannot-find-directory]
  [cannot-discard-directory]
  
  [cannot-read-all-data]
  [not-a-directory]
  )

(exception: #export (cannot-move {target Path} {source Path})
  (ex.report ["Source" source]
             ["Target" target]))

(exception: #export (cannot-modify {instant Instant} {file Path})
  (ex.report ["Instant" (%instant instant)]
             ["Path" file]))

(template: (!delete path exception)
  (do io.Monad<IO>
    [outcome (java/io/File::delete (java/io/File::new path))]
    (case outcome
      (#error.Success #1)
      (wrap (#error.Success []))

      _
      (io.throw exception [path]))))

(`` (for {(~~ (static host.jvm))
          (as-is (import: #long java/io/File
                   (new [String])
                   (~~ (do-template [<name>]
                         [(<name> [] #io #try boolean)]

                         [createNewFile] [mkdir]
                         [exists] [delete]
                         [isFile] [isDirectory]
                         [canRead] [canWrite] [canExecute]))
                   
                   (length [] #io #try long)
                   (listFiles [] #io #try #? (Array java/io/File))
                   (getAbsolutePath [] #io #try String)
                   (renameTo [java/io/File] #io #try boolean)
                   (lastModified [] #io #try long)
                   (setLastModified [long] #io #try boolean)
                   (#static separator String))

                 (import: java/lang/AutoCloseable
                   (close [] #io #try void))

                 (import: java/io/OutputStream
                   (write [(Array byte)] #io #try void)
                   (flush [] #io #try void))

                 (import: java/io/FileOutputStream
                   (new [java/io/File boolean] #io #try))

                 (import: java/io/InputStream
                   (read [(Array byte)] #io #try int))

                 (import: java/io/FileInputStream
                   (new [java/io/File] #io #try))

                 (structure: (File<IO> path)
                   (-> Path (File IO))

                   (~~ (do-template [<name> <flag>]
                         [(def: (<name> data)
                            (do io.Monad<Process>
                              [stream (FileOutputStream::new (java/io/File::new path) <flag>)
                               _ (OutputStream::write data stream)
                               _ (OutputStream::flush stream)]
                              (AutoCloseable::close stream)))]

                         [over-write  #0]
                         [append      #1]
                         ))

                   (def: (content _)
                     (do io.Monad<Process>
                       [#let [file (java/io/File::new path)]
                        size (java/io/File::length file)
                        #let [data (binary.create (.nat size))]
                        stream (FileInputStream::new file)
                        bytes-read (InputStream::read data stream)
                        _ (AutoCloseable::close stream)]
                       (if (i/= size bytes-read)
                         (wrap (integrity.taint data))
                         (io.io (ex.throw cannot-read-all-data path)))))

                   (def: (size _)
                     (|> path
                         java/io/File::new
                         java/io/File::length
                         (:: io.Monad<Process> map .nat)))

                   (def: (last-modified _)
                     (|> path
                         java/io/File::new
                         (java/io/File::lastModified)
                         (:: io.Monad<Process> map (|>> duration.from-millis instant.absolute))))

                   (def: (can-execute? _)
                     (|> path
                         java/io/File::new
                         java/io/File::canExecute))

                   (def: (move destination)
                     (do io.Monad<IO>
                       [outcome (java/io/File::renameTo (java/io/File::new destination)
                                                        (java/io/File::new path))]
                       (case outcome
                         (#error.Success #1)
                         (wrap (#error.Success (File<IO> destination)))

                         _
                         (io.throw cannot-move [destination path]))))

                   (def: (modify time-stamp)
                     (do io.Monad<IO>
                       [outcome (java/io/File::setLastModified (|> time-stamp instant.relative duration.to-millis)
                                                               (java/io/File::new path))]
                       (case outcome
                         (#error.Success #1)
                         (wrap (#error.Success []))

                         _
                         (io.throw cannot-modify [time-stamp path]))))

                   (def: (delete _)
                     (!delete path cannot-delete-file)))

                 (structure: (Directory<IO> path)
                   (-> Path (Directory IO))

                   (~~ (do-template [<name> <method> <capability>]
                         [(def: (<name> _)
                            (do io.Monad<Process>
                              [?children (java/io/File::listFiles (java/io/File::new path))]
                              (case ?children
                                (#.Some children)
                                (|> children
                                    array.to-list
                                    (monad.filter @ (|>> <method>))
                                    (:: @ map (monad.map @ (|>> java/io/File::getAbsolutePath (:: @ map  <capability>))))
                                    (:: @ join))

                                #.None
                                (io.throw not-a-directory [path]))))]

                         [files       java/io/File::isFile      File<IO>]
                         [directories java/io/File::isDirectory Directory<IO>]
                         ))

                   (def: (discard _)
                     (!delete path cannot-discard-directory)))

                 (structure: #export _ (System IO)
                   (~~ (do-template [<name> <method> <capability> <exception>]
                         [(def: (<name> path)
                            (do io.Monad<IO>
                              [#let [file (java/io/File::new path)]
                               outcome (<method> file)]
                              (case outcome
                                (#error.Success #1)
                                (wrap (#error.Success (<capability> path)))

                                _
                                (wrap (ex.throw <exception> [path])))))]

                         [file             java/io/File::isFile        ..File<IO>      cannot-find-file]
                         [create-file      java/io/File::createNewFile ..File<IO>      cannot-create-file]
                         [directory        java/io/File::isDirectory   ..Directory<IO> cannot-find-directory]
                         [create-directory java/io/File::mkdir         ..Directory<IO> cannot-create-directory]
                         ))

                   (def: separator (java/io/File::separator))
                   ))
          }))

(do-template [<get> <signature> <create> <find> <exception>]
  [(def: #export (<get> Monad<!> System<!> path)
     (All [!] (-> (Monad !) (System !) Path (! (Error (<signature> !)))))
     (do Monad<!>
       [outcome (:: System<!> <create> path)]
       (case outcome
         (#error.Success file)
         (wrap (#error.Success file))
         
         (#error.Failure error)
         (if (ex.match? <exception> error)
           (:: System<!> <find> path)
           (wrap (#error.Failure error))))))]

  [get-file      File      create-file      file      ..cannot-create-file]
  [get-directory Directory create-directory directory ..cannot-create-directory]
  )

(def: #export (exists? Monad<!> System<!> path)
  (All [!] (-> (Monad !) (System !) Path (! Bit)))
  (do Monad<!>
    [?file (:: System<!> file path)]
    (case ?file
      (#error.Success file)
      (wrap true)

      (#error.Failure _)
      (do Monad<!>
        [?directory (:: System<!> directory path)]
        (case ?directory
          (#error.Success directory)
          (wrap true)

          (#error.Failure _)
          (wrap false))))))