aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/control/monad.lux21
-rw-r--r--stdlib/source/lux/control/security/capability.lux6
-rw-r--r--stdlib/source/lux/world/file.lux350
3 files changed, 247 insertions, 130 deletions
diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux
index 6f07ceb0a..6e0992444 100644
--- a/stdlib/source/lux/control/monad.lux
+++ b/stdlib/source/lux/control/monad.lux
@@ -127,6 +127,27 @@
(!/map (|>> (#.Cons _x)) (recur xs'))))
!/join)))))
+(def: #export (filter Monad<!> f)
+ {#.doc "Filter the values in a list with a monadic function."}
+ (All [! a b]
+ (-> (Monad !) (-> a (! Bit)) (List a)
+ (! (List a))))
+ (let [(^open "!/.") Monad<!>]
+ (function (recur xs)
+ (case xs
+ #.Nil
+ (!/wrap #.Nil)
+
+ (#.Cons head xs')
+ (|> (f head)
+ (!/map (function (_ verdict)
+ (!/map (function (_ tail)
+ (if verdict
+ (#.Cons head tail)
+ tail))
+ (recur xs'))))
+ !/join)))))
+
(def: #export (fold monad f init xs)
{#.doc "Fold a list with a monadic function."}
(All [M a b]
diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux
new file mode 100644
index 000000000..572b52f3b
--- /dev/null
+++ b/stdlib/source/lux/control/security/capability.lux
@@ -0,0 +1,6 @@
+(.module:
+ [lux #*])
+
+(signature: #export (Capability input output)
+ (: (-> input output)
+ perform))
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index 9b53e4453..e0975799d 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -4,20 +4,22 @@
["." monad (#+ Monad do)]
["ex" exception (#+ Exception exception:)]
[security
- ["." taint (#+ Dirty taint)]]]
+ ["." taint (#+ Dirty taint)]
+ ["." capability (#+ Capability)]]]
[data
["." maybe]
- ["." error (#+ Error)]
+ ["." error (#+ Error) ("error/." Functor<Error>)]
["." text
format]
[collection
- ["." array (#+ Array)]]]
+ ["." array (#+ Array)]
+ ["." list ("list/." Functor<List>)]]]
[time
["." instant (#+ Instant)]
["." duration]]
[world
["." binary (#+ Binary)]]
- ["." io (#+ IO)]
+ ["." io (#+ IO) ("io/." Functor<IO>)]
[concurrency
["." promise (#+ Promise)]]
[host (#+ import:)]
@@ -25,80 +27,119 @@
[compiler
["." host]]]])
-(type: #export File Text)
+(type: #export Path Text)
-(type: #export Permission
- #Read
- #Write
- #Execute)
+(type: #export (Can-Open ! capability)
+ (Capability Path (! (Error (capability !)))))
-(signature: #export (System !)
- (do-template [<name>]
- [(: (-> Binary File (! (Error Any)))
- <name>)]
+(do-template [<capability> <input> <output>]
+ [(type: #export (<capability> !)
+ (Capability <input> (! (Error <output>))))]
- [append]
- [write])
+ [Can-Edit [Binary] Any]
+ [Can-Delete [] Any]
+ )
- (do-template [<name> <output>]
- [(: (-> File (! (Error <output>)))
- <name>)]
+(type: #export (Can-Query ! o)
+ (Capability [] (! (Error o))))
- [read (Dirty Binary)]
- [size Nat]
- [files (List File)]
- [last-modified Instant])
+(type: #export (Can-Modify ! i)
+ (Capability [i] (! (Error Any))))
- (do-template [<name>]
- [(: (-> File (! (Error Bit)))
+(signature: #export (File !)
+ (do-template [<name> <output>]
+ [(: (Can-Query ! <output>)
<name>)]
- [file?]
- [directory?]
+ [size Nat]
+ [last-modified Instant]
+ [can-execute? Bit]
+ [content (Dirty Binary)]
)
- (: (-> Permission File (! (Error Bit)))
- can?)
+ (: (Can-Open ! File)
+ move)
- (do-template [<name>]
- [(: (-> File (! (Error Any)))
+ (do-template [<name> <input>]
+ [(: (Can-Modify ! <input>)
<name>)]
- [make-directory]
- [delete]
+ [modify Instant]
+ [over-write Binary]
)
- (: (-> File File (! (Error Any)))
- move)
+ (: (Can-Edit !)
+ append)
+
+ (: (Can-Delete !)
+ delete)
+ )
- (: (-> Instant File (! (Error Any)))
- modify)
+(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: #export (async system)
- (-> (System IO) (System Promise))
+(def: (async-file file)
+ (-> (File IO) (File Promise))
(`` (structure
(~~ (do-template [<name>]
- [(def: (<name> parameter file)
- (promise.future (:: system <name> parameter file)))]
+ [(def: <name> (|>> (:: file <name>) promise.future))]
- [append] [write]
- [can?] [move] [modify]))
+ [size] [last-modified] [can-execute?] [content]
+ [modify] [over-write]
+ [append]
+ [delete]))
- (~~ (do-template [<name>]
- [(def: <name> (|>> (:: system <name>) promise.future))]
+ (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]))
- [read] [size] [files] [last-modified]
- [file?] [directory?]
- [make-directory] [delete]))
+ (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 !) File (Maybe [File Text])))
+ (All [!] (-> (System !) Path (Maybe [Path Text])))
(case (text.last-index-of (:: System<!> separator) file)
#.None
#.None
@@ -109,26 +150,42 @@
(#.Some [parent child]))))
(def: #export (nest System<!> [parent child])
- (All [!] (-> (System !) [File Text] File))
+ (All [!] (-> (System !) [Path Text] Path))
(format parent (:: System<!> separator) child))
(do-template [<name>]
- [(exception: #export (<name> {file File})
- (ex.report ["File" file]))]
+ [(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]
- [cannot-make-directory]
- [cannot-delete]
)
-(exception: #export (cannot-move {target File} {source File})
+(exception: #export (cannot-move {target Path} {source Path})
(ex.report ["Source" source]
["Target" target]))
-(exception: #export (cannot-modify {instant Instant} {file File})
+(exception: #export (cannot-modify {instant Instant} {file Path})
(ex.report ["Instant" (%instant instant)]
- ["File" file]))
+ ["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
@@ -136,7 +193,8 @@
(~~ (do-template [<name>]
[(<name> [] #io #try boolean)]
- [exists] [mkdirs] [delete]
+ [createNewFile] [mkdir]
+ [exists] [delete]
[isFile] [isDirectory]
[canRead] [canWrite] [canExecute]))
@@ -164,105 +222,137 @@
(import: java/io/FileInputStream
(new [java/io/File] #io #try))
- (structure: #export _ (System IO)
+ (structure: (File<IO> path)
+ (-> Path (File IO))
+
(do-template [<name> <flag>]
- [(def: (<name> data file)
+ [(def: (<name> data)
(do io.Monad<Process>
- [stream (FileOutputStream::new (java/io/File::new file) <flag>)
+ [stream (FileOutputStream::new (java/io/File::new path) <flag>)
_ (OutputStream::write data stream)
_ (OutputStream::flush stream)]
(AutoCloseable::close stream)))]
- [append #1]
- [write #0]
+ [over-write #0]
+ [append #1]
)
- (def: (read file)
+ (def: (content _)
(do io.Monad<Process>
- [#let [file' (java/io/File::new file)]
- size (java/io/File::length file')
+ [#let [file (java/io/File::new path)]
+ size (java/io/File::length file)
#let [data (binary.create (.nat size))]
- stream (FileInputStream::new file')
+ stream (FileInputStream::new file)
bytes-read (InputStream::read data stream)
_ (AutoCloseable::close stream)]
(if (i/= size bytes-read)
(wrap (taint data))
- (io.io (ex.throw cannot-read-all-data file)))))
-
- (def: size
- (|>> java/io/File::new
- java/io/File::length
- (:: io.Monad<Process> map .nat)))
-
- (def: (files dir)
- (do io.Monad<Process>
- [?files (java/io/File::listFiles (java/io/File::new dir))]
- (case ?files
- (#.Some files)
- (monad.map @ (|>> java/io/File::getAbsolutePath)
- (array.to-list files))
-
- #.None
- (io.throw not-a-directory dir))))
-
- (do-template [<name> <method>]
- [(def: <name> (|>> java/io/File::new <method>))]
-
- [file? java/io/File::isFile]
- [directory? java/io/File::isDirectory]
+ (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: (can? permission file)
- (let [jvm-file (java/io/File::new file)]
- (case permission
- #Read (java/io/File::canRead jvm-file)
- #Write (java/io/File::canWrite jvm-file)
- #Execute (java/io/File::canExecute jvm-file))))
-
- (def: last-modified
- (|>> java/io/File::new
- (java/io/File::lastModified)
- (:: io.Monad<Process> map (|>> duration.from-millis instant.absolute))))
-
- (do-template [<name> <exception> <method>]
- [(def: (<name> subject)
- (do io.Monad<IO>
- [outcome (<method> (java/io/File::new subject))]
- (case outcome
- (#error.Success #1)
- (wrap (#error.Success []))
-
- _
- (io.throw <exception> [subject]))))]
-
- [make-directory cannot-make-directory java/io/File::mkdirs]
- [delete cannot-delete java/io/File::delete]
- )
+ (def: (discard _)
+ (!delete path cannot-discard-directory)))
- (do-template [<name> <exception> <method> <parameter-pre>]
- [(def: (<name> parameter subject)
+ (structure: #export _ (System IO)
+ (do-template [<name> <method> <capability> <exception>]
+ [(def: (<name> path)
(do io.Monad<IO>
- [outcome (<method> (|> parameter <parameter-pre>)
- (java/io/File::new subject))]
+ [#let [file (java/io/File::new path)]
+ outcome (<method> file)]
(case outcome
(#error.Success #1)
- (wrap (#error.Success []))
+ (wrap (#error.Success (<capability> path)))
_
- (io.throw <exception> [parameter subject]))))]
+ (wrap (ex.throw <exception> [path])))))]
- [move cannot-move java/io/File::renameTo java/io/File::new]
- [modify cannot-modify java/io/File::setLastModified (<| duration.to-millis instant.relative)]
+ [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))
))
}))
-(def: #export (exists? Monad<!> System<!> file)
- (All [!] (-> (Monad !) (System !) File (! (Error Bit))))
- (do (error.ErrorT Monad<!>)
- [??? (:: System<!> file? file)]
- (if ???
- (wrap ???)
- (:: System<!> directory? file))))
+(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.Error _)
+ (do Monad<!>
+ [?directory (:: System<!> directory path)]
+ (case ?directory
+ (#error.Success directory)
+ (wrap true)
+
+ (#error.Error _)
+ (wrap false))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 18:02:57 +0000