!import "base.tri" !Local
!import "list.tri" !Local
!import "bytes.tri" !Local

errUnexpectedEof = 1
errUnexpectedBytes = 2
errUnexpectedByte = 3

ok = value rest : pair true (pair value rest)
err = code rest : pair false (pair code rest)

matchResult = (errCase okCase result :
  matchPair
    (tag payload :
      matchPair
        (value rest :
          matchBool
            (okCase value rest)
            (errCase value rest)
            tag)
        payload)
    result)

readU8 = (bytes : matchList
  (err errUnexpectedEof t)
  (h r : ok h r)
  bytes)

readBytesTaken = n bytes : bytesTake n bytes
readBytesRest = n bytes : bytesDrop n bytes
readBytesEnough? = n bytes : equal? (bytesLength (readBytesTaken n bytes)) n

readBytes = (n bytes : matchBool
    (ok (readBytesTaken n bytes) (readBytesRest n bytes))
    (err errUnexpectedEof bytes)
    (readBytesEnough? n bytes))

unit = t

expectBytes = (expected bs :
  matchResult
    (code rest : err code bs)
    (taken rest :
      matchBool
        (ok unit rest)
        (err errUnexpectedBytes bs)
        (bytesEq? taken expected))
    (readBytes (bytesLength expected) bs))

expectU8 = (expected bs :
  matchResult
    (code rest : err code bs)
    (actual rest :
      matchBool
        (ok unit rest)
        (err errUnexpectedByte bs)
        (byteEq? actual expected))
    (readU8 bs))

read2 = (bs : readBytes 2 bs)
read4 = (bs : readBytes 4 bs)

mapResult = (f result :
  matchResult
    (code rest : err code rest)
    (value rest : ok (f value) rest)
    result)

bindResult = (result f :
  matchResult
    (code rest : err code rest)
    (value rest : f value rest)
    result)

readU16BEBytes = (bs : read2 bs)
readU32BEBytes = (bs : read4 bs)