From 2139e72d8e7c58cb355799d4a8412a0c38fb481c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 28 May 2020 02:18:02 -0400 Subject: Can now parse TAR files. --- documentation/research/Agent.md | 8 + documentation/research/Memory Management.md | 1 + .../research/Optics (eg lenses & prisms).md | 1 + documentation/research/Optimization.md | 1 + documentation/research/math.md | 2 + documentation/research/operating_system.md | 1 + documentation/research/text_editor & ide.md | 1 + stdlib/source/lux/abstract/monad/free.lux | 2 +- stdlib/source/lux/control/parser.lux | 35 +- stdlib/source/lux/control/parser/binary.lux | 62 +-- stdlib/source/lux/data/binary.lux | 4 +- stdlib/source/lux/data/format/tar.lux | 466 +++++++++++++++++---- stdlib/source/lux/time/duration.lux | 12 +- stdlib/source/lux/time/instant.lux | 39 +- .../spec/lux/abstract/functor/contravariant.lux | 31 ++ stdlib/source/test/lux/abstract.lux | 13 +- stdlib/source/test/lux/abstract/equivalence.lux | 20 +- .../test/lux/abstract/functor/contravariant.lux | 10 + stdlib/source/test/lux/abstract/order.lux | 23 +- stdlib/source/test/lux/data.lux | 2 + stdlib/source/test/lux/data/format/tar.lux | 409 ++++++++++++++++++ 21 files changed, 1006 insertions(+), 137 deletions(-) create mode 100644 documentation/research/Agent.md create mode 100644 stdlib/source/spec/lux/abstract/functor/contravariant.lux create mode 100644 stdlib/source/test/lux/abstract/functor/contravariant.lux create mode 100644 stdlib/source/test/lux/data/format/tar.lux diff --git a/documentation/research/Agent.md b/documentation/research/Agent.md new file mode 100644 index 000000000..5f8a7629a --- /dev/null +++ b/documentation/research/Agent.md @@ -0,0 +1,8 @@ +# Reference + +1. [Introduction to Java Agents](https://devolution.tech/introduction-to-java-agents/) +1. https://docs.oracle.com/javase/7/docs/api/java/lang/instrument/package-summary.html +1. http://javabeat.net/introduction-to-java-agents/ +1. https://www.javacodegeeks.com/2015/09/java-agents.html +1. https://github.com/cretz/stackparam + diff --git a/documentation/research/Memory Management.md b/documentation/research/Memory Management.md index 7b326a4a0..8905c6b20 100644 --- a/documentation/research/Memory Management.md +++ b/documentation/research/Memory Management.md @@ -26,6 +26,7 @@ # Reference +1. [Relative Pointers](https://www.gingerbill.org/article/2020/05/17/relative-pointers/) 1. [Scopes Describe Frames: A Uniform Model for Memory Layout in Dynamic Semantics](http://drops.dagstuhl.de/opus/volltexte/2016/6114/) 1. https://uridiumauthor.blogspot.com/2018/06/memory-management.html 1. https://github.com/mtrebi/memory-allocators diff --git a/documentation/research/Optics (eg lenses & prisms).md b/documentation/research/Optics (eg lenses & prisms).md index 493b05c61..6f7acb5ca 100644 --- a/documentation/research/Optics (eg lenses & prisms).md +++ b/documentation/research/Optics (eg lenses & prisms).md @@ -1,5 +1,6 @@ # Reference +1. [Profunctor optics, a categorical update](https://arxiv.org/abs/2001.07488) 1. [On Lawful Lenses](https://blog.statebox.org/on-lawful-lenses-6e18a1e17bdf) 1. https://medium.com/urbint-engineering/haskell-lens-operator-onboarding-a235481e8fac 1. https://fstarlang.github.io/general/2018/01/12/lens-indexed-lenses.html diff --git a/documentation/research/Optimization.md b/documentation/research/Optimization.md index a99b474e3..1fac9193b 100644 --- a/documentation/research/Optimization.md +++ b/documentation/research/Optimization.md @@ -8,6 +8,7 @@ # Reference +1. [A Language for Describing Optimization Strategies](https://arxiv.org/abs/2002.02268) 1. https://docs.google.com/presentation/d/1tpeJZFObkeick4CF-mx0L3CeCgvT15B96aJeRpxEPcE/preview?slide=id.p 1. https://www.quora.com/What-is-the-future-of-optimizing-compilers?share=1 1. https://advancedweb.hu/2016/05/27/jvm_jit_optimization_techniques/ &&& https://advancedweb.hu/2016/06/28/jvm_jit_optimization_techniques_part_2/ diff --git a/documentation/research/math.md b/documentation/research/math.md index 777a3c1d2..91c434dca 100644 --- a/documentation/research/math.md +++ b/documentation/research/math.md @@ -160,6 +160,8 @@ # Geometric Algebra | Clifford Algebra +1. [Siggraph2019 Geometric Algebra](https://www.youtube.com/watch?v=tX4H_ctggYo) +1. [Introduction to Clifford Algebra](https://www.av8n.com/physics/clifford-intro.htm) 1. [An Introduction to Geometric Algebra over R^2](https://bitworking.org/news/ga/2d) 1. [Exterior Product](https://medium.com/@marksaroufim/exterior-product-ecd5836c28ab) 1. [Projective geometric algebra: A modern framework for doing geometry](http://page.math.tu-berlin.de/~gunn/PGA/index.html) diff --git a/documentation/research/operating_system.md b/documentation/research/operating_system.md index c21f82f5b..82943f024 100644 --- a/documentation/research/operating_system.md +++ b/documentation/research/operating_system.md @@ -19,6 +19,7 @@ ## Operating system +1. [CLOSOS: Specication of a Lisp operating system.](http://metamodular.com/lispos.pdf) 1. [CLOSOS: Specication of a Lisp operating system.](http://metamodular.com/closos.pdf) 1. https://medium.com/@jasonyuan/introducing-mercury-os-f4de45a04289 1. http://lsneff.me/why-nebulet/ ||| https://github.com/nebulet/nebulet diff --git a/documentation/research/text_editor & ide.md b/documentation/research/text_editor & ide.md index 3d234605f..ab5f3f4fe 100644 --- a/documentation/research/text_editor & ide.md +++ b/documentation/research/text_editor & ide.md @@ -204,6 +204,7 @@ ## Structured editing +1. [Going beyond regular expressions with structural code search](https://about.sourcegraph.com/blog/going-beyond-regular-expressions-with-structural-code-search) 1. [俺のlisp](https://github.com/illiichi/orenolisp) 1. [豆腐 (Tofu): meaningful code editing](https://gregoor.github.io/tofu/) 1. [Tiled Text](http://www.tiledtext.com/projects/tiledtext) 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 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 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 [ ] @@ -126,23 +136,27 @@ 1 (wrap #1) _ (//.lift (exception.throw ..not-a-bit [value]))))) -(template [ ] +(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 [ ] [(def: #export (Parser Binary) (do //.monad [size (//@map .nat )] - (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 [ ] @@ -160,7 +174,7 @@ (def: #export text ..utf8/64) -(template [ ] +(template [ ] [(def: #export ( 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 ["" 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 [ +(template [ ] - [(def: + [(def: #export + Nat (|> ..octal-size (list.repeat ) - (list@fold n.* 1))) + (list@fold n.* 1) + inc)) (exception: #export ( {value Nat}) (exception.report ["Value" (%.nat value)] - ["Maximum" (%.nat )])) + ["Maximum" (%.nat (dec ))])) - (abstract: + (abstract: #export {} Nat (def: #export ( value) (-> Nat (Try )) - (if (|> value (n.% ) (n.= value)) + (if (|> value (n.% ) (n.= value)) (#try.Success (:abstraction value)) (exception.throw [value]))) - (def: + (def: #export (-> Nat) (|>> :representation)) @@ -89,25 +92,74 @@ (def: (-> Nat ) - (|>> (n.% ) + (|>> (n.% ) :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 .bits/8 + end .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 (.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 (.segment ..big-size) + digits (<>.lift + (encoding.from-utf8 digits)) + end .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 (.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 [ ] - [(abstract: +(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 [ ] + [(abstract: #export {} @@ -168,12 +255,12 @@ (def: #export ( value) (-> (Try )) (if (..ascii? value) - (if (|> value encoding.to-utf8 binary.size (n.< )) + (if (|> value encoding.to-utf8 binary.size (n.<= )) (#try.Success (:abstraction value)) (exception.throw [value])) (exception.throw ..not-ascii [value]))) - (def: + (def: #export (-> ) (|>> :representation)) @@ -186,13 +273,27 @@ encoding.to-utf8 (format.segment padded-size)))) + (def: + (Parser ) + (do <>.monad + [string (.segment ) + end .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)] + ( text))))) + (def: #export (try.assume ( ""))) )] - [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 (.segment ..magic-size) + end .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 [ ] - [(def: - Link-Flag - (:abstraction (char )))] - - ["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 [ (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 [ ] + [(def: + Link-Flag + (:abstraction ))] + + + ) + + (exception: #export (invalid-link-flag {value Nat}) + (exception.report + ["Value" (%.nat value)])) + + (def: link-flag-parser + (Parser Link-Flag) + (do <>.monad + [linkflag .bits/8] + (case (.nat linkflag) + (^template [ ] + (^ ) + (wrap )) + () + + _ + (<>.lift + (exception.throw ..invalid-link-flag [(.nat linkflag)])))))) ) (abstract: #export Mode @@ -308,27 +441,9 @@ Nat - (template [ ] - [(def: #export - Mode - (:abstraction (number.oct )))] - - ["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 [ (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 [ ] + [(def: #export + Mode + (:abstraction (number.oct )))] + + + ) + + (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 (.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 + _ (.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 (.segment (..from-big size)) + content (<>.lift (..content content)) + _ (.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 (.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? .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 [] [(def: @@ -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 + ["" 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 [ ] + [(_.cover [] + (|> (do try.monad + [expected-path (/.path expected-path) + tar (|> (row.row ( expected-path)) + (format.run /.writer) + (.run /.parser))] + (wrap (case (row.to-list tar) + (^ (list ( 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 [ ] + [(_.cover [] + (|> (do try.monad + [expected-path (/.path expected-path) + expected-content (/.content content) + tar (|> (row.row ( [expected-path + expected-moment + /.none + {#/.user {#/.name /.anonymous + #/.id /.no-id} + #/.group {#/.name /.anonymous + #/.id /.no-id}} + expected-content])) + (format.run /.writer) + (.run /.parser))] + (wrap (case (row.to-list tar) + (^ (list ( [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) + (.run /.parser))] + (wrap (case (row.to-list tar) + (^ (list (#/.Normal [_ _ actual-mode _ _]))) + (n.= (/.mode expected-mode) + (/.mode actual-mode)) + + _ + false))) + (try.default false))) + (~~ (template [] + [(_.cover [] + (|> (do try.monad + [path (/.path path) + content (/.content (binary.create 0)) + tar (|> (row.row (#/.Normal [path + (instant.from-millis +0) + + {#/.user {#/.name /.anonymous + #/.id /.no-id} + #/.group {#/.name /.anonymous + #/.id /.no-id}} + content])) + (format.run /.writer) + (.run /.parser))] + (wrap (case (row.to-list tar) + (^ (list (#/.Normal [_ _ actual-mode _ _]))) + (n.= (/.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) + (.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) + (.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) + (.run /.parser) + (:: try.monad map row.empty?) + (try.default false))) + ..path + ..name + ..small + ..big + (_.with-cover [/.Entry] + ($_ _.and + ..entry + ..mode + ..ownership + )) + )))) -- cgit v1.2.3