Fully normalized top-level definitions
This commit is contained in:
@@ -1,7 +1,6 @@
|
||||
!import "../base.tri" !Local
|
||||
!import "../list.tri" !Local
|
||||
!import "../bytes.tri" !Local
|
||||
!import "../binary.tri" !Local
|
||||
!import "../prelude.tri" !Local
|
||||
!import "../bytes.tri" !Local
|
||||
!import "../binary.tri" !Local
|
||||
|
||||
arboricxMagic = [(65) (82) (66) (79) (82) (73) (67) (88)]
|
||||
arboricxMajorVersion = [(0) (1)]
|
||||
|
||||
@@ -46,14 +46,72 @@ nodePayloadValid? = (nodePayload :
|
||||
(nodePayloadStem? nodePayload)
|
||||
(nodePayloadFork? nodePayload)))
|
||||
|
||||
nodeU32FromBytes4 = (b0 b1 b2 b3 :
|
||||
u32BEBytesToNat
|
||||
(pair b0
|
||||
(pair b1
|
||||
(pair b2
|
||||
(pair b3 t)))))
|
||||
|
||||
withNodePayloadStemIndex = (nodePayload shortK indexK :
|
||||
matchList
|
||||
(shortK t)
|
||||
(tag r0 :
|
||||
matchList
|
||||
(shortK t)
|
||||
(b0 r1 :
|
||||
matchList
|
||||
(shortK t)
|
||||
(b1 r2 :
|
||||
matchList
|
||||
(shortK t)
|
||||
(b2 r3 :
|
||||
matchList
|
||||
(shortK t)
|
||||
(b3 _ :
|
||||
indexK (nodeU32FromBytes4 b0 b1 b2 b3))
|
||||
r3) r2) r1) r0) nodePayload)
|
||||
|
||||
withNodePayloadForkIndices = (nodePayload shortK indicesK :
|
||||
matchList
|
||||
(shortK t)
|
||||
(tag r0 :
|
||||
matchList
|
||||
(shortK t)
|
||||
(l0 r1 :
|
||||
matchList
|
||||
(shortK t)
|
||||
(l1 r2 :
|
||||
matchList
|
||||
(shortK t)
|
||||
(l2 r3 :
|
||||
matchList
|
||||
(shortK t)
|
||||
(l3 r4 :
|
||||
matchList
|
||||
(shortK t)
|
||||
(r0b r5 :
|
||||
matchList
|
||||
(shortK t)
|
||||
(r1b r6 :
|
||||
matchList
|
||||
(shortK t)
|
||||
(r2b r7 :
|
||||
matchList
|
||||
(shortK t)
|
||||
(r3b _ :
|
||||
indicesK
|
||||
(nodeU32FromBytes4 l0 l1 l2 l3)
|
||||
(nodeU32FromBytes4 r0b r1b r2b r3b)) r7) r6) r5) r4) r3) r2) r1) r0) nodePayload)
|
||||
|
||||
nodePayloadStemChildIndex = (nodePayload :
|
||||
u32BEBytesToNat (bytesTake 4 (bytesDrop 1 nodePayload)))
|
||||
withNodePayloadStemIndex nodePayload (_ : 0) (index : index))
|
||||
|
||||
nodePayloadForkLeftIndex = (nodePayload :
|
||||
u32BEBytesToNat (bytesTake 4 (bytesDrop 1 nodePayload)))
|
||||
withNodePayloadForkIndices nodePayload (_ : 0) (left right : left))
|
||||
|
||||
nodePayloadForkRightIndex = (nodePayload :
|
||||
u32BEBytesToNat (bytesTake 4 (bytesDrop 5 nodePayload)))
|
||||
withNodePayloadForkIndices nodePayload (_ : 0) (left right : right))
|
||||
|
||||
nodeRecordsHaveInvalidPayload? = y (self nodeRecords :
|
||||
matchList
|
||||
@@ -65,31 +123,44 @@ nodeRecordsHaveInvalidPayload? = y (self nodeRecords :
|
||||
nodeRecords)
|
||||
|
||||
nodePayloadChildIndices = (nodePayload :
|
||||
matchBool
|
||||
matchList
|
||||
t
|
||||
(matchBool
|
||||
(pair (nodePayloadStemChildIndex nodePayload) t)
|
||||
(pair (nodePayloadForkLeftIndex nodePayload)
|
||||
(pair (nodePayloadForkRightIndex nodePayload) t))
|
||||
(nodePayloadStem? nodePayload))
|
||||
(nodePayloadLeaf? nodePayload))
|
||||
(tag rest :
|
||||
lazyBool
|
||||
(_ :
|
||||
withNodePayloadStemIndex
|
||||
nodePayload
|
||||
(_ : t)
|
||||
(childIndex : pair childIndex t))
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ :
|
||||
withNodePayloadForkIndices
|
||||
nodePayload
|
||||
(_ : t)
|
||||
(leftIndex rightIndex :
|
||||
pair leftIndex (pair rightIndex t)))
|
||||
(_ : t)
|
||||
(equal? tag nodePayloadForkTag))
|
||||
(equal? tag nodePayloadStemTag))
|
||||
nodePayload)
|
||||
|
||||
-- True iff index n names an element before limit in records.
|
||||
-- For topologically sorted indexed bundles, every child of record i must
|
||||
-- satisfy childIndex < i, so searching only the prefix [0, i) validates both
|
||||
-- bounds and acyclicity.
|
||||
nodeIndexInPrefix? = y (self n records i limit :
|
||||
matchBool
|
||||
nodeIndexInPrefix? = y (self records n i limit :
|
||||
matchList
|
||||
false
|
||||
(matchList
|
||||
false
|
||||
(_ rest :
|
||||
matchBool
|
||||
(_ rest :
|
||||
matchBool
|
||||
false
|
||||
(matchBool
|
||||
true
|
||||
(self n rest (succ i) limit)
|
||||
(self rest n (succ i) limit)
|
||||
(equal? i n))
|
||||
records)
|
||||
(equal? i limit))
|
||||
(equal? i limit))
|
||||
records)
|
||||
|
||||
nodeChildIndicesInPrefix? = y (self childIndices records limit :
|
||||
matchList
|
||||
@@ -98,7 +169,7 @@ nodeChildIndicesInPrefix? = y (self childIndices records limit :
|
||||
matchBool
|
||||
(self rest records limit)
|
||||
false
|
||||
(nodeIndexInPrefix? childIndex records 0 limit))
|
||||
(nodeIndexInPrefix? records childIndex 0 limit))
|
||||
childIndices)
|
||||
|
||||
nodePayloadIndicesValid? = (nodePayload i records :
|
||||
@@ -178,31 +249,124 @@ nodesSectionRecords = (nodesSection :
|
||||
(_ nodeRecords : nodeRecords)
|
||||
nodesSection)
|
||||
|
||||
nodePayloadToTreeWith = (self nodeRecords nodePayload :
|
||||
matchBool
|
||||
(ok t t)
|
||||
(matchBool
|
||||
(bindResult (self (nodePayloadStemChildIndex nodePayload) nodeRecords)
|
||||
(child _ : ok (t child) t))
|
||||
(bindResult (self (nodePayloadForkLeftIndex nodePayload) nodeRecords)
|
||||
(left _ :
|
||||
bindResult (self (nodePayloadForkRightIndex nodePayload) nodeRecords)
|
||||
(right _ : ok (pair left right) t)))
|
||||
(nodePayloadStem? nodePayload))
|
||||
(nodePayloadLeaf? nodePayload))
|
||||
nodeBuiltTreeIndex = (entry :
|
||||
matchPair
|
||||
(index _ : index)
|
||||
entry)
|
||||
|
||||
nodeIndexToTree = y (self nodeIndex nodeRecords :
|
||||
(nodePayload :
|
||||
matchBool
|
||||
(nodePayloadToTreeWith self nodeRecords nodePayload)
|
||||
(err errMissingNode t)
|
||||
(not? (equal? nodePayload t)))
|
||||
(nth nodeIndex nodeRecords))
|
||||
nodeBuiltTreeValue = (entry :
|
||||
matchPair
|
||||
(_ tree : tree)
|
||||
entry)
|
||||
|
||||
nodeTreeByIndex_ = (self builtTrees targetIndex :
|
||||
lazyList
|
||||
(_ : err errMissingNode t)
|
||||
(entry rest :
|
||||
lazyBool
|
||||
(_ : ok (nodeBuiltTreeValue entry) t)
|
||||
(_ : self rest targetIndex)
|
||||
(equal? (nodeBuiltTreeIndex entry) targetIndex))
|
||||
builtTrees)
|
||||
|
||||
nodeTreeByIndex = (builtTrees targetIndex :
|
||||
y nodeTreeByIndex_ builtTrees targetIndex)
|
||||
|
||||
nodePayloadToTreeFromBuilt = (builtTrees nodePayload :
|
||||
matchList
|
||||
(err errInvalidNodePayload t)
|
||||
(tag rest :
|
||||
lazyBool
|
||||
(_ : ok t t)
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ :
|
||||
withNodePayloadStemIndex
|
||||
nodePayload
|
||||
(_ : err errInvalidNodePayload t)
|
||||
(childIndex :
|
||||
lazyResult
|
||||
(code after : err code after)
|
||||
(child _ : ok (t child) t)
|
||||
(nodeTreeByIndex builtTrees childIndex)))
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ :
|
||||
withNodePayloadForkIndices
|
||||
nodePayload
|
||||
(_ : err errInvalidNodePayload t)
|
||||
(leftIndex rightIndex :
|
||||
lazyResult
|
||||
(code after : err code after)
|
||||
(left _ :
|
||||
lazyResult
|
||||
(code after : err code after)
|
||||
(right _ : ok (pair left right) t)
|
||||
(nodeTreeByIndex builtTrees rightIndex))
|
||||
(nodeTreeByIndex builtTrees leftIndex)))
|
||||
(_ : err errInvalidNodePayload t)
|
||||
(equal? tag nodePayloadForkTag))
|
||||
(equal? tag nodePayloadStemTag))
|
||||
(equal? tag 0))
|
||||
nodePayload)
|
||||
|
||||
nodeBuildState = (targetIndex i builtTrees :
|
||||
pair targetIndex (pair i builtTrees))
|
||||
|
||||
nodeBuildStateTargetIndex = (state :
|
||||
matchPair
|
||||
(targetIndex _ : targetIndex)
|
||||
state)
|
||||
|
||||
nodeBuildStateI = (state :
|
||||
matchPair
|
||||
(_ rest :
|
||||
matchPair
|
||||
(i _ : i)
|
||||
rest)
|
||||
state)
|
||||
|
||||
nodeBuildStateBuiltTrees = (state :
|
||||
matchPair
|
||||
(_ rest :
|
||||
matchPair
|
||||
(_ builtTrees : builtTrees)
|
||||
rest)
|
||||
state)
|
||||
|
||||
nodeIndexToTree_ = (self remainingRecords state :
|
||||
((nodeIndex :
|
||||
((i :
|
||||
((builtTrees :
|
||||
lazyList
|
||||
(_ : err errMissingNode t)
|
||||
(nodePayload rest :
|
||||
lazyResult
|
||||
(code after : err code after)
|
||||
(tree _ :
|
||||
lazyBool
|
||||
(_ : ok tree t)
|
||||
(_ :
|
||||
self
|
||||
rest
|
||||
(nodeBuildState
|
||||
nodeIndex
|
||||
(succ i)
|
||||
(pair (pair i tree) builtTrees)))
|
||||
(equal? i nodeIndex))
|
||||
(nodePayloadToTreeFromBuilt builtTrees nodePayload))
|
||||
remainingRecords)
|
||||
(nodeBuildStateBuiltTrees state)))
|
||||
(nodeBuildStateI state)))
|
||||
(nodeBuildStateTargetIndex state)))
|
||||
|
||||
nodeIndexToTree = (nodeRecords nodeIndex :
|
||||
y nodeIndexToTree_ nodeRecords (nodeBuildState nodeIndex 0 t))
|
||||
|
||||
readArboricxTreeFromIndex = (rootIndexBytes bs :
|
||||
bindResult (readArboricxNodesSection bs)
|
||||
(nodesSection afterContainer :
|
||||
bindResult (nodeIndexToTree (u32BEBytesToNat rootIndexBytes) (nodesSectionRecords nodesSection))
|
||||
bindResult (nodeIndexToTree (nodesSectionRecords nodesSection) (u32BEBytesToNat rootIndexBytes))
|
||||
(tree _ : ok tree afterContainer)))
|
||||
|
||||
readArboricxExecutableFromIndex = readArboricxTreeFromIndex
|
||||
|
||||
@@ -9,23 +9,40 @@
|
||||
|
||||
pathJoin = a b : append a (append "/" b)
|
||||
|
||||
objectDir = root shard : pathJoin (pathJoin root "objects") shard
|
||||
objectDir = root shard :
|
||||
pathJoin (pathJoin root "objects") shard
|
||||
|
||||
hashShard = (hash :
|
||||
matchList
|
||||
t
|
||||
(h0 r0 :
|
||||
matchList
|
||||
(pair h0 t)
|
||||
(h1 r1 :
|
||||
matchList
|
||||
(pair h0 (pair h1 t))
|
||||
(h2 _ :
|
||||
pair h0 (pair h1 (pair h2 t)))
|
||||
r1)
|
||||
r0)
|
||||
hash)
|
||||
|
||||
bundleObjectPath = (root hash :
|
||||
((shard : pathJoin (objectDir root shard) (append hash ".arboricx"))
|
||||
(take 3 hash)))
|
||||
|
||||
--bundleTmpPath = (root hash time :
|
||||
-- pathJoin (pathJoin root "tmp") (append hash (append "." (append (showNumber time) ".tmp"))))
|
||||
pathJoin
|
||||
(objectDir root (hashShard hash))
|
||||
(append hash ".arboricx"))
|
||||
|
||||
bundleTmpPath = (root hash time :
|
||||
pathJoin (pathJoin root "tmp") (append hash ".tmp"))
|
||||
pathJoin
|
||||
(pathJoin root "tmp")
|
||||
(append hash ".tmp"))
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- Store initialization
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
ensureDir = path : void (createDirectory path)
|
||||
ensureDir = path :
|
||||
void (createDirectory path)
|
||||
|
||||
ensureStore = (root :
|
||||
foldl
|
||||
@@ -59,7 +76,7 @@ putBundleWithHash = (root bundleBytes time hash :
|
||||
root
|
||||
bundleBytes
|
||||
hash
|
||||
(take 3 hash)
|
||||
(hashShard hash)
|
||||
(bundleTmpPath root hash time)
|
||||
(bundleObjectPath root hash))
|
||||
|
||||
@@ -85,56 +102,106 @@ getBundleByHash = (root hash :
|
||||
(errMsg : pure (err errMsg t))
|
||||
(bytes : pure (ok bytes t)))
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- Route prefix helper
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
stripPrefix_ = (self input prefix :
|
||||
lazyList
|
||||
(_ :
|
||||
lazyList
|
||||
(_ : just t)
|
||||
(_ _ : nothing)
|
||||
prefix)
|
||||
(ih ir :
|
||||
lazyList
|
||||
(_ : just input)
|
||||
(ph pr :
|
||||
lazyBool
|
||||
(_ : self ir pr)
|
||||
(_ : nothing)
|
||||
(equal? ih ph))
|
||||
prefix)
|
||||
input)
|
||||
|
||||
stripPrefix = (prefix input :
|
||||
y stripPrefix_ input prefix)
|
||||
|
||||
bundleHashPrefix = "/_arboricx/bundle/hash/"
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- Registry routes
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
healthRoute = (method target :
|
||||
matchBool
|
||||
(pure (okResponse "OK\n"))
|
||||
(pure notFoundResponse)
|
||||
(and? (equal? method "GET") (equal? target "/_arboricx/health")))
|
||||
lazyBool
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : pure (okResponse "OK\n"))
|
||||
(_ : pure notFoundResponse)
|
||||
(equal? target "/_arboricx/health"))
|
||||
(_ : pure notFoundResponse)
|
||||
(equal? method "GET"))
|
||||
|
||||
putBundleRoute = (root method target body :
|
||||
matchBool
|
||||
(bind (putBundle root body) (result :
|
||||
matchResult
|
||||
(err _ : pure (badRequestResponse (append "Upload failed: " err)))
|
||||
(hash _ : pure (createdResponse hash))
|
||||
result))
|
||||
(pure notFoundResponse)
|
||||
(and? (equal? method "POST") (equal? target "/_arboricx/bundles")))
|
||||
lazyBool
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ :
|
||||
bind (putBundle root body) (result :
|
||||
matchResult
|
||||
(err _ : pure (badRequestResponse (append "Upload failed: " err)))
|
||||
(hash _ : pure (createdResponse hash))
|
||||
result))
|
||||
(_ : pure notFoundResponse)
|
||||
(equal? target "/_arboricx/bundles"))
|
||||
(_ : pure notFoundResponse)
|
||||
(equal? method "POST"))
|
||||
|
||||
getBundleRoute = (root method target :
|
||||
matchBool
|
||||
((hash :
|
||||
bind (getBundleByHash root hash) (result :
|
||||
matchResult
|
||||
(errMsg _ : pure (errorResponse 404 errMsg))
|
||||
(bytes _ : pure (response 200 "application/vnd.arboricx.bundle" bytes))
|
||||
result))
|
||||
(drop 23 target))
|
||||
(pure notFoundResponse)
|
||||
(and? (equal? method "GET") (startsWith? "/_arboricx/bundle/hash/" target)))
|
||||
lazyBool
|
||||
(_ :
|
||||
lazyMaybe
|
||||
(_ : pure notFoundResponse)
|
||||
(hash :
|
||||
bind (getBundleByHash root hash) (result :
|
||||
matchResult
|
||||
(errMsg _ : pure (errorResponse 404 errMsg))
|
||||
(bytes _ : pure (response 200 "application/vnd.arboricx.bundle" bytes))
|
||||
result))
|
||||
(stripPrefix bundleHashPrefix target))
|
||||
(_ : pure notFoundResponse)
|
||||
(equal? method "GET"))
|
||||
|
||||
arboricxRouter = (root method target headers body :
|
||||
matchBool
|
||||
(getBundleRoute root method target)
|
||||
(matchBool
|
||||
(putBundleRoute root method target body)
|
||||
(matchBool
|
||||
(healthRoute method target)
|
||||
(pure notFoundResponse)
|
||||
(and? (equal? method "GET") (equal? target "/_arboricx/health")))
|
||||
(and? (equal? method "POST") (equal? target "/_arboricx/bundles")))
|
||||
(and? (equal? method "GET") (startsWith? "/_arboricx/bundle/hash/" target)))
|
||||
lazyBool
|
||||
(_ :
|
||||
lazyMaybe
|
||||
(_ : healthRoute method target)
|
||||
(hash :
|
||||
bind (getBundleByHash root hash) (result :
|
||||
matchResult
|
||||
(errMsg _ : pure (errorResponse 404 errMsg))
|
||||
(bytes _ : pure (response 200 "application/vnd.arboricx.bundle" bytes))
|
||||
result))
|
||||
(stripPrefix bundleHashPrefix target))
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : putBundleRoute root method target body)
|
||||
(_ : pure notFoundResponse)
|
||||
(equal? method "POST"))
|
||||
(equal? method "GET"))
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- Server entrypoint
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
arboricxHandler = (root client peer :
|
||||
httpHandlerIO (arboricxRouter root) client peer)
|
||||
httpHandlerIO
|
||||
(method target headers body :
|
||||
arboricxRouter root method target headers body)
|
||||
client
|
||||
peer)
|
||||
|
||||
arboricxServer = (root addr port :
|
||||
onResult_ (listenSocket addr port 128)
|
||||
|
||||
@@ -56,7 +56,6 @@ expectU8 = (expected bs :
|
||||
|
||||
read2 = (bs : readBytes 2 bs)
|
||||
read4 = (bs : readBytes 4 bs)
|
||||
readU16BEBytes = (bs : read2 bs)
|
||||
readU32BEBytes = (bs : read4 bs)
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
@@ -105,14 +104,3 @@ eof? = (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
|
||||
|
||||
48
lib/http.tri
48
lib/http.tri
@@ -3,7 +3,7 @@
|
||||
!import "socket.tri" !Local
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- 1. Constants
|
||||
-- Constants
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
maxHeaderBytes = 65536
|
||||
@@ -14,39 +14,7 @@ crlf = pair 13 (pair 10 t)
|
||||
crlfcrlf = pair 13 (pair 10 (pair 13 (pair 10 t)))
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- 2. Lazy eliminators
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
lazyBool = (thenK elseK cond :
|
||||
((chosen : chosen t)
|
||||
(matchBool
|
||||
thenK
|
||||
elseK
|
||||
cond)))
|
||||
|
||||
lazyList = (nilK consK xs :
|
||||
((chosen : chosen t)
|
||||
(matchList
|
||||
nilK
|
||||
(h r : (_ : consK h r))
|
||||
xs)))
|
||||
|
||||
lazyMaybe = (noneK someK m :
|
||||
((chosen : chosen t)
|
||||
(matchMaybe
|
||||
noneK
|
||||
(x : (_ : someK x))
|
||||
m)))
|
||||
|
||||
lazyResult = (errK okK result :
|
||||
((chosen : chosen t)
|
||||
(matchResult
|
||||
(code rest : (_ : errK code rest))
|
||||
(value rest : (_ : okK value rest))
|
||||
result)))
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- 3. Small byte/list helpers
|
||||
-- Small byte/list helpers
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
chomp = (xs :
|
||||
@@ -60,7 +28,7 @@ chomp = (xs :
|
||||
(reverse xs))
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- 4. Response construction
|
||||
-- Response construction
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
statusPhrase = (code :
|
||||
@@ -184,7 +152,7 @@ responseForMethod = (method resp :
|
||||
(equal? method "HEAD"))
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- 5. Header receive / framing
|
||||
-- Header receive / framing
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
recvUntilMax_ = (y (self sock pattern maxBytes acc accLen :
|
||||
@@ -221,7 +189,7 @@ recvHeaders = (sock :
|
||||
recvUntilMax sock crlfcrlf maxHeaderBytes)
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- 6. Request line parsing
|
||||
-- Request line parsing
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
readLineBytes_ = (y (self bs acc :
|
||||
@@ -277,7 +245,7 @@ parseRequestLine = (bs :
|
||||
(readLineBytes bs)))
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- 7. Header parsing
|
||||
-- Header parsing
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
|
||||
@@ -429,7 +397,7 @@ parseHeaders = (bs :
|
||||
y parseHeaders_ bs t t t false true)
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- 8. Content-Length parsing
|
||||
-- Content-Length parsing
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
bit0? = (x :
|
||||
@@ -544,7 +512,7 @@ contentLength = (headers :
|
||||
y contentLength_ headers)
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- 9. Body reading
|
||||
-- Body reading
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
consumeAvailable_ = (y (self bytes remaining acc :
|
||||
|
||||
30
lib/lazy.tri
Normal file
30
lib/lazy.tri
Normal file
@@ -0,0 +1,30 @@
|
||||
!import "base.tri" !Local
|
||||
!import "list.tri" !Local
|
||||
|
||||
lazyBool = (thenK elseK cond :
|
||||
((chosen : chosen t)
|
||||
(matchBool
|
||||
thenK
|
||||
elseK
|
||||
cond)))
|
||||
|
||||
lazyList = (nilK consK xs :
|
||||
((chosen : chosen t)
|
||||
(matchList
|
||||
nilK
|
||||
(h r : (_ : consK h r))
|
||||
xs)))
|
||||
|
||||
lazyMaybe = (noneK someK m :
|
||||
((chosen : chosen t)
|
||||
(matchMaybe
|
||||
noneK
|
||||
(x : (_ : someK x))
|
||||
m)))
|
||||
|
||||
lazyResult = (errK okK result :
|
||||
((chosen : chosen t)
|
||||
(matchResult
|
||||
(code rest : (_ : errK code rest))
|
||||
(value rest : (_ : okK value rest))
|
||||
result)))
|
||||
@@ -3,4 +3,5 @@
|
||||
!import "base.tri" !Local
|
||||
!import "list.tri" !Local
|
||||
!import "bytes.tri" !Local
|
||||
!import "lazy.tri" !Local
|
||||
!import "conversions.tri" !Local
|
||||
|
||||
Reference in New Issue
Block a user