James Eversole
bf30d5945e
Perhaps the first webserver in Tree Calculus? Sure, it's married to a Haskell IO runtime... but we're managing all of the actual webserver semantics in tricu! This includes a demo Arboricx application server that is capable of storing and serving bundles.
119 lines
2.8 KiB
Plaintext
119 lines
2.8 KiB
Plaintext
!import "base.tri" !Local
|
|
!import "list.tri" !Local
|
|
!import "bytes.tri" !Local
|
|
|
|
errUnexpectedEof = 1
|
|
errUnexpectedBytes = 2
|
|
errUnexpectedByte = 3
|
|
|
|
readU8 = (bytes : matchList
|
|
(err errUnexpectedEof t)
|
|
(h r : ok h r)
|
|
bytes)
|
|
|
|
readBytes_ = y (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 : readBytes_ bs n 0 bs t)
|
|
|
|
unit = t
|
|
|
|
expectBytes_ = y (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 : 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)
|
|
readU16BEBytes = (bs : read2 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_ = y (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 : 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
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Endian / int conversion helpers
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
u16BE = bytes : add (mul 256 (head bytes)) (head (tail bytes))
|
|
|
|
u16LE = bytes : add (mul 256 (head (tail bytes))) (head bytes)
|
|
|
|
readU16BE = bs : bindParser read2 (bytes rest : ok (u16BE bytes) rest) bs
|
|
readU16LE = bs : bindParser read2 (bytes rest : ok (u16LE bytes) rest) bs
|