aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/abstract/monad/free.lux2
-rw-r--r--stdlib/source/lux/control/parser.lux35
-rw-r--r--stdlib/source/lux/control/parser/binary.lux62
-rw-r--r--stdlib/source/lux/data/binary.lux4
-rw-r--r--stdlib/source/lux/data/format/tar.lux466
-rw-r--r--stdlib/source/lux/time/duration.lux12
-rw-r--r--stdlib/source/lux/time/instant.lux39
-rw-r--r--stdlib/source/spec/lux/abstract/functor/contravariant.lux31
-rw-r--r--stdlib/source/test/lux/abstract.lux13
-rw-r--r--stdlib/source/test/lux/abstract/equivalence.lux20
-rw-r--r--stdlib/source/test/lux/abstract/functor/contravariant.lux10
-rw-r--r--stdlib/source/test/lux/abstract/order.lux23
-rw-r--r--stdlib/source/test/lux/data.lux2
-rw-r--r--stdlib/source/test/lux/data/format/tar.lux409
14 files changed, 991 insertions, 137 deletions
diff --git a/stdlib/source/lux/abstract/monad/free.lux b/stdlib/source/lux/abstract/monad/free.lux
index 214261450..5194963b4 100644
--- a/stdlib/source/lux/abstract/monad/free.lux
+++ b/stdlib/source/lux/abstract/monad/free.lux
@@ -1,5 +1,5 @@
(.module:
- lux
+ [lux #*]
[///
[functor (#+ Functor)]
[apply (#+ Apply)]
diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux
index 88eefcdaf..d854be6d0 100644
--- a/stdlib/source/lux/control/parser.lux
+++ b/stdlib/source/lux/control/parser.lux
@@ -92,29 +92,28 @@
(-> (Parser s a) s (Try [s a])))
(p input))
-(def: #export (some p)
+(def: #export (some parser)
{#.doc "0-or-more combinator."}
(All [s a]
(-> (Parser s a) (Parser s (List a))))
(function (_ input)
- (case (p input)
+ (case (parser input)
(#try.Failure _)
(#try.Success [input (list)])
- (#try.Success [input' x])
- (run (do ..monad
- [xs (some p)]
- (wrap (list& x xs)))
+ (#try.Success [input' head])
+ (run (:: ..monad map (|>> (list& head))
+ (some parser))
input'))))
-(def: #export (many p)
+(def: #export (many parser)
{#.doc "1-or-more combinator."}
(All [s a]
(-> (Parser s a) (Parser s (List a))))
- (do ..monad
- [x p
- xs (some p)]
- (wrap (list& x xs))))
+ (do {@ ..monad}
+ [head parser]
+ (:: @ map (|>> (list& head))
+ (some parser))))
(def: #export (and p1 p2)
{#.doc "Sequencing combinator."}
@@ -289,7 +288,17 @@
(#try.Success [input' _])
(#try.Success [input' true]))))
-(def: #export (codec Codec<a,z> parser)
+(def: #export (speculative parser)
+ (All [s a] (-> (Parser s a) (Parser s a)))
+ (function (_ input)
+ (case (parser input)
+ (#try.Success [input' output])
+ (#try.Success [input output])
+
+ output
+ output)))
+
+(def: #export (codec codec parser)
(All [s a z] (-> (Codec a z) (Parser s a) (Parser s z)))
(function (_ input)
(case (parser input)
@@ -297,7 +306,7 @@
(#try.Failure error)
(#try.Success [input' to-decode])
- (case (:: Codec<a,z> decode to-decode)
+ (case (:: codec decode to-decode)
(#try.Failure error)
(#try.Failure error)
diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux
index b2a1b1b52..3dc061940 100644
--- a/stdlib/source/lux/control/parser/binary.lux
+++ b/stdlib/source/lux/control/parser/binary.lux
@@ -8,7 +8,7 @@
["." try (#+ Try)]
["." exception (#+ exception:)]]
[data
- ["." binary (#+ Binary)]
+ ["/" binary (#+ Binary)]
[number
["n" nat]
["." frac]]
@@ -40,11 +40,21 @@
(#try.Failure msg)
(#try.Success [[end _] output])
- (let [length (binary.size input)]
+ (let [length (/.size input)]
(if (n.= end length)
(#try.Success output)
(exception.throw ..binary-was-not-fully-read [length end])))))
+(def: #export end?
+ (Parser Bit)
+ (function (_ (^@ input [offset data]))
+ (#try.Success [input (n.= offset (/.size data))])))
+
+(def: #export remaining
+ (Parser Nat)
+ (function (_ (^@ input [offset data]))
+ (#try.Success [input (n.- offset (/.size data))])))
+
(type: #export Size Nat)
(def: #export size/8 Size 1)
@@ -63,10 +73,10 @@
(#try.Failure error)
(#try.Failure error))))]
- [bits/8 ..size/8 binary.read/8]
- [bits/16 ..size/16 binary.read/16]
- [bits/32 ..size/32 binary.read/32]
- [bits/64 ..size/64 binary.read/64]
+ [bits/8 ..size/8 /.read/8]
+ [bits/16 ..size/16 /.read/16]
+ [bits/32 ..size/32 /.read/32]
+ [bits/64 ..size/64 /.read/64]
)
(template [<name> <type>]
@@ -126,23 +136,27 @@
1 (wrap #1)
_ (//.lift (exception.throw ..not-a-bit [value])))))
-(template [<name> <bits> <size>]
+(def: #export (segment size)
+ (-> Nat (Parser Binary))
+ (function (_ [offset binary])
+ (case size
+ 0 (#try.Success [[offset binary] (/.create 0)])
+ _ (do try.monad
+ [#let [end (n.+ size offset)]
+ output (/.slice offset (.dec end) binary)]
+ (wrap [[end binary] output])))))
+
+(template [<name> <bits>]
[(def: #export <name>
(Parser Binary)
(do //.monad
[size (//@map .nat <bits>)]
- (function (_ [offset binary])
- (case size
- 0 (#try.Success [[offset binary] (binary.create 0)])
- _ (do try.monad
- [#let [end (n.+ size offset)]
- output (binary.slice offset (.dec end) binary)]
- (wrap [[end binary] output]))))))]
-
- [binary/8 ..bits/8 ..size/8]
- [binary/16 ..bits/16 ..size/16]
- [binary/32 ..bits/32 ..size/32]
- [binary/64 ..bits/64 ..size/64]
+ (..segment size)))]
+
+ [binary/8 ..bits/8]
+ [binary/16 ..bits/16]
+ [binary/32 ..bits/32]
+ [binary/64 ..bits/64]
)
(template [<name> <binary>]
@@ -160,7 +174,7 @@
(def: #export text ..utf8/64)
-(template [<name> <bits> <size>]
+(template [<name> <bits>]
[(def: #export (<name> valueP)
(All [v] (-> (Parser v) (Parser (Row v))))
(do //.monad
@@ -179,10 +193,10 @@
(row.add value output)))
(//@wrap output)))))]
- [row/8 ..bits/8 ..size/8]
- [row/16 ..bits/16 ..size/16]
- [row/32 ..bits/32 ..size/32]
- [row/64 ..bits/64 ..size/64]
+ [row/8 ..bits/8]
+ [row/16 ..bits/16]
+ [row/32 ..bits/32]
+ [row/64 ..bits/64]
)
(def: #export maybe
diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux
index defb62049..3853e6aa5 100644
--- a/stdlib/source/lux/data/binary.lux
+++ b/stdlib/source/lux/data/binary.lux
@@ -219,7 +219,9 @@
(#try.Success binary))
(exception.throw ..index-out-of-bounds [(..!size binary) idx])))
-(structure: #export equivalence (Equivalence Binary)
+(structure: #export equivalence
+ (Equivalence Binary)
+
(def: (= reference sample)
(`` (for {(~~ (static @.old))
(java/util/Arrays::equals reference sample)
diff --git a/stdlib/source/lux/data/format/tar.lux b/stdlib/source/lux/data/format/tar.lux
index a9bb06954..42e8103e7 100644
--- a/stdlib/source/lux/data/format/tar.lux
+++ b/stdlib/source/lux/data/format/tar.lux
@@ -9,6 +9,7 @@
["<>" parser
["<b>" binary (#+ Parser)]]]
[data
+ ["." product]
["." binary (#+ Binary)]
["." text (#+ Char)
["%" format (#+ format)]
@@ -48,31 +49,33 @@
(def: small-size Size 6)
(def: big-size Size 11)
-(template [<exception> <maximum> <size>
+(template [<exception> <limit> <size>
<type> <in> <out> <writer> <suffix>
<coercion>]
- [(def: <maximum>
+ [(def: #export <limit>
+ Nat
(|> ..octal-size
(list.repeat <size>)
- (list@fold n.* 1)))
+ (list@fold n.* 1)
+ inc))
(exception: #export (<exception> {value Nat})
(exception.report
["Value" (%.nat value)]
- ["Maximum" (%.nat <maximum>)]))
+ ["Maximum" (%.nat (dec <limit>))]))
- (abstract: <type>
+ (abstract: #export <type>
{}
Nat
(def: #export (<in> value)
(-> Nat (Try <type>))
- (if (|> value (n.% <maximum>) (n.= value))
+ (if (|> value (n.% <limit>) (n.= value))
(#try.Success (:abstraction value))
(exception.throw <exception> [value])))
- (def: <out>
+ (def: #export <out>
(-> <type> Nat)
(|>> :representation))
@@ -89,25 +92,74 @@
(def: <coercion>
(-> Nat <type>)
- (|>> (n.% <maximum>)
+ (|>> (n.% <limit>)
:abstraction))
)]
- [not-a-small-number maximum-small-size ..small-size
+ [not-a-small-number small-limit ..small-size
Small small from-small
small-writer (format ..blank ..null)
coerce-small]
- [not-a-big-number maximum-big-size ..big-size
+ [not-a-big-number big-limit ..big-size
Big big from-big
big-writer ..blank
coerce-big]
)
+(exception: #export (wrong-character {expected Char} {actual Char})
+ (exception.report
+ ["Expected" (%.nat expected)]
+ ["Actual" (%.nat actual)]))
+
+(def: verify-small-suffix
+ (Parser Any)
+ (do <>.monad
+ [pre-end <b>.bits/8
+ end <b>.bits/8
+ _ (let [expected (`` (char (~~ (static ..blank))))]
+ (<>.assert (exception.construct ..wrong-character [expected pre-end])
+ (n.= expected pre-end)))
+ _ (let [expected (`` (char (~~ (static ..null))))]
+ (<>.assert (exception.construct ..wrong-character [expected end])
+ (n.= expected end)))]
+ (wrap [])))
+
+(def: small-parser
+ (Parser Small)
+ (do <>.monad
+ [digits (<b>.segment ..small-size)
+ digits (<>.lift
+ (encoding.from-utf8 digits))
+ _ ..verify-small-suffix]
+ (<>.lift
+ (do {@ try.monad}
+ [value (:: n.octal decode digits)]
+ (..small value)))))
+
+(def: big-parser
+ (Parser Big)
+ (do <>.monad
+ [digits (<b>.segment ..big-size)
+ digits (<>.lift
+ (encoding.from-utf8 digits))
+ end <b>.bits/8
+ _ (let [expected (`` (char (~~ (static ..blank))))]
+ (<>.assert (exception.construct ..wrong-character [expected end])
+ (n.= expected end)))]
+ (<>.lift
+ (do {@ try.monad}
+ [value (:: n.octal decode digits)]
+ (..big value)))))
+
(abstract: Checksum
{}
Text
+ (def: from-checksum
+ (-> Checksum Text)
+ (|>> :representation))
+
(def: dummy-checksum
Checksum
(:abstraction " "))
@@ -116,8 +168,15 @@
(format ..blank ..null))
(def: checksum
+ (-> Binary Nat)
+ (binary.fold n.+ 0))
+
+ (def: checksum-checksum
+ (|> ..dummy-checksum :representation encoding.to-utf8 ..checksum))
+
+ (def: checksum-code
(-> Binary Checksum)
- (|>> (binary.fold n.+ 0)
+ (|>> ..checksum
..coerce-small
..from-small
(:: n.octal encode)
@@ -132,6 +191,18 @@
(|>> :representation
encoding.to-utf8
(format.segment padded-size))))
+
+ (def: checksum-parser
+ (Parser [Nat Checksum])
+ (do <>.monad
+ [ascii (<b>.segment ..small-size)
+ digits (<>.lift
+ (encoding.from-utf8 ascii))
+ _ ..verify-small-suffix
+ value (<>.lift
+ (:: n.octal decode digits))]
+ (wrap [value
+ (:abstraction (format digits ..checksum-suffix))])))
)
(def: last-ascii
@@ -150,11 +221,27 @@
(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>
+(def: #export name-size Size 31)
+(def: #export path-size Size 99)
+
+(def: (un-pad string)
+ (-> Binary (Try Binary))
+ (case (binary.size string)
+ 0 (#try.Success string)
+ size (loop [end (dec size)]
+ (case end
+ 0 (#try.Success (encoding.to-utf8 ""))
+ _ (do try.monad
+ [last-char (binary.read/8 end string)]
+ (`` (case (.nat last-char)
+ (^ (char (~~ (static ..null))))
+ (recur (dec end))
+
+ _
+ (binary.slice 0 end string))))))))
+
+(template [<type> <representation> <size> <exception> <in> <out> <writer> <parser> <none>]
+ [(abstract: #export <type>
{}
<representation>
@@ -168,12 +255,12 @@
(def: #export (<in> value)
(-> <representation> (Try <type>))
(if (..ascii? value)
- (if (|> value encoding.to-utf8 binary.size (n.< <size>))
+ (if (|> value encoding.to-utf8 binary.size (n.<= <size>))
(#try.Success (:abstraction value))
(exception.throw <exception> [value]))
(exception.throw ..not-ascii [value])))
- (def: <out>
+ (def: #export <out>
(-> <type> <representation>)
(|>> :representation))
@@ -186,13 +273,27 @@
encoding.to-utf8
(format.segment padded-size))))
+ (def: <parser>
+ (Parser <type>)
+ (do <>.monad
+ [string (<b>.segment <size>)
+ end <b>.bits/8
+ #let [expected (`` (char (~~ (static ..null))))]
+ _ (<>.assert (exception.construct ..wrong-character [expected end])
+ (n.= expected end))]
+ (<>.lift
+ (do {@ try.monad}
+ [ascii (..un-pad string)
+ text (encoding.from-utf8 ascii)]
+ (<in> text)))))
+
(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]
+ [Name Text ..name-size name-is-too-long name from-name name-writer name-parser anonymous]
+ [Path file.Path ..path-size path-is-too-long path from-path path-writer path-parser no-path]
)
(def: magic-size Size 7)
@@ -215,6 +316,18 @@
(|>> :representation
encoding.to-utf8
(format.segment padded-size))))
+
+ (def: magic-parser
+ (Parser Magic)
+ (do <>.monad
+ [string (<b>.segment ..magic-size)
+ end <b>.bits/8
+ #let [expected (`` (char (~~ (static ..null))))]
+ _ (<>.assert (exception.construct ..wrong-character [expected end])
+ (n.= expected end))]
+ (<>.lift
+ (:: try.monad map (|>> :abstraction)
+ (encoding.from-utf8 string)))))
)
(def: block-size Size 512)
@@ -278,29 +391,49 @@
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
+ (-> Link-Flag Char)
+ (|>> :representation))
(def: link-flag-writer
(Writer Link-Flag)
(|>> :representation
format.bits/8))
+
+ (with-expansions [<options> (as-is [0 old-normal]
+ [(char "0") normal]
+ [(char "1") link]
+ [(char "2") symbolic-link]
+ [(char "3") character]
+ [(char "4") block]
+ [(char "5") directory]
+ [(char "6") fifo]
+ [(char "7") contiguous])]
+ (template [<flag> <name>]
+ [(def: <name>
+ Link-Flag
+ (:abstraction <flag>))]
+
+ <options>
+ )
+
+ (exception: #export (invalid-link-flag {value Nat})
+ (exception.report
+ ["Value" (%.nat value)]))
+
+ (def: link-flag-parser
+ (Parser Link-Flag)
+ (do <>.monad
+ [linkflag <b>.bits/8]
+ (case (.nat linkflag)
+ (^template [<value> <link-flag>]
+ (^ <value>)
+ (wrap <link-flag>))
+ (<options>)
+
+ _
+ (<>.lift
+ (exception.throw ..invalid-link-flag [(.nat linkflag)]))))))
)
(abstract: #export Mode
@@ -308,27 +441,9 @@
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 mode
+ (-> Mode Nat)
+ (|>> :representation))
(def: #export (and left right)
(-> Mode Mode Mode)
@@ -342,6 +457,67 @@
..small
try.assume
..small-writer))
+
+ (exception: #export (invalid-mode {value Nat})
+ (exception.report
+ ["Value" (%.nat value)]))
+
+ (with-expansions [<options> (as-is ["0000" none]
+
+ ["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])]
+ (template [<code> <name>]
+ [(def: #export <name>
+ Mode
+ (:abstraction (number.oct <code>)))]
+
+ <options>
+ )
+
+ (def: maximum-mode
+ Mode
+ ($_ and
+ ..none
+
+ ..execute-by-other
+ ..write-by-other
+ ..read-by-other
+
+ ..execute-by-group
+ ..write-by-group
+ ..read-by-group
+
+ ..execute-by-owner
+ ..write-by-owner
+ ..read-by-owner
+
+ ..save-text
+ ..set-group-id-on-execution
+ ..set-user-id-on-execution
+ ))
+
+ (def: mode-parser
+ (Parser Mode)
+ (do {@ <>.monad}
+ [value (:: @ map ..from-small ..small-parser)]
+ (if (n.<= (:representation ..maximum-mode)
+ value)
+ (wrap (:abstraction value))
+ (<>.lift
+ (exception.throw ..invalid-mode [value]))))))
)
(def: maximum-content-size
@@ -350,7 +526,7 @@
(list.repeat ..content-size)
(list@fold n.* 1)))
-(abstract: Content
+(abstract: #export Content
{}
[Big Binary]
@@ -364,6 +540,10 @@
(def: from-content
(-> Content [Big Binary])
(|>> :representation))
+
+ (def: #export data
+ (-> Content Binary)
+ (|>> :representation product.right))
)
(type: #export ID
@@ -384,14 +564,16 @@
(type: #export File
[Path Instant Mode Ownership Content])
-(type: #export Directory
- Path)
+(type: #export Normal File)
+(type: #export Symbolic-Link Path)
+(type: #export Directory Path)
+(type: #export Contiguous File)
(type: #export Entry
- (#Normal File)
- (#Symbolic-Link Path)
- (#Directory Directory)
- (#Contiguous File))
+ (#Normal ..Normal)
+ (#Symbolic-Link ..Symbolic-Link)
+ (#Directory ..Directory)
+ (#Contiguous ..Contiguous))
(type: #export Device
Small)
@@ -456,11 +638,10 @@
(let [checksum (|> header
(set@ #checksum ..dummy-checksum)
(format.run ..header-writer')
- ..checksum)
- data (|> header
- (set@ #checksum checksum)
- (format.run ..header-writer'))]
- (|> data
+ ..checksum-code)]
+ (|> header
+ (set@ #checksum checksum)
+ (format.run ..header-writer')
(format.segment ..block-size))))
(def: modification-time
@@ -523,7 +704,7 @@
#minor-device ..no-device}))
(def: (directory-writer path)
- (Writer Directory)
+ (Writer Path)
(..header-writer
{#path path
#mode ($_ ..and
@@ -563,3 +744,144 @@
format@identity
tar)
(format.segment ..end-of-archive-size ..end-of-archive)))
+
+(exception: #export (wrong-checksum {expected Nat} {actual Nat})
+ (exception.report
+ ["Expected" (%.nat expected)]
+ ["Actual" (%.nat actual)]))
+
+(def: header-padding-size
+ (n.- header-size block-size))
+
+## When the checksum gets originally calculated, the assumption is that all the characters in the checksum field
+## of the header will be spaces.
+## This means that just calculating the checksum of the 512 bytes of the header, when reading them, would yield
+## an incorrect result, as the contents of the checksum field would be an actual checksum, instead of just spaces.
+## To correct for this, it is necessary to calculate the checksum of just the checksum field, subtract that, and then
+## add-in the checksum of the spaces.
+(def: (expected-checksum checksum header)
+ (-> Checksum Binary Nat)
+ (let [|checksum| (|> checksum ..from-checksum encoding.to-utf8 ..checksum)]
+ (|> (..checksum header)
+ (n.- |checksum|)
+ (n.+ ..checksum-checksum))))
+
+(def: header-parser
+ (Parser Header)
+ (do <>.monad
+ [binary-header (<>.speculative (<b>.segment block-size))
+ path ..path-parser
+ mode ..mode-parser
+ user-id ..small-parser
+ group-id ..small-parser
+ size ..big-parser
+ modification-time ..big-parser
+ [actual checksum-code] ..checksum-parser
+ _ (let [expected (expected-checksum checksum-code binary-header)]
+ (<>.lift
+ (exception.assert ..wrong-checksum [expected actual]
+ (n.= expected actual))))
+ link-flag ..link-flag-parser
+ link-name ..path-parser
+ magic ..magic-parser
+ user-name ..name-parser
+ group-name ..name-parser
+ major-device ..small-parser
+ minor-device ..small-parser
+ _ (<b>.segment ..header-padding-size)]
+ (wrap {#path path
+ #mode mode
+ #user-id user-id
+ #group-id group-id
+ #size size
+ #modification-time modification-time
+ #checksum checksum-code
+ #link-flag link-flag
+ #link-name link-name
+ #magic magic
+ #user-name user-name
+ #group-name group-name
+ #major-device major-device
+ #minor-device minor-device})))
+
+(exception: #export (wrong-link-flag {expected Link-Flag} {actual Link-Flag})
+ (exception.report
+ ["Expected" (%.nat (..link-flag expected))]
+ ["Actual" (%.nat (..link-flag actual))]))
+
+(def: (file-parser expected)
+ (-> Link-Flag (Parser File))
+ (do <>.monad
+ [header ..header-parser
+ _ (<>.assert (exception.construct ..wrong-link-flag [expected (get@ #link-flag header)])
+ (is? expected (get@ #link-flag header)))
+ #let [size (get@ #size header)
+ rounded-size (..rounded-content-size size)]
+ content (<b>.segment (..from-big size))
+ content (<>.lift (..content content))
+ _ (<b>.segment (n.- (..from-big size) rounded-size))]
+ (wrap [(get@ #path header)
+ (|> header
+ (get@ #modification-time)
+ ..from-big
+ .int
+ duration.from-millis
+ (duration.scale-up (|> duration.second duration.to-millis .nat))
+ instant.absolute)
+ (get@ #mode header)
+ {#user {#name (get@ #user-name header)
+ #id (get@ #user-id header)}
+ #group {#name (get@ #group-name header)
+ #id (get@ #group-id header)}}
+ content])))
+
+(def: (file-name-parser expected extractor)
+ (-> Link-Flag (-> Header Path) (Parser Path))
+ (do <>.monad
+ [header ..header-parser
+ _ (<>.lift
+ (exception.assert ..wrong-link-flag [expected (get@ #link-flag header)]
+ (n.= (..link-flag expected)
+ (..link-flag (get@ #link-flag header)))))]
+ (wrap (extractor header))))
+
+(def: entry-parser
+ (Parser Entry)
+ ($_ <>.either
+ (:: <>.monad map (|>> #..Normal)
+ (<>.either (..file-parser ..normal)
+ (..file-parser ..old-normal)))
+ (:: <>.monad map (|>> #..Symbolic-Link)
+ (..file-name-parser ..symbolic-link (get@ #link-name)))
+ (:: <>.monad map (|>> #..Directory)
+ (..file-name-parser ..directory (get@ #path)))
+ (:: <>.monad map (|>> #..Contiguous)
+ (..file-parser ..contiguous))))
+
+## It's safe to implement the parser this way because the range of values for Nat is 2^64
+## Whereas the maximum possible value for the checksum of a 512 block is (256 × 512) = 131,072
+(def: end-of-archive-block-parser
+ (Parser Any)
+ (do <>.monad
+ [block (<b>.segment ..block-size)]
+ (let [actual (..checksum block)]
+ (<>.lift
+ (exception.assert ..wrong-checksum [0 actual]
+ (n.= 0 actual))))))
+
+(exception: #export invalid-end-of-archive)
+
+(def: end-of-archive-parser
+ (Parser Any)
+ (do <>.monad
+ [_ (<>.at-most 2 end-of-archive-block-parser)
+ done? <b>.end?]
+ (<>.lift
+ (exception.assert ..invalid-end-of-archive []
+ done?))))
+
+(def: #export parser
+ (Parser Tar)
+ (|> (<>.some entry-parser)
+ (:: <>.monad map row.from-list)
+ (<>.before ..end-of-archive-parser)))
diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux
index 47a480ab9..b87c2e2d3 100644
--- a/stdlib/source/lux/time/duration.lux
+++ b/stdlib/source/lux/time/duration.lux
@@ -60,11 +60,15 @@
(-> Duration Duration Int)
(i./ (:representation param) (:representation subject)))
- (structure: #export equivalence (Equivalence Duration)
+ (structure: #export equivalence
+ (Equivalence Duration)
+
(def: (= param subject)
(i.= (:representation param) (:representation subject))))
- (structure: #export order (Order Duration)
+ (structure: #export order
+ (Order Duration)
+
(def: &equivalence ..equivalence)
(def: (< param subject)
(i.< (:representation param) (:representation subject))))
@@ -96,7 +100,9 @@
(def: #export leap-year (merge day normal-year))
-(structure: #export monoid (Monoid Duration)
+(structure: #export monoid
+ (Monoid Duration)
+
(def: identity ..empty)
(def: compose ..merge))
diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux
index bd378016a..ab7fe6953 100644
--- a/stdlib/source/lux/time/instant.lux
+++ b/stdlib/source/lux/time/instant.lux
@@ -14,7 +14,7 @@
[data
["." maybe]
[number
- ["n" nat]
+ ["n" nat ("#@." decimal)]
["i" int ("#@." decimal)]]
["." text ("#@." monoid)]
[collection
@@ -56,16 +56,22 @@
(-> Duration Instant)
(|> offset duration.to-millis :abstraction))
- (structure: #export equivalence (Equivalence Instant)
+ (structure: #export equivalence
+ (Equivalence Instant)
+
(def: (= param subject)
(:: i.equivalence = (:representation param) (:representation subject))))
- (structure: #export order (Order Instant)
+ (structure: #export order
+ (Order Instant)
+
(def: &equivalence ..equivalence)
(def: (< param subject)
(:: i.order < (:representation param) (:representation subject))))
- (`` (structure: #export enum (Enum Instant)
+ (`` (structure: #export enum
+ (Enum Instant)
+
(def: &order ..order)
(~~ (template [<name>]
[(def: <name>
@@ -126,10 +132,10 @@
(row.reverse months))))
(def: (pad value)
- (-> Int Text)
- (if (i.< +10 value)
- (text@compose "0" (i@encode value))
- (i@encode value)))
+ (-> Nat Text)
+ (if (n.< 10 value)
+ (text@compose "0" (n@encode value))
+ (n@encode value)))
(def: (adjust-negative space duration)
(-> Duration Duration Duration)
@@ -138,12 +144,12 @@
duration))
(def: (encode-millis millis)
- (-> Int Text)
- (cond (i.= +0 millis) ""
- (i.< +10 millis) ($_ text@compose ".00" (i@encode millis))
- (i.< +100 millis) ($_ text@compose ".0" (i@encode millis))
- ## (i.< +1,000 millis)
- ($_ text@compose "." (i@encode millis))))
+ (-> Nat Text)
+ (cond (n.= 0 millis) ""
+ (n.< 10 millis) ($_ text@compose ".00" (n@encode millis))
+ (n.< 100 millis) ($_ text@compose ".0" (n@encode millis))
+ ## (n.< 1,000 millis)
+ ($_ text@compose "." (n@encode millis))))
(def: seconds-per-day Int (duration.query duration.second duration.day))
(def: days-up-to-epoch Int +719468)
@@ -196,11 +202,12 @@
[hours day-time] [(duration.query duration.hour day-time) (duration.frame duration.hour day-time)]
[minutes day-time] [(duration.query duration.minute day-time) (duration.frame duration.minute day-time)]
[seconds millis] [(duration.query duration.second day-time) (duration.frame duration.second day-time)]]
- ($_ text@compose (i@encode year) "-" (pad month) "-" (pad day) "T"
- (pad hours) ":" (pad minutes) ":" (pad seconds)
+ ($_ text@compose (i@encode year) "-" (pad (.nat month)) "-" (pad (.nat day)) "T"
+ (pad (.nat hours)) ":" (pad (.nat minutes)) ":" (pad (.nat seconds))
(|> millis
(adjust-negative duration.second)
duration.to-millis
+ .nat
encode-millis)
"Z")))
diff --git a/stdlib/source/spec/lux/abstract/functor/contravariant.lux b/stdlib/source/spec/lux/abstract/functor/contravariant.lux
new file mode 100644
index 000000000..b21e28e68
--- /dev/null
+++ b/stdlib/source/spec/lux/abstract/functor/contravariant.lux
@@ -0,0 +1,31 @@
+(.module:
+ [lux #*
+ [abstract
+ [equivalence (#+ Equivalence)]
+ [monad (#+ do)]]
+ [data
+ [number
+ ["n" nat]]]
+ [control
+ ["." function]]
+ [math
+ ["." random]]
+ ["_" test (#+ Test)]]
+ {1
+ ["." / (#+ Functor)]})
+
+(def: (identity equivalence value (^open "/@."))
+ (All [f a] (-> (Equivalence (f a)) (f a) (Functor f) Test))
+ (_.test "Law of identity."
+ (equivalence
+ (/@map function.identity value)
+ value)))
+
+(def: #export (spec equivalence value functor)
+ (All [f a] (-> (Equivalence (f a)) (f a) (Functor f) Test))
+ (do random.monad
+ [sample random.nat]
+ (<| (_.with-cover [/.Functor])
+ ($_ _.and
+ (..identity equivalence value functor)
+ ))))
diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux
index ef7cb0774..aa93df86f 100644
--- a/stdlib/source/test/lux/abstract.lux
+++ b/stdlib/source/test/lux/abstract.lux
@@ -14,7 +14,16 @@
["#." monad]
["#." monoid]
["#." order]
- ["#." predicate]])
+ ["#." predicate]
+ [functor
+ ["#." contravariant]]])
+
+(def: functor
+ Test
+ ($_ _.and
+ /functor.test
+ /contravariant.test
+ ))
(def: #export test
Test
@@ -25,7 +34,7 @@
/enum.test
/equivalence.test
/fold.test
- /functor.test
+ ..functor
/hash.test
/interval.test
/monad.test
diff --git a/stdlib/source/test/lux/abstract/equivalence.lux b/stdlib/source/test/lux/abstract/equivalence.lux
index 7cc5c95f9..d79803e31 100644
--- a/stdlib/source/test/lux/abstract/equivalence.lux
+++ b/stdlib/source/test/lux/abstract/equivalence.lux
@@ -1,7 +1,12 @@
(.module:
[lux #*
["_" test (#+ Test)]
- [abstract/monad (#+ do)]
+ [abstract
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ [functor
+ ["." contravariant]]]}]
[data
["." bit ("#@." equivalence)]
[number
@@ -20,9 +25,20 @@
leftI random.int
rightI random.int
sample random.nat
- different (|> random.nat (random.filter (|>> (n.= sample) not)))]
+ different (|> random.nat (random.filter (|>> (n.= sample) not)))
+ #let [equivalence (: (Equivalence (Equivalence Nat))
+ (structure
+ (def: (= left right)
+ (and (bit@= (:: left = leftN leftN)
+ (:: right = leftN leftN))
+ (bit@= (:: left = rightN rightN)
+ (:: right = rightN rightN))
+ (bit@= (:: left = leftN rightN)
+ (:: right = leftN rightN))))))]]
(<| (_.covering /._)
($_ _.and
+ (_.with-cover [/.functor]
+ (contravariant.spec equivalence n.equivalence /.functor))
(_.cover [/.sum]
(let [equivalence (/.sum n.equivalence i.equivalence)]
(and (bit@= (:: n.equivalence = leftN leftN)
diff --git a/stdlib/source/test/lux/abstract/functor/contravariant.lux b/stdlib/source/test/lux/abstract/functor/contravariant.lux
new file mode 100644
index 000000000..93d1f18ad
--- /dev/null
+++ b/stdlib/source/test/lux/abstract/functor/contravariant.lux
@@ -0,0 +1,10 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]]
+ {1
+ ["." /]})
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.in-parallel (list))))
diff --git a/stdlib/source/test/lux/abstract/order.lux b/stdlib/source/test/lux/abstract/order.lux
index 7157a6c01..dff849034 100644
--- a/stdlib/source/test/lux/abstract/order.lux
+++ b/stdlib/source/test/lux/abstract/order.lux
@@ -2,7 +2,11 @@
[lux #*
["_" test (#+ Test)]
[abstract
- [monad (#+ do)]]
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ [functor
+ ["." contravariant]]]}]
[data
["." bit ("#@." equivalence)]
[number
@@ -10,15 +14,28 @@
[math
["." random (#+ Random)]]]
{1
- ["." / (#+ Order)]})
+ ["." / (#+ Order)
+ [//
+ [equivalence (#+ Equivalence)]]]})
(def: #export test
Test
(<| (_.covering /._)
(do random.monad
[left random.nat
- right (|> random.nat (random.filter (|>> (n.= left) not)))])
+ right (|> random.nat (random.filter (|>> (n.= left) not)))
+ #let [equivalence (: (Equivalence (Order Nat))
+ (structure
+ (def: (= leftO rightO)
+ (and (bit@= (:: leftO < left left)
+ (:: rightO < left left))
+ (bit@= (:: leftO < right right)
+ (:: rightO < right right))
+ (bit@= (:: leftO < left right)
+ (:: rightO < left right))))))]])
($_ _.and
+ (_.with-cover [/.functor]
+ (contravariant.spec equivalence n.order /.functor))
(_.cover [/.Choice /.min /.max]
(n.< (/.max n.order left right)
(/.min n.order left right)))
diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux
index fa544ccd5..47a79b530 100644
--- a/stdlib/source/test/lux/data.lux
+++ b/stdlib/source/test/lux/data.lux
@@ -30,6 +30,7 @@
["#/." regex]]
[format
["#." json]
+ ["#." tar]
["#." xml]]
["#." collection]])
@@ -71,6 +72,7 @@
(def: format
($_ _.and
/json.test
+ /tar.test
/xml.test
))
diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux
new file mode 100644
index 000000000..b8ba1af51
--- /dev/null
+++ b/stdlib/source/test/lux/data/format/tar.lux
@@ -0,0 +1,409 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try]
+ ["." exception]
+ ["<>" parser
+ ["<b>" binary]]]
+ [data
+ ["." product]
+ ["." maybe]
+ ["." binary ("#@." equivalence)]
+ ["." text ("#@." equivalence)
+ ["." encoding]
+ ["." unicode]
+ ["%" format (#+ format)]]
+ [number
+ ["n" nat]
+ ["i" int]]
+ [collection
+ ["." row]
+ ["." list ("#@." fold)]]
+ ["." format #_
+ ["#" binary]]]
+ [time
+ ["." instant (#+ Instant)]
+ ["." duration]]
+ [math
+ ["." random (#+ Random)]]]
+ {1
+ ["." /]})
+
+(def: path
+ Test
+ (_.with-cover [/.Path]
+ (do {@ random.monad}
+ [expected (random.ascii/lower-alpha /.path-size)
+ invalid (random.ascii/lower-alpha (inc /.path-size))
+ not-ascii (random.text (random.char (unicode.set (list unicode.katakana)))
+ /.path-size)]
+ (`` ($_ _.and
+ (_.cover [/.path /.from-path]
+ (case (/.path expected)
+ (#try.Success actual)
+ (text@= expected
+ (/.from-path actual))
+
+ (#try.Failure error)
+ false))
+ (_.cover [/.path-size /.path-is-too-long]
+ (case (/.path invalid)
+ (#try.Success _)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.path-is-too-long error)))
+ (_.cover [/.not-ascii]
+ (case (/.path not-ascii)
+ (#try.Success actual)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.not-ascii error)))
+ )))))
+
+(def: name
+ Test
+ (_.with-cover [/.Name]
+ (do {@ random.monad}
+ [expected (random.ascii/lower-alpha /.name-size)
+ invalid (random.ascii/lower-alpha (inc /.name-size))
+ not-ascii (random.text (random.char (unicode.set (list unicode.katakana)))
+ /.name-size)]
+ (`` ($_ _.and
+ (_.cover [/.name /.from-name]
+ (case (/.name expected)
+ (#try.Success actual)
+ (text@= expected
+ (/.from-name actual))
+
+ (#try.Failure error)
+ false))
+ (_.cover [/.name-size /.name-is-too-long]
+ (case (/.name invalid)
+ (#try.Success _)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.name-is-too-long error)))
+ (_.cover [/.not-ascii]
+ (case (/.name not-ascii)
+ (#try.Success actual)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.not-ascii error)))
+ )))))
+
+(def: small
+ Test
+ (_.with-cover [/.Small]
+ (do {@ random.monad}
+ [expected (|> random.nat (:: @ map (n.% /.small-limit)))
+ invalid (|> random.nat (:: @ map (n.max /.small-limit)))]
+ (`` ($_ _.and
+ (_.cover [/.small /.from-small]
+ (case (/.small expected)
+ (#try.Success actual)
+ (n.= expected
+ (/.from-small actual))
+
+ (#try.Failure error)
+ false))
+ (_.cover [/.small-limit /.not-a-small-number]
+ (case (/.small invalid)
+ (#try.Success actual)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.not-a-small-number error)))
+ )))))
+
+(def: big
+ Test
+ (_.with-cover [/.Big]
+ (do {@ random.monad}
+ [expected (|> random.nat (:: @ map (n.% /.big-limit)))
+ invalid (|> random.nat (:: @ map (n.max /.big-limit)))]
+ (`` ($_ _.and
+ (_.cover [/.big /.from-big]
+ (case (/.big expected)
+ (#try.Success actual)
+ (n.= expected
+ (/.from-big actual))
+
+ (#try.Failure error)
+ false))
+ (_.cover [/.big-limit /.not-a-big-number]
+ (case (/.big invalid)
+ (#try.Success actual)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.not-a-big-number error)))
+ )))))
+
+(def: chunk-size 32)
+
+(def: entry
+ Test
+ (do {@ random.monad}
+ [expected-path (random.ascii/lower-alpha (dec /.path-size))
+ expected-moment (:: @ map (|>> (n.% 1,00,00,00,00,00,000) .int instant.from-millis)
+ random.nat)
+ chunk (random.ascii/lower-alpha chunk-size)
+ chunks (:: @ map (n.% 100) random.nat)
+ #let [content (|> chunk
+ (list.repeat chunks)
+ (text.join-with "")
+ encoding.to-utf8)]]
+ (`` ($_ _.and
+ (~~ (template [<type> <tag>]
+ [(_.cover [<type>]
+ (|> (do try.monad
+ [expected-path (/.path expected-path)
+ tar (|> (row.row (<tag> expected-path))
+ (format.run /.writer)
+ (<b>.run /.parser))]
+ (wrap (case (row.to-list tar)
+ (^ (list (<tag> actual-path)))
+ (text@= (/.from-path expected-path)
+ (/.from-path actual-path))
+
+ _
+ false)))
+ (try.default false)))]
+
+ [/.Symbolic-Link #/.Symbolic-Link]
+ [/.Directory #/.Directory]
+ ))
+ (_.with-cover [/.File /.Content /.content /.data]
+ ($_ _.and
+ (~~ (template [<type> <tag>]
+ [(_.cover [<type>]
+ (|> (do try.monad
+ [expected-path (/.path expected-path)
+ expected-content (/.content content)
+ tar (|> (row.row (<tag> [expected-path
+ expected-moment
+ /.none
+ {#/.user {#/.name /.anonymous
+ #/.id /.no-id}
+ #/.group {#/.name /.anonymous
+ #/.id /.no-id}}
+ expected-content]))
+ (format.run /.writer)
+ (<b>.run /.parser))]
+ (wrap (case (row.to-list tar)
+ (^ (list (<tag> [actual-path actual-moment actual-mode actual-ownership actual-content])))
+ (let [seconds (: (-> Instant Int)
+ (|>> instant.relative (duration.query duration.second)))]
+ (and (text@= (/.from-path expected-path)
+ (/.from-path actual-path))
+ (i.= (seconds expected-moment)
+ (seconds actual-moment))
+ (binary@= (/.data expected-content)
+ (/.data actual-content))))
+
+ _
+ false)))
+ (try.default false)))]
+
+ [/.Normal #/.Normal]
+ [/.Contiguous #/.Contiguous]
+ ))))))))
+
+(def: random-mode
+ (Random /.Mode)
+ (do {@ random.monad}
+ []
+ (random.either (random.either (random.either (wrap /.execute-by-other)
+ (wrap /.write-by-other))
+ (random.either (wrap /.read-by-other)
+ (wrap /.execute-by-group)))
+ (random.either (random.either (random.either (wrap /.write-by-group)
+ (wrap /.read-by-group))
+ (random.either (wrap /.execute-by-owner)
+ (wrap /.write-by-owner)))
+ (random.either (random.either (wrap /.read-by-owner)
+ (wrap /.save-text))
+ (random.either (wrap /.set-group-id-on-execution)
+ (wrap /.set-user-id-on-execution)))))))
+
+(def: mode
+ Test
+ (_.with-cover [/.Mode /.mode]
+ (do {@ random.monad}
+ [path (random.ascii/lower-alpha 10)
+ modes (random.list 4 ..random-mode)
+ #let [expected-mode (list@fold /.and /.none modes)]]
+ (`` ($_ _.and
+ (_.cover [/.and]
+ (|> (do try.monad
+ [path (/.path path)
+ content (/.content (binary.create 0))
+ tar (|> (row.row (#/.Normal [path
+ (instant.from-millis +0)
+ expected-mode
+ {#/.user {#/.name /.anonymous
+ #/.id /.no-id}
+ #/.group {#/.name /.anonymous
+ #/.id /.no-id}}
+ content]))
+ (format.run /.writer)
+ (<b>.run /.parser))]
+ (wrap (case (row.to-list tar)
+ (^ (list (#/.Normal [_ _ actual-mode _ _])))
+ (n.= (/.mode expected-mode)
+ (/.mode actual-mode))
+
+ _
+ false)))
+ (try.default false)))
+ (~~ (template [<expected-mode>]
+ [(_.cover [<expected-mode>]
+ (|> (do try.monad
+ [path (/.path path)
+ content (/.content (binary.create 0))
+ tar (|> (row.row (#/.Normal [path
+ (instant.from-millis +0)
+ <expected-mode>
+ {#/.user {#/.name /.anonymous
+ #/.id /.no-id}
+ #/.group {#/.name /.anonymous
+ #/.id /.no-id}}
+ content]))
+ (format.run /.writer)
+ (<b>.run /.parser))]
+ (wrap (case (row.to-list tar)
+ (^ (list (#/.Normal [_ _ actual-mode _ _])))
+ (n.= (/.mode <expected-mode>)
+ (/.mode actual-mode))
+
+ _
+ false)))
+ (try.default false)))]
+
+ [/.none]
+
+ [/.execute-by-other]
+ [/.write-by-other]
+ [/.read-by-other]
+
+ [/.execute-by-group]
+ [/.write-by-group]
+ [/.read-by-group]
+
+ [/.execute-by-owner]
+ [/.write-by-owner]
+ [/.read-by-owner]
+
+ [/.save-text]
+ [/.set-group-id-on-execution]
+ [/.set-user-id-on-execution]
+ )))))))
+
+(def: ownership
+ Test
+ (do {@ random.monad}
+ [path (random.ascii/lower-alpha /.path-size)
+ expected (random.ascii/lower-alpha /.name-size)
+ invalid (random.ascii/lower-alpha (inc /.name-size))
+ not-ascii (random.text (random.char (unicode.set (list unicode.katakana)))
+ /.name-size)]
+ (_.with-cover [/.Ownership /.Owner /.ID]
+ ($_ _.and
+ (_.cover [/.name-size /.name-is-too-long]
+ (case (/.name invalid)
+ (#try.Success _)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.name-is-too-long error)))
+ (_.cover [/.not-ascii]
+ (case (/.name not-ascii)
+ (#try.Success actual)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.not-ascii error)))
+ (_.cover [/.Name /.name /.from-name]
+ (|> (do try.monad
+ [path (/.path path)
+ content (/.content (binary.create 0))
+ expected (/.name expected)
+ tar (|> (row.row (#/.Normal [path
+ (instant.from-millis +0)
+ /.none
+ {#/.user {#/.name expected
+ #/.id /.no-id}
+ #/.group {#/.name /.anonymous
+ #/.id /.no-id}}
+ content]))
+ (format.run /.writer)
+ (<b>.run /.parser))]
+ (wrap (case (row.to-list tar)
+ (^ (list (#/.Normal [_ _ _ actual-ownership _])))
+ (and (text@= (/.from-name expected)
+ (/.from-name (get@ [#/.user #/.name] actual-ownership)))
+ (text@= (/.from-name /.anonymous)
+ (/.from-name (get@ [#/.group #/.name] actual-ownership))))
+
+ _
+ false)))
+ (try.default false)))
+ (_.cover [/.anonymous /.no-id]
+ (|> (do try.monad
+ [path (/.path path)
+ content (/.content (binary.create 0))
+ tar (|> (row.row (#/.Normal [path
+ (instant.from-millis +0)
+ /.none
+ {#/.user {#/.name /.anonymous
+ #/.id /.no-id}
+ #/.group {#/.name /.anonymous
+ #/.id /.no-id}}
+ content]))
+ (format.run /.writer)
+ (<b>.run /.parser))]
+ (wrap (case (row.to-list tar)
+ (^ (list (#/.Normal [_ _ _ actual-ownership _])))
+ (and (text@= (/.from-name /.anonymous)
+ (/.from-name (get@ [#/.user #/.name] actual-ownership)))
+ (n.= (/.from-small /.no-id)
+ (/.from-small (get@ [#/.user #/.id] actual-ownership)))
+ (text@= (/.from-name /.anonymous)
+ (/.from-name (get@ [#/.group #/.name] actual-ownership)))
+ (n.= (/.from-small /.no-id)
+ (/.from-small (get@ [#/.group #/.id] actual-ownership))))
+
+ _
+ false)))
+ (try.default false)))
+ ))))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.with-cover [/.Tar]
+ ($_ _.and
+ (_.cover [/.writer /.parser]
+ (|> row.empty
+ (format.run /.writer)
+ (<b>.run /.parser)
+ (:: try.monad map row.empty?)
+ (try.default false)))
+ ..path
+ ..name
+ ..small
+ ..big
+ (_.with-cover [/.Entry]
+ ($_ _.and
+ ..entry
+ ..mode
+ ..ownership
+ ))
+ ))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 15:39:18 +0000