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

errUnexpectedEof = 1
errUnexpectedBytes = 2
errUnexpectedByte = 3

unit = t

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

readBytes_ self bs n i original acc =
  matchList
    (matchBool
      (ok (reverse acc) bs)
      (err errUnexpectedEof original)
      (equal? i n))
    (h r :
      matchBool
        (ok (reverse acc) bs)
        (self r n (succ i) original (pair h acc))
        (equal? i n))
    bs

readBytes = (n bs :
  y readBytes_ bs n 0 bs t)

expectBytes_ self expected bs original =
  matchList
    (ok unit bs)
    (expectedByte expectedRest :
      matchResult
        (code rest : err code original)
        (actual rest :
          matchBool
            (self expectedRest rest original)
            (err errUnexpectedBytes original)
            (equal? actual expectedByte))
        (readU8 bs))
    expected

expectBytes = (expected bs :
  y expectBytes_ expected bs bs)

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

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

-- ---------------------------------------------------------------------------
-- Parser combinators
-- ---------------------------------------------------------------------------

pureParser = value bs : ok value bs
failParser = code bs : err code bs

mapParser = f p bs : mapResult f (p bs)
bindParser = p f bs : bindResult (p bs) f
thenParser = p q bs : bindResult (p bs) (_ : q)

orParser = (p q bs :
  matchResult
    (_ _ : q bs)
    (value rest : ok value rest)
    (p bs))

readWhile_ self pred bs acc =
  matchResult
    (code rest : ok (reverse acc) bs)
    (value rest :
      matchBool
        (self pred rest (pair value acc))
        (ok (reverse acc) (pair value rest))
        (pred value))
    (readU8 bs)

readWhile = pred bs :
  y readWhile_ pred bs t

readUntil = pred :
  readWhile (x : not? (pred x))

readRemaining = bs : ok bs t

peekU8 = (bs :
  matchResult
    (code rest : err code bs)
    (value rest : ok value bs)
    (readU8 bs))

eof? = (bs :
  matchBool
    (ok t bs)
    (err errUnexpectedEof bs)
    (emptyList? bs))

expectAscii = expectBytes