path: root/stdlib/source/test/lux/data/binary.lux

(.require
 [library
  [lux (.except)
   [ffi (.only)]
   [abstract
    [equivalence (.only Equivalence)]
    ["[0]" monad (.only do)]
    ["[0]" enum]
    [\\specification
     ["$[0]" equivalence]
     ["$[0]" monoid]]]
   [control
    ["<>" parser]
    ["[0]" pipe]
    ["[0]" maybe]
    ["[0]" try (.only Try)]
    ["[0]" exception (.only Exception)]
    [function
     [predicate (.only Predicate)]]]
   [data
    ["[0]" sum]
    ["[0]" bit]
    ["[0]" text (.use "[1]#[0]" equivalence)
     ["%" \\format (.only format)]
     [encoding
      ["[0]" utf8]]]
    [collection
     ["[0]" list (.use "[1]#[0]" functor)]
     ["[0]" sequence]
     ["[0]" set]
     [array
      [\\unsafe (.only)]]]]
   [math
    ["[0]" random (.only Random)]
    [number
     ["n" nat]
     ["[0]" i64]
     ["[0]" int]
     ["[0]" rev]
     ["[0]" frac]]]
   [meta
    ["[0]" symbol]
    ["[0]" type]
    ["[0]" code]
    [macro
     ["^" pattern]]]
   [test
    ["_" property (.only Test)]]]]
 [\\library
  ["[0]" / (.only) (.use "[1]#[0]" equivalence)
   ["!" \\unsafe]
   ["[0]" \\format]
   ["[0]" \\parser]]])

(def !expect
  (template (_ <expectation> <computation>)
    [(when <computation>
       <expectation>
       true

       _
       false)]))

(def segment_size 10)

(def (utf8_conversion_does_not_alter? value)
  (Predicate Text)
  (|> value
      (of utf8.codec encoded)
      (of utf8.codec decoded)
      (pipe.when
        {try.#Success converted}
        (text#= value converted)
        
        {try.#Failure error}
        false)))

(def random_text
  (Random Text)
  (random.only ..utf8_conversion_does_not_alter?
               (random.unicode ..segment_size)))

(def random_symbol
  (Random Symbol)
  (random.and ..random_text ..random_text))

(def location_equivalence
  (Equivalence Location)
  (implementation
   (def (= [expected_module expected_line expected_column]
           [sample_module sample_line sample_column])
     (and (text#= expected_module sample_module)
          (n.= expected_line sample_line)
          (n.= expected_column sample_column)))))

(def random_location
  (Random Location)
  (all random.and
       ..random_text
       random.nat
       random.nat))

(def random_code
  (Random Code)
  (random.rec
   (function (_ again)
     (let [random_sequence (do [! random.monad]
                             [size (of ! each (n.% 2) random.nat)]
                             (random.list size again))]
       (all random.and
            ..random_location
            (is (Random (Code' (Ann Location)))
                (all random.or
                     random.bit
                     random.nat
                     random.int
                     random.rev
                     random.safe_frac
                     ..random_text
                     ..random_symbol
                     random_sequence
                     random_sequence
                     random_sequence
                     )))))))

(def random_type
  (Random Type)
  (let [(open "[0]") random.monad]
    (all random.either
         (in .Nat)
         (in .List)
         (in .Code)
         (in .Type))))

(def size
  Test
  (<| (_.for [\\parser.Size])
      (`` (all _.and
               (,, (with_template [<size> <parser> <format>]
                     [(do [! random.monad]
                        [expected (of ! each (i64.and (i64.mask <size>))
                                      random.nat)]
                        (_.coverage [<size> <parser> <format>]
                          (|> (\\format.result <format> expected)
                              (\\parser.result <parser>)
                              (!expect (^.multi {try.#Success actual}
                                                (n.= (.nat expected)
                                                     (.nat actual)))))))]

                     [\\parser.size_8 \\parser.bits_8 \\format.bits_8]
                     [\\parser.size_16 \\parser.bits_16 \\format.bits_16]
                     [\\parser.size_32 \\parser.bits_32 \\format.bits_32]
                     [\\parser.size_64 \\parser.bits_64 \\format.bits_64]
                     ))))))

(def binary
  Test
  (`` (all _.and
           (,, (with_template [<parser> <format>]
                 [(do [! random.monad]
                    [expected (of ! each (of utf8.codec encoded) (random.ascii ..segment_size))]
                    (_.coverage [<parser> <format>]
                      (|> (\\format.result <format> expected)
                          (\\parser.result <parser>)
                          (!expect (^.multi {try.#Success actual}
                                            (of /.equivalence = expected actual))))))]

                 [\\parser.binary_8 \\format.binary_8]
                 [\\parser.binary_16 \\format.binary_16]
                 [\\parser.binary_32 \\format.binary_32]
                 [\\parser.binary_64 \\format.binary_64]
                 )))))

(def utf8
  Test
  (`` (all _.and
           (,, (with_template [<parser> <format>]
                 [(do [! random.monad]
                    [expected (random.ascii ..segment_size)]
                    (_.coverage [<parser> <format>]
                      (|> (\\format.result <format> expected)
                          (\\parser.result <parser>)
                          (!expect (^.multi {try.#Success actual}
                                            (of text.equivalence = expected actual))))))]

                 [\\parser.utf8_8 \\format.utf8_8]
                 [\\parser.utf8_16 \\format.utf8_16]
                 [\\parser.utf8_32 \\format.utf8_32]
                 [\\parser.utf8_64 \\format.utf8_64]
                 [\\parser.text \\format.text]
                 )))))

(def sequence
  Test
  (`` (all _.and
           (,, (with_template [<parser> <format>]
                 [(do [! random.monad]
                    [expected (random.sequence ..segment_size random.nat)]
                    (_.coverage [<parser> <format>]
                      (|> expected
                          (\\format.result (<format> \\format.nat))
                          (\\parser.result (<parser> \\parser.nat))
                          (!expect (^.multi {try.#Success actual}
                                            (of (sequence.equivalence n.equivalence) = expected actual))))))]

                 [\\parser.sequence_8 \\format.sequence_8]
                 [\\parser.sequence_16 \\format.sequence_16]
                 [\\parser.sequence_32 \\format.sequence_32]
                 [\\parser.sequence_64 \\format.sequence_64]
                 )))))

(def simple
  Test
  (`` (all _.and
           (,, (with_template [<parser> <format> <random> <equivalence>]
                 [(do [! random.monad]
                    [expected <random>]
                    (_.coverage [<parser> <format>]
                      (|> expected
                          (\\format.result <format>)
                          (\\parser.result <parser>)
                          (!expect (^.multi {try.#Success actual}
                                            (of <equivalence> = expected actual))))))]

                 [\\parser.bit \\format.bit random.bit bit.equivalence]
                 [\\parser.nat \\format.nat random.nat n.equivalence]
                 [\\parser.int \\format.int random.int int.equivalence]
                 [\\parser.rev \\format.rev random.rev rev.equivalence]))
           (do [! random.monad]
             [expected random.frac]
             (_.coverage [\\parser.frac \\format.frac]
               (|> expected
                   (\\format.result \\format.frac)
                   (\\parser.result \\parser.frac)
                   (!expect (^.multi {try.#Success actual}
                                     (or (of frac.equivalence = expected actual)
                                         (and (frac.not_a_number? expected)
                                              (frac.not_a_number? actual))))))))
           (do [! random.monad]
             [expected (of ! each (|>> (i64.and (i64.mask \\parser.size_8))
                                       (n.max 2))
                           random.nat)]
             (_.coverage [\\parser.not_a_bit]
               (|> expected
                   (\\format.result \\format.bits_8)
                   (\\parser.result \\parser.bit)
                   (!expect (^.multi {try.#Failure error}
                                     (exception.match? \\parser.not_a_bit error))))))
           )))

(def complex
  Test
  (`` (all _.and
           (,, (with_template [<parser> <format> <random> <equivalence>]
                 [(do [! random.monad]
                    [expected <random>]
                    (_.coverage [<parser> <format>]
                      (|> expected
                          (\\format.result <format>)
                          (\\parser.result <parser>)
                          (!expect (^.multi {try.#Success actual}
                                            (of <equivalence> = expected actual))))))]

                 [\\parser.location \\format.location random_location location_equivalence]
                 [\\parser.code \\format.code random_code code.equivalence]
                 [\\parser.type \\format.type random_type type.equivalence]
                 ))
           (,, (with_template [<parser_coverage> <parser> <coverage_format> <format> <random> <equivalence>]
                 [(do [! random.monad]
                    [expected <random>]
                    (_.coverage [<parser_coverage> <coverage_format>]
                      (|> expected
                          (\\format.result <format>)
                          (\\parser.result <parser>)
                          (!expect (^.multi {try.#Success actual}
                                            (of <equivalence> = expected actual))))))]

                 [\\parser.maybe (\\parser.maybe \\parser.nat) \\format.maybe (\\format.maybe \\format.nat) (random.maybe random.nat) (maybe.equivalence n.equivalence)]
                 [\\parser.list (\\parser.list \\parser.nat) \\format.list (\\format.list \\format.nat) (random.list ..segment_size random.nat) (list.equivalence n.equivalence)]
                 [\\parser.set (\\parser.set n.hash \\parser.nat) \\format.set (\\format.set \\format.nat) (random.set n.hash ..segment_size random.nat) set.equivalence]
                 [\\parser.symbol \\parser.symbol \\format.symbol \\format.symbol ..random_symbol symbol.equivalence]))
           (do [! random.monad]
             [expected (of ! each (list.repeated ..segment_size) random.nat)]
             (_.coverage [\\parser.set_elements_are_not_unique]
               (|> expected
                   (\\format.result (\\format.list \\format.nat))
                   (\\parser.result (\\parser.set n.hash \\parser.nat))
                   (!expect (^.multi {try.#Failure error}
                                     (exception.match? \\parser.set_elements_are_not_unique error))))))
           (do [! random.monad]
             [expected (random.or random.bit random.nat)]
             (_.coverage [\\parser.or \\format.or]
               (|> expected
                   (\\format.result (\\format.or \\format.bit \\format.nat))
                   (\\parser.result (is (\\parser.Parser (Either Bit Nat))
                                        (\\parser.or \\parser.bit \\parser.nat)))
                   (!expect (^.multi {try.#Success actual}
                                     (of (sum.equivalence bit.equivalence n.equivalence) =
                                         expected
                                         actual))))))
           (do [! random.monad]
             [tag (of ! each (|>> (i64.and (i64.mask \\parser.size_8))
                                  (n.max 2))
                      random.nat)
              value random.bit]
             (_.coverage [\\parser.invalid_tag]
               (|> [tag value]
                   (\\format.result (\\format.and \\format.bits_8 \\format.bit))
                   (\\parser.result (is (\\parser.Parser (Either Bit Nat))
                                        (\\parser.or \\parser.bit \\parser.nat)))
                   (!expect (^.multi {try.#Failure error}
                                     (exception.match? \\parser.invalid_tag error))))))
           (do [! random.monad]
             [expected (random.list ..segment_size random.nat)]
             (_.coverage [\\parser.rec \\format.rec \\format.and \\format.any]
               (|> expected
                   (\\format.result (\\format.rec (|>> (\\format.and \\format.nat)
                                                       (\\format.or \\format.any))))
                   (\\parser.result (is (\\parser.Parser (List Nat))
                                        (\\parser.rec
                                         (function (_ again)
                                           (\\parser.or \\parser.any
                                                        (<>.and \\parser.nat
                                                                again))))))
                   (!expect (^.multi {try.#Success actual}
                                     (of (list.equivalence n.equivalence) =
                                         expected
                                         actual))))))
           )))

(def \\parser
  Test
  (<| (_.covering \\parser._)
      (_.for [\\parser.Parser])
      (`` (all _.and
               (_.coverage [\\parser.result \\parser.any
                            \\format.no_op \\format.instance]
                 (|> (\\format.instance \\format.no_op)
                     (\\parser.result \\parser.any)
                     (!expect {try.#Success _})))
               (do [! random.monad]
                 [data (of ! each (of utf8.codec encoded) (random.ascii ..segment_size))]
                 (_.coverage [\\parser.binary_was_not_fully_read]
                   (|> data
                       (\\parser.result \\parser.any)
                       (!expect (^.multi {try.#Failure error}
                                         (exception.match? \\parser.binary_was_not_fully_read error))))))
               (do [! random.monad]
                 [expected (of ! each (of utf8.codec encoded) (random.ascii ..segment_size))]
                 (_.coverage [\\parser.segment \\format.segment \\format.result]
                   (|> expected
                       (\\format.result (\\format.segment ..segment_size))
                       (\\parser.result (\\parser.segment ..segment_size))
                       (!expect (^.multi {try.#Success actual}
                                         (of /.equivalence = expected actual))))))
               (do [! random.monad]
                 [data (of ! each (of utf8.codec encoded) (random.ascii ..segment_size))]
                 (_.coverage [\\parser.end?]
                   (|> data
                       (\\parser.result (do <>.monad
                                          [pre \\parser.end?
                                           _ (\\parser.segment ..segment_size)
                                           post \\parser.end?]
                                          (in (and (not pre)
                                                   post))))
                       (!expect {try.#Success .true}))))
               (do [! random.monad]
                 [to_read (of ! each (n.% (++ ..segment_size)) random.nat)
                  data (of ! each (of utf8.codec encoded) (random.ascii ..segment_size))]
                 (_.coverage [\\parser.Offset \\parser.offset]
                   (|> data
                       (\\parser.result (do <>.monad
                                          [start \\parser.offset
                                           _ (\\parser.segment to_read)
                                           offset \\parser.offset
                                           _ (\\parser.segment (n.- to_read ..segment_size))
                                           nothing_left \\parser.offset]
                                          (in (and (n.= 0 start)
                                                   (n.= to_read offset)
                                                   (n.= ..segment_size nothing_left)))))
                       (!expect {try.#Success .true}))))
               (do [! random.monad]
                 [to_read (of ! each (n.% (++ ..segment_size)) random.nat)
                  data (of ! each (of utf8.codec encoded) (random.ascii ..segment_size))]
                 (_.coverage [\\parser.remaining]
                   (|> data
                       (\\parser.result (do <>.monad
                                          [_ (\\parser.segment to_read)
                                           remaining \\parser.remaining
                                           _ (\\parser.segment (n.- to_read ..segment_size))
                                           nothing_left \\parser.remaining]
                                          (in (and (n.= ..segment_size
                                                        (n.+ to_read remaining))
                                                   (n.= 0 nothing_left)))))
                       (!expect {try.#Success .true}))))
               ..size
               ..binary
               ..utf8
               ..sequence
               ..simple
               ..complex
               ))))

(def equivalence
  (Equivalence \\format.Specification)
  (implementation
   (def (= reference subject)
     (/#= (\\format.instance reference)
          (\\format.instance subject)))))

(def random_specification
  (Random \\format.Specification)
  (of random.monad each \\format.nat random.nat))

(def \\format
  Test
  (<| (_.covering \\format._)
      (_.for [\\format.Mutation \\format.Specification \\format.Format])
      (all _.and
           (_.for [\\format.monoid]
                  ($monoid.spec ..equivalence \\format.monoid ..random_specification))
           )))

(def (succeed result)
  (-> (Try Bit) Bit)
  (when result
    {try.#Failure _}
    false

    {try.#Success output}
    output))

(def .public (random size)
  (-> Nat (Random /.Binary))
  (let [output (/.empty size)]
    (loop (again [idx 0])
      (if (n.< size idx)
        (do random.monad
          [byte random.nat]
          (exec (try.trusted (/.has_8! idx byte output))
            (again (++ idx))))
        (of random.monad in output)))))

(def (throws? exception try)
  (All (_ e a) (-> (Exception e) (Try a) Bit))
  (when try
    {try.#Failure error}
    (exception.match? exception error)

    {try.#Success _}
    false))

(def (binary_io power read write value)
  (-> Nat (-> Nat /.Binary (Try Nat)) (-> Nat Nat /.Binary (Try Any)) Nat Bit)
  (let [bytes (i64.left_shifted power 1)
        binary (/.empty bytes)
        cap (when bytes
              8 (-- 0)
              _ (|> 1 (i64.left_shifted (n.* 8 bytes)) --))
        capped_value (i64.and cap value)]
    (and (..succeed
          (do try.monad
            [pre (read 0 binary)
             _ (write 0 value binary)
             post (read 0 binary)]
            (in (and (n.= 0 pre)
                     (n.= capped_value post)))))
         (throws? /.index_out_of_bounds (read 1 binary))
         (throws? /.index_out_of_bounds (write 1 value binary)))))

(def as_list
  (-> /.Binary (List Nat))
  (/.mix (function (_ head tail)
           {.#Item head tail})
         (list)))

(def test|unsafe
  Test
  (<| (_.covering !._)
      (_.for [!.Binary])
      (do [! random.monad]
        [.let [gen_size (|> random.nat (of ! each (|>> (n.% 100) (n.max 8))))]
         size gen_size
         sample (..random size)
         value random.nat
         .let [gen_idx (|> random.nat (of ! each (n.% size)))]
         offset gen_idx
         length (of ! each (n.% (n.- offset size)) random.nat)]
        (`` (all _.and
                 (_.for [!.=]
                        ($equivalence.spec (function (_ left right)
                                             (!.= left right))
                                           (..random size)))
                 (_.coverage [!.empty]
                   (!.= (!.empty size) (!.empty size)))
                 (_.coverage [!.size]
                   (|> (!.empty size) !.size (n.= size)))
                 (,, (with_template [<power> <bytes/?> <has/?>]
                       [(_.coverage [<bytes/?> <has/?>]
                          (let [bytes (i64.left_shifted <power> 1)
                                binary (!.empty bytes)
                                cap (when bytes
                                      8 (-- 0)
                                      _ (|> 1 (i64.left_shifted (n.* 8 bytes)) --))
                                capped_value (i64.and cap value)
                                
                                pre (<bytes/?> 0 binary)
                                _ (<has/?> 0 value binary)
                                post (<bytes/?> 0 binary)]
                            (and (n.= 0 pre)
                                 (n.= capped_value post))))]

                       [0 !.bits_8 !.has_8!]
                       [1 !.bits_16 !.has_16!]
                       [2 !.bits_32 !.has_32!]
                       [3 !.bits_64 !.has_64!]))
                 (_.coverage [!.slice]
                   (let [random_slice (!.slice offset length sample)
                         idxs (is (List Nat)
                                  (when length
                                    0 (list)
                                    _ (enum.range n.enum 0 (-- length))))
                         reader (function (_ binary idx)
                                  (!.bits_8 idx binary))]
                     (and (n.= length (!.size random_slice))
                          (of (list.equivalence n.equivalence) =
                              (list#each (|>> (n.+ offset) (reader sample)) idxs)
                              (list#each (reader random_slice) idxs)))))
                 (_.coverage [!.copy!]
                   (and (let [it (!.copy! size 0 sample 0 (!.empty size))]
                          (and (not (same? sample it))
                               (!.= sample it)))
                        (let [sample/0 (!.bits_8 0 sample)
                              copy (!.copy! 1 0 sample 0 (!.empty 2))
                              copy/0 (!.bits_8 0 copy)
                              copy/1 (!.bits_8 1 copy)]
                          (and (n.= sample/0 copy/0)
                               (n.= 0 copy/1)))))
                 )))))

(def .public test
  Test
  (<| (_.covering /._)
      (_.for [/.Binary])
      (do [! random.monad]
        [.let [gen_size (|> random.nat (of ! each (|>> (n.% 100) (n.max 8))))]
         size gen_size
         sample (..random size)
         value random.nat
         .let [gen_idx (|> random.nat (of ! each (n.% size)))]
         offset (of ! each (n.max 1) gen_idx)
         length (of ! each (n.% (n.- offset size)) random.nat)]
        (all _.and
             (_.for [/.equivalence]
                    ($equivalence.spec /.equivalence (..random size)))
             (_.for [/.monoid]
                    ($monoid.spec /.equivalence /.monoid (..random size)))
             (_.coverage [/.mix]
               (n.= (of list.mix mix n.+ 0 (..as_list sample))
                    (/.mix n.+ 0 sample)))
             
             (_.coverage [/.empty]
               (of /.equivalence =
                   (/.empty size)
                   (/.empty size)))
             (_.coverage [/.size]
               (|> (/.empty size) /.size (n.= size)))
             (_.for [/.index_out_of_bounds]
                    (all _.and
                         (_.coverage [/.bits_8 /.has_8!]
                           (..binary_io 0 /.bits_8 /.has_8! value))
                         (_.coverage [/.bits_16 /.has_16!]
                           (..binary_io 1 /.bits_16 /.has_16! value))
                         (_.coverage [/.bits_32 /.has_32!]
                           (..binary_io 2 /.bits_32 /.has_32! value))
                         (_.coverage [/.bits_64 /.has_64!]
                           (..binary_io 3 /.bits_64 /.has_64! value))))
             (_.coverage [/.slice]
               (let [random_slice (try.trusted (/.slice offset length sample))
                     idxs (is (List Nat)
                              (when length
                                0 (list)
                                _ (enum.range n.enum 0 (-- length))))
                     reader (function (_ binary idx)
                              (/.bits_8 idx binary))]
                 (and (n.= length (/.size random_slice))
                      (when [(monad.each try.monad (|>> (n.+ offset) (reader sample)) idxs)
                             (monad.each try.monad (reader random_slice) idxs)]
                        [{try.#Success binary_vals} {try.#Success slice_vals}]
                        (of (list.equivalence n.equivalence) = binary_vals slice_vals)

                        _
                        false))))
             (_.coverage [/.slice_out_of_bounds]
               (and (throws? /.slice_out_of_bounds (/.slice size size sample))
                    (let [verdict (throws? /.slice_out_of_bounds (/.slice offset size sample))]
                      (when offset
                        0 (not verdict)
                        _ verdict))))
             (_.coverage [/.after]
               (and (of /.equivalence = sample (/.after 0 sample))
                    (of /.equivalence = (/.empty 0) (/.after size sample))
                    (n.= (n.- offset size) (/.size (/.after offset sample)))
                    (when (list.reversed (..as_list sample))
                      {.#End}
                      false

                      {.#Item head tail}
                      (n.= (list.mix n.+ 0 tail)
                           (/.mix n.+ 0 (/.after 1 sample))))))
             (_.coverage [/.copy!]
               (and (when (/.copy! size 0 sample 0 (/.empty size))
                      {try.#Success output}
                      (and (not (same? sample output))
                           (of /.equivalence = sample output))

                      {try.#Failure _}
                      false)
                    (succeed
                     (do try.monad
                       [sample/0 (/.bits_8 0 sample)
                        copy (/.copy! 1 0 sample 0 (/.empty 2))
                        copy/0 (/.bits_8 0 copy)
                        copy/1 (/.bits_8 1 copy)]
                       (in (and (n.= sample/0 copy/0)
                                (n.= 0 copy/1)))))))
             (_.coverage [/.cannot_copy]
               (and (not (throws? /.cannot_copy
                                  (/.copy! size 0 sample 0 (/.empty size))))
                    (throws? /.cannot_copy
                             (/.copy! (n.+ offset size) 0 sample 0 (/.empty size)))
                    (throws? /.cannot_copy
                             (/.copy! size offset sample 0 (/.empty size)))
                    (throws? /.cannot_copy
                             (/.copy! size 0 sample offset (/.empty size)))))

             ..test|unsafe
             ..\\format
             ..\\parser
             ))))