Can now parse TAR files.

1 files changed, 409 insertions, 0 deletions

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
+                  ))
+            ))))