aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/abstract/apply.lux6
-rw-r--r--stdlib/source/lux/control/pipe.lux6
-rw-r--r--stdlib/source/lux/data/binary.lux9
-rw-r--r--stdlib/source/lux/data/format/binary.lux13
-rw-r--r--stdlib/source/lux/data/format/tar.lux565
-rw-r--r--stdlib/source/lux/data/number.lux4
-rw-r--r--stdlib/source/lux/data/text/encoding.lux4
-rw-r--r--stdlib/source/lux/time/duration.lux12
-rw-r--r--stdlib/source/lux/world/file.lux5
-rw-r--r--stdlib/source/test/lux/abstract.lux6
-rw-r--r--stdlib/source/test/lux/abstract/apply.lux24
-rw-r--r--stdlib/source/test/lux/abstract/comonad.lux27
-rw-r--r--stdlib/source/test/lux/abstract/functor.lux1
-rw-r--r--stdlib/source/test/lux/abstract/hash.lux35
14 files changed, 699 insertions, 18 deletions
diff --git a/stdlib/source/lux/abstract/apply.lux b/stdlib/source/lux/abstract/apply.lux
index 5eb42b63d..febf31a73 100644
--- a/stdlib/source/lux/abstract/apply.lux
+++ b/stdlib/source/lux/abstract/apply.lux
@@ -1,8 +1,8 @@
(.module:
- lux
+ [lux #*]
[//
- ["." functor (#+ Functor)]
- [monad (#+ Monad)]])
+ [monad (#+ Monad)]
+ ["." functor (#+ Functor)]])
(signature: #export (Apply f)
{#.doc "Applicative functors."}
diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux
index ed6b54311..691d5568b 100644
--- a/stdlib/source/lux/control/pipe.lux
+++ b/stdlib/source/lux/control/pipe.lux
@@ -11,7 +11,7 @@
["n" nat]
["i" int]]
[collection
- ["." list ("#;." fold monad)]]]
+ ["." list ("#@." fold monad)]]]
[macro (#+ with-gensyms)
[syntax (#+ syntax:)]
["." code]]])
@@ -134,7 +134,7 @@
"Will become: [+50 +2 '+5']")}
(with-gensyms [g!temp]
(wrap (list (` (let [(~ g!temp) (~ prev)]
- [(~+ (list;map (function (_ body) (` (|> (~ g!temp) (~+ body))))
+ [(~+ (list@map (function (_ body) (` (|> (~ g!temp) (~+ body))))
paths))]))))))
(syntax: #export (case> {branches (p.many (p.and s.any s.any))}
@@ -154,5 +154,5 @@
+9 "nine"
_ "???")))}
(wrap (list (` (case (~ prev)
- (~+ (list;join (list;map (function (_ [pattern body]) (list pattern body))
+ (~+ (list@join (list@map (function (_ [pattern body]) (list pattern body))
branches))))))))
diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux
index 33e0bdac3..defb62049 100644
--- a/stdlib/source/lux/data/binary.lux
+++ b/stdlib/source/lux/data/binary.lux
@@ -129,6 +129,15 @@
(~~ (static @.js))
(|>> .nat-to-frac [] ArrayBuffer::new Uint8Array::new)})))
+(def: #export (fold f init binary)
+ (All [a] (-> (-> I64 a a) a Binary a))
+ (let [size (..!size binary)]
+ (loop [idx 0
+ output init]
+ (if (n.< size idx)
+ (recur (inc idx) (f (!read idx binary) output))
+ output))))
+
(def: #export (read/8 idx binary)
(-> Nat Binary (Try I64))
(if (n.< (..!size binary) idx)
diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux
index 90e3cc468..ece895c38 100644
--- a/stdlib/source/lux/data/format/binary.lux
+++ b/stdlib/source/lux/data/format/binary.lux
@@ -127,6 +127,19 @@
(Writer Frac)
(|>> frac.to-bits ..bits/64))
+(def: #export (segment size)
+ (-> Nat (Writer Binary))
+ (function (_ value)
+ [size
+ (function (_ [offset binary])
+ [(n.+ size offset)
+ (try.assume
+ (binary.copy (n.min size (binary.size value))
+ 0
+ value
+ offset
+ binary))])]))
+
(template [<name> <bits> <size> <write>]
[(def: #export <name>
(Writer Binary)
diff --git a/stdlib/source/lux/data/format/tar.lux b/stdlib/source/lux/data/format/tar.lux
new file mode 100644
index 000000000..a9bb06954
--- /dev/null
+++ b/stdlib/source/lux/data/format/tar.lux
@@ -0,0 +1,565 @@
+(.module:
+ [lux (#- Mode Name and)
+ [abstract
+ [monad (#+ do)]]
+ [control
+ [pipe (#+ case>)]
+ ["." try (#+ Try)]
+ ["." exception (#+ exception:)]
+ ["<>" parser
+ ["<b>" binary (#+ Parser)]]]
+ [data
+ ["." binary (#+ Binary)]
+ ["." text (#+ Char)
+ ["%" format (#+ format)]
+ ["." encoding]]
+ ["." number
+ ["n" nat]
+ ["." i64]]
+ ["." format #_
+ ["#" binary (#+ Writer) ("#@." monoid)]]
+ [collection
+ ["." list ("#@." fold)]
+ ["." row (#+ Row) ("#@." fold)]]]
+ [time
+ ["." instant (#+ Instant)]
+ ["." duration]]
+ [world
+ ["." file]]
+ [type
+ abstract]])
+
+(type: Size Nat)
+
+(def: octal-size Size 8)
+
+(def: (octal-padding max-size number)
+ (-> Size Text Text)
+ (let [padding-size (n.- (text.size number)
+ max-size)
+ padding (|> "0"
+ (list.repeat padding-size)
+ (text.join-with ""))]
+ (format padding number)))
+
+(def: blank " ")
+(def: null text.null)
+
+(def: small-size Size 6)
+(def: big-size Size 11)
+
+(template [<exception> <maximum> <size>
+ <type> <in> <out> <writer> <suffix>
+ <coercion>]
+ [(def: <maximum>
+ (|> ..octal-size
+ (list.repeat <size>)
+ (list@fold n.* 1)))
+
+ (exception: #export (<exception> {value Nat})
+ (exception.report
+ ["Value" (%.nat value)]
+ ["Maximum" (%.nat <maximum>)]))
+
+ (abstract: <type>
+ {}
+
+ Nat
+
+ (def: #export (<in> value)
+ (-> Nat (Try <type>))
+ (if (|> value (n.% <maximum>) (n.= value))
+ (#try.Success (:abstraction value))
+ (exception.throw <exception> [value])))
+
+ (def: <out>
+ (-> <type> Nat)
+ (|>> :representation))
+
+ (def: <writer>
+ (Writer <type>)
+ (let [suffix <suffix>
+ padded-size (n.+ (text.size suffix) <size>)]
+ (|>> :representation
+ (:: n.octal encode)
+ (..octal-padding <size>)
+ (text.suffix suffix)
+ encoding.to-utf8
+ (format.segment padded-size))))
+
+ (def: <coercion>
+ (-> Nat <type>)
+ (|>> (n.% <maximum>)
+ :abstraction))
+ )]
+
+ [not-a-small-number maximum-small-size ..small-size
+ Small small from-small
+ small-writer (format ..blank ..null)
+ coerce-small]
+ [not-a-big-number maximum-big-size ..big-size
+ Big big from-big
+ big-writer ..blank
+ coerce-big]
+ )
+
+(abstract: Checksum
+ {}
+
+ Text
+
+ (def: dummy-checksum
+ Checksum
+ (:abstraction " "))
+
+ (def: checksum-suffix
+ (format ..blank ..null))
+
+ (def: checksum
+ (-> Binary Checksum)
+ (|>> (binary.fold n.+ 0)
+ ..coerce-small
+ ..from-small
+ (:: n.octal encode)
+ (..octal-padding ..small-size)
+ (text.suffix ..checksum-suffix)
+ :abstraction))
+
+ (def: checksum-writer
+ (Writer Checksum)
+ (let [padded-size (n.+ (text.size ..checksum-suffix)
+ ..small-size)]
+ (|>> :representation
+ encoding.to-utf8
+ (format.segment padded-size))))
+ )
+
+(def: last-ascii
+ Char
+ (number.hex "007F"))
+
+(def: ascii?
+ (-> Text Bit)
+ (|>> encoding.to-utf8
+ (binary.fold (function (_ char verdict)
+ (.and verdict
+ (n.<= ..last-ascii char)))
+ true)))
+
+(exception: #export (not-ascii {text Text})
+ (exception.report
+ ["Text" (%.text text)]))
+
+(def: name-size Size 31)
+(def: path-size Size 99)
+
+(template [<type> <representation> <size> <exception> <in> <out> <writer> <none>]
+ [(abstract: <type>
+ {}
+
+ <representation>
+
+ (exception: #export (<exception> {value Text})
+ (exception.report
+ ["Value" (%.text value)]
+ ["Size" (%.nat (text.size value))]
+ ["Maximum" (%.nat <size>)]))
+
+ (def: #export (<in> value)
+ (-> <representation> (Try <type>))
+ (if (..ascii? value)
+ (if (|> value encoding.to-utf8 binary.size (n.< <size>))
+ (#try.Success (:abstraction value))
+ (exception.throw <exception> [value]))
+ (exception.throw ..not-ascii [value])))
+
+ (def: <out>
+ (-> <type> <representation>)
+ (|>> :representation))
+
+ (def: <writer>
+ (Writer <type>)
+ (let [suffix ..null
+ padded-size (n.+ (text.size suffix) <size>)]
+ (|>> :representation
+ (text.suffix suffix)
+ encoding.to-utf8
+ (format.segment padded-size))))
+
+ (def: #export <none>
+ <type>
+ (try.assume (<in> "")))
+ )]
+
+ [Name Text ..name-size name-is-too-long name from-name name-writer anonymous]
+ [Path file.Path ..path-size path-is-too-long path from-path path-writer no-path]
+ )
+
+(def: magic-size Size 7)
+
+(abstract: Magic
+ {}
+
+ Text
+
+ (def: ustar (:abstraction "ustar "))
+
+ (def: from-magic
+ (-> Magic Text)
+ (|>> :representation))
+
+ (def: magic-writer
+ (Writer Magic)
+ (let [padded-size (n.+ (text.size ..null)
+ ..magic-size)]
+ (|>> :representation
+ encoding.to-utf8
+ (format.segment padded-size))))
+ )
+
+(def: block-size Size 512)
+
+(def: owner-id-size ..small-size)
+
+(def: blank-size Size (text.size ..blank))
+(def: null-size Size (text.size ..null))
+(def: mode-size Size ..small-size)
+(def: content-size Size ..big-size)
+(def: modification-time-size Size ..big-size)
+(def: checksum-size Size ..small-size)
+(def: link-flag-size Size 1)
+(def: device-size Size ..small-size)
+
+(def: small-number
+ (-> Size Size)
+ (|>> ($_ n.+ ..blank-size ..null-size)))
+
+(def: big-number
+ (-> Size Size)
+ (|>> ($_ n.+ ..blank-size)))
+
+(def: string
+ (-> Size Size)
+ (|>> ($_ n.+ ..null-size)))
+
+(def: header-size
+ ($_ n.+
+ ## name
+ (..string ..path-size)
+ ## mode
+ (..small-number ..mode-size)
+ ## uid
+ (..small-number ..owner-id-size)
+ ## gid
+ (..small-number ..owner-id-size)
+ ## size
+ (..big-number ..content-size)
+ ## mtime
+ (..big-number ..modification-time-size)
+ ## chksum
+ (..small-number ..checksum-size)
+ ## linkflag
+ ..link-flag-size
+ ## linkname
+ (..string ..path-size)
+ ## magic
+ (..string ..magic-size)
+ ## uname
+ (..string ..name-size)
+ ## gname
+ (..string ..name-size)
+ ## devmajor
+ (..small-number ..device-size)
+ ## devminor
+ (..small-number ..device-size)))
+
+(abstract: Link-Flag
+ {}
+
+ Char
+
+ (def: old-normal
+ Link-Flag
+ (:abstraction 0))
+
+ (template [<flag> <name>]
+ [(def: <name>
+ Link-Flag
+ (:abstraction (char <flag>)))]
+
+ ["0" normal]
+ ["1" link]
+ ["2" symbolic-link]
+ ["3" character]
+ ["4" block]
+ ["5" directory]
+ ["6" fifo]
+ ["7" contiguous]
+ )
+
+ (def: link-flag-writer
+ (Writer Link-Flag)
+ (|>> :representation
+ format.bits/8))
+ )
+
+(abstract: #export Mode
+ {}
+
+ Nat
+
+ (template [<code> <name>]
+ [(def: #export <name>
+ Mode
+ (:abstraction (number.oct <code>)))]
+
+ ["0001" execute-by-other]
+ ["0002" write-by-other]
+ ["0004" read-by-other]
+
+ ["0010" execute-by-group]
+ ["0020" write-by-group]
+ ["0040" read-by-group]
+
+ ["0100" execute-by-owner]
+ ["0200" write-by-owner]
+ ["0400" read-by-owner]
+
+ ["1000" save-text]
+ ["2000" set-group-id-on-execution]
+ ["4000" set-user-id-on-execution]
+ )
+
+ (def: #export (and left right)
+ (-> Mode Mode Mode)
+ (:abstraction
+ (i64.or (:representation left)
+ (:representation right))))
+
+ (def: mode-writer
+ (Writer Mode)
+ (|>> :representation
+ ..small
+ try.assume
+ ..small-writer))
+ )
+
+(def: maximum-content-size
+ Nat
+ (|> ..octal-size
+ (list.repeat ..content-size)
+ (list@fold n.* 1)))
+
+(abstract: Content
+ {}
+
+ [Big Binary]
+
+ (def: #export (content content)
+ (-> Binary (Try Content))
+ (do try.monad
+ [size (..big (binary.size content))]
+ (wrap (:abstraction [size content]))))
+
+ (def: from-content
+ (-> Content [Big Binary])
+ (|>> :representation))
+ )
+
+(type: #export ID
+ Small)
+
+(def: #export no-id
+ ID
+ (..coerce-small 0))
+
+(type: #export Owner
+ {#name Name
+ #id ID})
+
+(type: #export Ownership
+ {#user Owner
+ #group Owner})
+
+(type: #export File
+ [Path Instant Mode Ownership Content])
+
+(type: #export Directory
+ Path)
+
+(type: #export Entry
+ (#Normal File)
+ (#Symbolic-Link Path)
+ (#Directory Directory)
+ (#Contiguous File))
+
+(type: #export Device
+ Small)
+
+(def: no-device
+ Device
+ (try.assume (..small 0)))
+
+(type: #export Tar
+ (Row Entry))
+
+(def: (blocks size)
+ (-> Big Nat)
+ (n.+ (n./ ..block-size
+ (..from-big size))
+ (case (n.% ..block-size (..from-big size))
+ 0 0
+ _ 1)))
+
+(def: rounded-content-size
+ (-> Big Nat)
+ (|>> ..blocks
+ (n.* ..block-size)))
+
+(type: Header
+ {#path Path
+ #mode Mode
+ #user-id ID
+ #group-id ID
+ #size Big
+ #modification-time Big
+ #checksum Checksum
+ #link-flag Link-Flag
+ #link-name Path
+ #magic Magic
+ #user-name Name
+ #group-name Name
+ #major-device Device
+ #minor-device Device})
+
+(def: header-writer'
+ (Writer Header)
+ ($_ format.and
+ ..path-writer
+ ..mode-writer
+ ..small-writer
+ ..small-writer
+ ..big-writer
+ ..big-writer
+ ..checksum-writer
+ ..link-flag-writer
+ ..path-writer
+ ..magic-writer
+ ..name-writer
+ ..name-writer
+ ..small-writer
+ ..small-writer
+ ))
+
+(def: (header-writer header)
+ (Writer Header)
+ (let [checksum (|> header
+ (set@ #checksum ..dummy-checksum)
+ (format.run ..header-writer')
+ ..checksum)
+ data (|> header
+ (set@ #checksum checksum)
+ (format.run ..header-writer'))]
+ (|> data
+ (format.segment ..block-size))))
+
+(def: modification-time
+ (-> Instant Big)
+ (|>> instant.relative
+ (duration.query duration.second)
+ .nat
+ ..coerce-big))
+
+(def: (file-writer link-flag)
+ (-> Link-Flag (Writer File))
+ (function (_ [path modification-time mode ownership content])
+ (let [[size content] (..from-content content)
+ writer ($_ format.and
+ ..header-writer
+ (format.segment (..rounded-content-size size)))]
+ (writer [{#path path
+ #mode mode
+ #user-id (get@ [#user #id] ownership)
+ #group-id (get@ [#group #id] ownership)
+ #size size
+ #modification-time (..modification-time modification-time)
+ #checksum ..dummy-checksum
+ #link-flag link-flag
+ #link-name ..no-path
+ #magic ..ustar
+ #user-name (get@ [#user #name] ownership)
+ #group-name (get@ [#group #name] ownership)
+ #major-device ..no-device
+ #minor-device ..no-device}
+ content]))))
+
+(def: normal-file-writer
+ (Writer File)
+ (..file-writer ..normal))
+
+(def: contiguous-file-writer
+ (Writer File)
+ (..file-writer ..contiguous))
+
+(def: (symbolic-link-writer path)
+ (Writer Path)
+ (..header-writer
+ {#path ..no-path
+ #mode ($_ ..and
+ ..read-by-other
+ ..read-by-group
+ ..read-by-owner)
+ #user-id ..no-id
+ #group-id ..no-id
+ #size (..coerce-big 0)
+ #modification-time (..coerce-big 0)
+ #checksum ..dummy-checksum
+ #link-flag ..symbolic-link
+ #link-name path
+ #magic ..ustar
+ #user-name ..anonymous
+ #group-name ..anonymous
+ #major-device ..no-device
+ #minor-device ..no-device}))
+
+(def: (directory-writer path)
+ (Writer Directory)
+ (..header-writer
+ {#path path
+ #mode ($_ ..and
+ ..read-by-other
+ ..read-by-group
+ ..read-by-owner)
+ #user-id ..no-id
+ #group-id ..no-id
+ #size (..coerce-big 0)
+ #modification-time (..coerce-big 0)
+ #checksum ..dummy-checksum
+ #link-flag ..directory
+ #link-name ..no-path
+ #magic ..ustar
+ #user-name ..anonymous
+ #group-name ..anonymous
+ #major-device ..no-device
+ #minor-device ..no-device}))
+
+(def: entry-writer
+ (Writer Entry)
+ (|>> (case> (#Normal value) (..normal-file-writer value)
+ (#Symbolic-Link value) (..symbolic-link-writer value)
+ (#Directory value) (..directory-writer value)
+ (#Contiguous value) (..contiguous-file-writer value))))
+
+(def: end-of-archive-size Size (n.* 2 ..block-size))
+
+(def: end-of-archive
+ Binary
+ (binary.create ..end-of-archive-size))
+
+(def: #export (writer tar)
+ (Writer Tar)
+ (format@compose (row@fold (function (_ next total)
+ (format@compose total (..entry-writer next)))
+ format@identity
+ tar)
+ (format.segment ..end-of-archive-size ..end-of-archive)))
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index 9b8381491..07e093849 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -73,10 +73,10 @@
[bin /nat.binary /int.binary /rev.binary /frac.binary
"Invalid binary syntax."
- (encoding-doc "binary" (bin "+11001001") (bin "+11,00,10,01"))]
+ (encoding-doc "binary" (bin "11001001") (bin "11,00,10,01"))]
[oct /nat.octal /int.octal /rev.octal /frac.octal
"Invalid octal syntax."
- (encoding-doc "octal" (oct "+615243") (oct "+615,243"))]
+ (encoding-doc "octal" (oct "615243") (oct "615,243"))]
[hex /nat.hex /int.hex /rev.hex /frac.hex
"Invalid hexadecimal syntax."
(encoding-doc "hexadecimal" (hex "deadBEEF") (hex "dead,BEEF"))]
diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux
index 59e5efcc2..9e94f25af 100644
--- a/stdlib/source/lux/data/text/encoding.lux
+++ b/stdlib/source/lux/data/text/encoding.lux
@@ -219,6 +219,8 @@
(#try.Success (|> (TextDecoder::new [(..name ..utf-8)])
(TextDecoder::decode [value])))})))
-(structure: #export UTF-8 (Codec Binary Text)
+(structure: #export UTF-8
+ (Codec Binary Text)
+
(def: encode ..to-utf8)
(def: decode ..from-utf8))
diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux
index 58d06ee2d..47a480ab9 100644
--- a/stdlib/source/lux/time/duration.lux
+++ b/stdlib/source/lux/time/duration.lux
@@ -86,12 +86,12 @@
(template [<name> <scale> <base>]
[(def: #export <name> (scale-up <scale> <base>))]
- [second 1,000 milli-second]
- [minute 60 second]
- [hour 60 minute]
- [day 24 hour]
- [week 7 day]
- [normal-year 365 day]
+ [second 1,000 milli-second]
+ [minute 60 second]
+ [hour 60 minute]
+ [day 24 hour]
+ [week 7 day]
+ [normal-year 365 day]
)
(def: #export leap-year (merge day normal-year))
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index 6cd802296..8ef16a276 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -387,6 +387,7 @@
(structure: #export system
(System IO)
+
(~~ (template [<name> <method> <capability> <exception>]
[(def: <name>
(..can-open
@@ -562,7 +563,9 @@
(function (discard _)
(io.io (Fs::rmdirSync [path] (!fs)))))))
- (structure: #export system (System IO)
+ (structure: #export system
+ (System IO)
+
(~~ (template [<name> <method> <capability> <exception>]
[(def: <name>
(..can-open
diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux
index b9aa18c9c..ef7cb0774 100644
--- a/stdlib/source/test/lux/abstract.lux
+++ b/stdlib/source/test/lux/abstract.lux
@@ -2,11 +2,14 @@
[lux #*
["_" test (#+ Test)]]
["." / #_
+ ["#." apply]
["#." codec]
+ ["#." comonad]
["#." enum]
["#." equivalence]
["#." fold]
["#." functor]
+ ["#." hash]
["#." interval]
["#." monad]
["#." monoid]
@@ -16,11 +19,14 @@
(def: #export test
Test
($_ _.and
+ /apply.test
/codec.test
+ /comonad.test
/enum.test
/equivalence.test
/fold.test
/functor.test
+ /hash.test
/interval.test
/monad.test
/monoid.test
diff --git a/stdlib/source/test/lux/abstract/apply.lux b/stdlib/source/test/lux/abstract/apply.lux
index 29e3e9d6f..eb8fd4e52 100644
--- a/stdlib/source/test/lux/abstract/apply.lux
+++ b/stdlib/source/test/lux/abstract/apply.lux
@@ -2,8 +2,11 @@
[lux #*
[abstract/monad (#+ do)]
[data
+ ["." maybe]
[number
- ["n" nat]]]
+ ["n" nat]]
+ [collection
+ ["." list]]]
[control
["." function]]
[math
@@ -70,3 +73,22 @@
(..interchange injection comparison apply)
(..composition injection comparison apply)
)))
+
+(def: #export test
+ Test
+ (do random.monad
+ [left random.nat
+ right random.nat]
+ (<| (_.covering /._)
+ ($_ _.and
+ (_.cover [/.compose]
+ (let [expected (n.+ left right)]
+ (case (:: (/.compose maybe.monad maybe.apply list.apply) apply
+ (#.Some (list (n.+ left)))
+ (#.Some (list right)))
+ (^ (#.Some (list actual)))
+ (n.= expected actual)
+
+ _
+ false)))
+ ))))
diff --git a/stdlib/source/test/lux/abstract/comonad.lux b/stdlib/source/test/lux/abstract/comonad.lux
new file mode 100644
index 000000000..2e63b4eb8
--- /dev/null
+++ b/stdlib/source/test/lux/abstract/comonad.lux
@@ -0,0 +1,27 @@
+(.module:
+ [lux #*
+ [abstract
+ [monad (#+ do)]]
+ [data
+ ["." identity (#+ Identity)]
+ [number
+ ["n" nat]]]
+ [math
+ ["." random]]
+ ["_" test (#+ Test)]]
+ {1
+ ["." /]})
+
+(def: #export test
+ Test
+ (do random.monad
+ [sample random.nat]
+ (<| (_.covering /._)
+ ($_ _.and
+ (_.cover [/.be]
+ (n.= (inc sample)
+ (: (Identity Nat)
+ (/.be identity.comonad
+ [value (unwrap sample)]
+ (unwrap (inc value))))))
+ ))))
diff --git a/stdlib/source/test/lux/abstract/functor.lux b/stdlib/source/test/lux/abstract/functor.lux
index fcceca39b..faef439c6 100644
--- a/stdlib/source/test/lux/abstract/functor.lux
+++ b/stdlib/source/test/lux/abstract/functor.lux
@@ -1,7 +1,6 @@
(.module:
[lux #*
["_" test (#+ Test)]
- ["%" data/text/format (#+ format)]
[abstract
[equivalence (#+ Equivalence)]
[monad (#+ do)]]
diff --git a/stdlib/source/test/lux/abstract/hash.lux b/stdlib/source/test/lux/abstract/hash.lux
new file mode 100644
index 000000000..f7f82ffe2
--- /dev/null
+++ b/stdlib/source/test/lux/abstract/hash.lux
@@ -0,0 +1,35 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [data
+ ["." bit ("#@." equivalence)]
+ [number
+ ["n" nat]
+ ["i" int]]]
+ [math
+ ["." random]]]
+ {1
+ ["." /]})
+
+(def: #export test
+ Test
+ (do random.monad
+ [left random.nat
+ right random.int
+ other-left random.nat
+ other-right random.int]
+ (<| (_.covering /._)
+ ($_ _.and
+ (_.cover [/.product]
+ (and (n.= (:: (/.product n.hash i.hash) hash [left right])
+ (n.* (:: n.hash hash left)
+ (:: i.hash hash right)))
+ (bit@= (:: (/.product n.hash i.hash) = [left right] [left right])
+ (and (:: n.hash = left left)
+ (:: i.hash = right right)))
+ (bit@= (:: (/.product n.hash i.hash) = [left right] [other-left other-right])
+ (and (:: n.hash = left other-left)
+ (:: i.hash = right other-right)))))
+ ))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 15:07:31 +0000