Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 306 lines (301 sloc) 10.927 kB
0dbb28c @mdirolf WIP: factoring out BSON and MongoDoc modules
authored
1 (* Copyright 2008 Michael Dirolf (mike@dirolf.com). All Rights Reserved. *)
5b223e4 @mdirolf rename value -> bson. document. toString instead of print
authored
2
3 (**
4 * Utilities for dealing with the BSON data format.
5 *)
0dbb28c @mdirolf WIP: factoring out BSON and MongoDoc modules
authored
6 signature BSON =
7 sig
5b223e4 @mdirolf rename value -> bson. document. toString instead of print
authored
8 (**
9 * A BSON "object".
10 *)
69dc8fc @mdirolf make bson an equality type. fixes for stupid compilation errors
authored
11 eqtype bson
5b223e4 @mdirolf rename value -> bson. document. toString instead of print
authored
12 (*
13 * Create a "hex dump" representation of a bson object.
14 *
15 * @param bson a bson document
16 * @return a string representation of the document
17 *)
18 val toString: bson -> string
19 (*
20 * Convert a Mongo document to a bson object.
21 *
22 * @param document a Mongo document
23 * @return a bson object corresponding to that document
24 *)
25 val fromDocument: MongoDoc.document -> bson
26 (*
27 * Convert a bson object to a Mongo document.
28 *
29 * @param bson a bson object
30 * @return a Mongo document corresponding to that object
31 *)
32 val toDocument: bson -> MongoDoc.document
1a4253a @mdirolf add size function
authored
33 (*
34 * Get the size (in bytes) of a bson object.
35 *
36 * @param bson a bson object
37 * @return the size of the object in bytes
38 *)
39 val size: bson -> int
0dbb28c @mdirolf WIP: factoring out BSON and MongoDoc modules
authored
40 end
de34e64 WIP: switching machines
Mike Dirolf authored
41
42 structure BSON :> BSON =
43 struct
44 structure MD = MongoDoc
5b223e4 @mdirolf rename value -> bson. document. toString instead of print
authored
45 type bson = Word8.word list
6409f98 @mdirolf complete the refactoring
authored
46 exception InternalError
8213661 @mdirolf towards toDocument
authored
47 exception NotImplementedError
b0c3d80 @mdirolf clean up zero constants
authored
48 val zeroByte = Word8.fromInt 0
f1634e7 @mdirolf cleaner
authored
49 fun makeList 0 element = nil
3dd23d2 @mdirolf cleaner
authored
50 | makeList n element = element::makeList (n-1) element
de34e64 WIP: switching machines
Mike Dirolf authored
51 fun padLeft list count padding =
52 let
53 val len = length list
54 in
55 if len >= count then
56 List.take(list, count)
57 else
58 (makeList (count - len) padding) @ list
59 end
5b223e4 @mdirolf rename value -> bson. document. toString instead of print
authored
60 fun toString bson =
de34e64 WIP: switching machines
Mike Dirolf authored
61 let
62 fun padStringLeft string count char =
63 String.implode (padLeft (String.explode string) count char)
64 fun printHelper lineNumber bson =
65 case bson of
69dc8fc @mdirolf make bson an equality type. fixes for stupid compilation errors
authored
66 nil => "\n"
de34e64 WIP: switching machines
Mike Dirolf authored
67 | hd::tl =>
5b223e4 @mdirolf rename value -> bson. document. toString instead of print
authored
68 let
69 val start =
70 if lineNumber mod 8 = 0 then
69dc8fc @mdirolf make bson an equality type. fixes for stupid compilation errors
authored
71 (if lineNumber <> 0 then "\n" else "") ^
5b223e4 @mdirolf rename value -> bson. document. toString instead of print
authored
72 ((padStringLeft (Int.toString lineNumber) 4 #" ") ^ ": ")
73 else
74 " "
75 in
d6c53d2 @mdirolf fix for toString
authored
76 start ^
69dc8fc @mdirolf make bson an equality type. fixes for stupid compilation errors
authored
77 padStringLeft (Word8.toString hd) 2 #"0" ^
5b223e4 @mdirolf rename value -> bson. document. toString instead of print
authored
78 printHelper (lineNumber + 1) tl
79 end
de34e64 WIP: switching machines
Mike Dirolf authored
80 in
81 printHelper 0 bson
82 end
a0aec26 @mdirolf use constants instead of awkward string mapper. start hydration
authored
83
84 (* Some constants. *)
85 val EOO = Word8.fromInt 0
86 val NUMBER = Word8.fromInt 1
87 val STRING = Word8.fromInt 2
88 val OBJECT = Word8.fromInt 3
89 val ARRAY = Word8.fromInt 4
90 val BINARY = Word8.fromInt 5
91 val UNDEFINED = Word8.fromInt 6
92 val OID = Word8.fromInt 7
93 val BOOLEAN = Word8.fromInt 8
94 val DATE = Word8.fromInt 9
95 val NULL = Word8.fromInt 10
96 val REGEX = Word8.fromInt 11
97 val REF = Word8.fromInt 12
98 val CODE = Word8.fromInt 13
99 val SYMBOL = Word8.fromInt 14
100 val CODE_W_SCOPE = Word8.fromInt 15
101 val NUMBER_INT = Word8.fromInt 16
102
de34e64 WIP: switching machines
Mike Dirolf authored
103 fun elementType element =
104 case element of
a0aec26 @mdirolf use constants instead of awkward string mapper. start hydration
authored
105 MD.Document _ => OBJECT
106 | MD.Array _ => ARRAY
107 | MD.Bool _ => BOOLEAN
108 | MD.Int _ => NUMBER_INT
109 | MD.Float _ => NUMBER
110 | MD.String _ => STRING
de34e64 WIP: switching machines
Mike Dirolf authored
111 (* TODO this ought to be UTF-8 encoded *)
112 fun toCString s =
113 let
8213661 @mdirolf towards toDocument
authored
114 val s' = List.map Byte.charToByte (explode s)
de34e64 WIP: switching machines
Mike Dirolf authored
115 in
b0c3d80 @mdirolf clean up zero constants
authored
116 List.concat [s', [zeroByte]]
de34e64 WIP: switching machines
Mike Dirolf authored
117 end
7a37d06 @mdirolf fix for negative ints
authored
118 fun toList vec = Word8Vector.foldr (op ::) [] vec
a3e0807 @mdirolf ints are little endian too
authored
119 fun intToWord8List int =
de34e64 WIP: switching machines
Mike Dirolf authored
120 let
7a37d06 @mdirolf fix for negative ints
authored
121 val array = Word8Array.array (4, zeroByte)
de34e64 WIP: switching machines
Mike Dirolf authored
122 in
7a37d06 @mdirolf fix for negative ints
authored
123 PackWord32Little.update (array, 0, (Word32.fromInt int));
124 toList (Word8Array.vector array)
de34e64 WIP: switching machines
Mike Dirolf authored
125 end
126 fun elementToBSON (name, element) =
127 let
128 val tp = elementType element
129 val name = toCString name
130 fun listAsArray list =
131 let
132 fun helper l index =
133 case l of
134 nil => nil
3dd23d2 @mdirolf cleaner
authored
135 | hd::tl => (Int.toString index, hd)::helper tl (index + 1)
de34e64 WIP: switching machines
Mike Dirolf authored
136 in
137 helper list 0
138 end
139 val element = case element of
adea047 @mdirolf A Document now carries around a *real* document
authored
140 MD.Document d => fromDocument d
6409f98 @mdirolf complete the refactoring
authored
141 | MD.Array a => fromDocument (MD.fromList (listAsArray a))
b0c3d80 @mdirolf clean up zero constants
authored
142 | MD.Bool b => if b then [Word8.fromInt 1] else [zeroByte]
6409f98 @mdirolf complete the refactoring
authored
143 | MD.Int i => intToWord8List i
144 | MD.Float f => toList (PackRealLittle.toBytes f)
145 | MD.String s =>
de34e64 WIP: switching machines
Mike Dirolf authored
146 let
147 val cs = toCString s
148 in
149 intToWord8List (length cs) @ cs
150 end
151 in
152 (tp::name) @ element
153 end
154 and fromDocument document =
155 let
1a51a9c @mdirolf don't need to worry about dups here, part of MongoDoc contract now
authored
156 val document' = MD.toList document
157 val objectData = List.concat(List.map elementToBSON document')
c0aa823 @mdirolf it should
authored
158 (* overhead for the size bytes and eoo *)
de34e64 WIP: switching machines
Mike Dirolf authored
159 val overhead = 5
160 val size = intToWord8List (length objectData + overhead)
161 in
b0c3d80 @mdirolf clean up zero constants
authored
162 List.concat [size, objectData, [zeroByte]]
de34e64 WIP: switching machines
Mike Dirolf authored
163 end
8213661 @mdirolf towards toDocument
authored
164 fun assert bool = if bool then () else raise InternalError
165 fun getInt bytes =
166 let
167 val firstFourBytes = List.take (bytes, 4) handle Subscript => raise InternalError
3e1dfc2 @mdirolf use the signed version of toInt
authored
168 val int = Word32.toIntX (PackWord32Little.subVecX (Word8Vector.fromList firstFourBytes, 0))
8213661 @mdirolf towards toDocument
authored
169 val remainder = List.drop (bytes, 4) handle Subscript => raise InternalError
170 in
171 (int, remainder)
172 end
173 fun getByte bytes =
174 let
175 val byte = hd bytes handle Empty => raise InternalError
176 val remainder = tl bytes handle Empty => raise InternalError
177 in
178 (byte, remainder)
179 end
180 (* TODO this NEEDS to handle UTF-8 *)
181 fun getCString bytes =
182 let
dc02d0b @mdirolf cleaner
authored
183 val (byte, remainder) = getByte bytes
184 in
185 if byte = zeroByte then
186 ("", remainder)
187 else
8213661 @mdirolf towards toDocument
authored
188 let
dc02d0b @mdirolf cleaner
authored
189 val (string, remainder') = getCString remainder
8213661 @mdirolf towards toDocument
authored
190 in
dc02d0b @mdirolf cleaner
authored
191 (String.str (Byte.byteToChar byte) ^ string, remainder')
8213661 @mdirolf towards toDocument
authored
192 end
193 end
5b63ba7 @mdirolf factor out getDocument
authored
194 fun getReal bytes =
195 let
196 val firstEightBytes = List.take (bytes, 8) handle Subscript => raise InternalError
197 val real = PackRealLittle.fromBytes (Word8Vector.fromList firstEightBytes)
198 val remainder = List.drop (bytes, 8) handle Subscript => raise InternalError
199 in
200 (real, remainder)
201 end
202 fun unwrapObject bson =
203 let
204 val (size, remainder) = getInt bson
205 val elements = List.take (remainder, size - 5) handle Subscript => raise InternalError
206 val remainder' = List.drop (remainder, size - 5) handle Subscript => raise InternalError
207 in
208 (assert (hd remainder' = zeroByte);
209 (elements, tl remainder')) handle Empty => raise InternalError
210 end
196cbc2 @mdirolf dehydrate arrays
authored
211 fun arrayFromDocument document =
212 let
213 fun helper document index =
214 let
215 val key = Int.toString index
216 in
20a2b71 @mdirolf use the MD alias for MongoDoc
authored
217 if MD.hasKey document key then
196cbc2 @mdirolf dehydrate arrays
authored
218 let
20a2b71 @mdirolf use the MD alias for MongoDoc
authored
219 val value = valOf (MD.valueForKey document key)
220 val document' = MD.removeKey document key
196cbc2 @mdirolf dehydrate arrays
authored
221 in
222 value::helper document' (index + 1)
223 end
224 else
225 nil
226 end
227 in
20a2b71 @mdirolf use the MD alias for MongoDoc
authored
228 MD.Array (helper document 0)
196cbc2 @mdirolf dehydrate arrays
authored
229 end
230 (* TODO this is hideous. couldn't get a case to work for some reason. must be something better than this... *)
a0aec26 @mdirolf use constants instead of awkward string mapper. start hydration
authored
231 fun hydrateValue elementType bytes =
dff64b5 @mdirolf ghetto...
authored
232 if elementType = NUMBER_INT then
a0aec26 @mdirolf use constants instead of awkward string mapper. start hydration
authored
233 let
234 val (int, remainder) = getInt bytes
235 in
20a2b71 @mdirolf use the MD alias for MongoDoc
authored
236 (MD.Int int, remainder)
a0aec26 @mdirolf use constants instead of awkward string mapper. start hydration
authored
237 end
dff64b5 @mdirolf ghetto...
authored
238 else
239 if elementType = BOOLEAN then
240 let
241 val (bool, remainder) = getByte bytes
242 in
243 if bool = zeroByte then
20a2b71 @mdirolf use the MD alias for MongoDoc
authored
244 (MD.Bool false, remainder)
dff64b5 @mdirolf ghetto...
authored
245 else
20a2b71 @mdirolf use the MD alias for MongoDoc
authored
246 (MD.Bool true, remainder)
dff64b5 @mdirolf ghetto...
authored
247 end
248 else
5b63ba7 @mdirolf factor out getDocument
authored
249 if elementType = NUMBER then
250 let
251 val (real, remainder) = getReal bytes
252 in
20a2b71 @mdirolf use the MD alias for MongoDoc
authored
253 (MD.Float real, remainder)
5b63ba7 @mdirolf factor out getDocument
authored
254 end
255 else
256 if elementType = STRING then
257 let
258 val (size, remainder) = getInt bytes
259 val (string, remainder') = getCString remainder
260 in
261 assert (size = String.size string + 1);
20a2b71 @mdirolf use the MD alias for MongoDoc
authored
262 (MD.String string, remainder')
5b63ba7 @mdirolf factor out getDocument
authored
263 end
264 else
265 if elementType = OBJECT then
266 let
267 val (document, remainder) = getDocument bytes
268 in
20a2b71 @mdirolf use the MD alias for MongoDoc
authored
269 (MD.Document document, remainder)
5b63ba7 @mdirolf factor out getDocument
authored
270 end
271 else
196cbc2 @mdirolf dehydrate arrays
authored
272 if elementType = ARRAY then
273 let
274 val (document, remainder) = getDocument bytes
275 val array = arrayFromDocument document
276 in
277 (array, remainder)
278 end
279 else
280 raise InternalError
978644b @mdirolf cleaner
authored
281 and hydrateElements bytes =
8213661 @mdirolf towards toDocument
authored
282 case bytes of
978644b @mdirolf cleaner
authored
283 nil => nil
dff64b5 @mdirolf ghetto...
authored
284 | _ => (let
285 val (elementType, remainder) = getByte bytes
286 val (key, data) = getCString remainder
287 val (value, elements) = hydrateValue elementType data
288 in
3dd23d2 @mdirolf cleaner
authored
289 (key, value)::hydrateElements elements
dff64b5 @mdirolf ghetto...
authored
290 end)
5b63ba7 @mdirolf factor out getDocument
authored
291 and getDocument bytes =
292 let
293 val (elements, remainder) = unwrapObject bytes
294 in
20a2b71 @mdirolf use the MD alias for MongoDoc
authored
295 (MD.fromList (hydrateElements elements), remainder)
5b63ba7 @mdirolf factor out getDocument
authored
296 end
8213661 @mdirolf towards toDocument
authored
297 fun toDocument bson =
298 let
5b63ba7 @mdirolf factor out getDocument
authored
299 val (document, remainder) = getDocument bson
8213661 @mdirolf towards toDocument
authored
300 in
5b63ba7 @mdirolf factor out getDocument
authored
301 assert (length remainder = 0);
302 document
8213661 @mdirolf towards toDocument
authored
303 end
1a4253a @mdirolf add size function
authored
304 fun size bson = length bson
de34e64 WIP: switching machines
Mike Dirolf authored
305 end
Something went wrong with that request. Please try again.