Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 144 lines (141 sloc) 5.315 kb
0dbb28c @mdirolf WIP: factoring out BSON and MongoDoc modules
authored
1 (* Copyright 2008 Michael Dirolf (mike@dirolf.com). All Rights Reserved. *)
2 signature BSON =
3 sig
4 type value
5 val print: value -> unit
6 val fromDocument: MongoDoc.document -> value
7 val toDocument: value -> MongoDoc.document
8 end
de34e64 WIP: switching machines
Mike Dirolf authored
9
10 structure BSON :> BSON =
11 struct
12 structure MD = MongoDoc
13
14 type value = Word8.word list
6409f98 @mdirolf complete the refactoring
authored
15 exception InternalError
de34e64 WIP: switching machines
Mike Dirolf authored
16 exception UnimplementedError
b0c3d80 @mdirolf clean up zero constants
authored
17 val zeroByte = Word8.fromInt 0
de34e64 WIP: switching machines
Mike Dirolf authored
18 fun makeList count element =
19 if count = 0 then
20 nil
21 else
22 element::(makeList (count - 1) element)
23 fun padLeft list count padding =
24 let
25 val len = length list
26 in
27 if len >= count then
28 List.take(list, count)
29 else
30 (makeList (count - len) padding) @ list
31 end
32 val print = fn bson =>
33 let
34 fun padStringLeft string count char =
35 String.implode (padLeft (String.explode string) count char)
36 fun printHelper lineNumber bson =
37 case bson of
38 nil => print "\n"
39 | hd::tl =>
40 (if lineNumber mod 8 = 0 then
b8db328 @mdirolf don't print a newline at the beginning
authored
41 (if lineNumber <> 0 then print "\n" else ();
42 print ((padStringLeft (Int.toString lineNumber) 4 #" ") ^ ": "))
de34e64 WIP: switching machines
Mike Dirolf authored
43 else
b8db328 @mdirolf don't print a newline at the beginning
authored
44 print " ";
de34e64 WIP: switching machines
Mike Dirolf authored
45 print (padStringLeft (Word8.toString hd) 2 #"0");
46 printHelper (lineNumber + 1) tl)
47 in
48 printHelper 0 bson
49 end
50 fun elementTypeFromName typeName =
51 case typeName of
52 "EOO" => Word8.fromInt 0
53 | "NUMBER" => Word8.fromInt 1
54 | "STRING" => Word8.fromInt 2
55 | "OBJECT" => Word8.fromInt 3
56 | "ARRAY" => Word8.fromInt 4
57 | "BINARY" => Word8.fromInt 5
58 | "UNDEFINED" => Word8.fromInt 6
59 | "OID" => Word8.fromInt 7
60 | "BOOLEAN" => Word8.fromInt 8
61 | "DATE" => Word8.fromInt 9
62 | "NULL" => Word8.fromInt 10
63 | "REGEX" => Word8.fromInt 11
64 | "REF" => Word8.fromInt 12
65 | "CODE" => Word8.fromInt 13
66 | "SYMBOL" => Word8.fromInt 14
67 | "CODE_W_SCOPE" => Word8.fromInt 15
68 | "NUMBER_INT" => Word8.fromInt 16
69 | _ => raise InternalError
70 fun elementType element =
71 case element of
6409f98 @mdirolf complete the refactoring
authored
72 MD.Document _ => elementTypeFromName "OBJECT"
73 | MD.Array _ => elementTypeFromName "ARRAY"
74 | MD.Bool _ => elementTypeFromName "BOOLEAN"
75 | MD.Int _ => elementTypeFromName "NUMBER_INT"
76 | MD.Float _ => elementTypeFromName "NUMBER"
77 | MD.String _ => elementTypeFromName "STRING"
de34e64 WIP: switching machines
Mike Dirolf authored
78 (* TODO this ought to be UTF-8 encoded *)
79 fun toCString s =
80 let
81 val s' = List.map (Word8.fromInt o ord) (explode s)
82 in
b0c3d80 @mdirolf clean up zero constants
authored
83 List.concat [s', [zeroByte]]
de34e64 WIP: switching machines
Mike Dirolf authored
84 end
a3e0807 @mdirolf ints are little endian too
authored
85 fun intToWord8List int =
de34e64 WIP: switching machines
Mike Dirolf authored
86 let
a3e0807 @mdirolf ints are little endian too
authored
87 fun helper int count =
88 if count = 0 then
89 nil
de34e64 WIP: switching machines
Mike Dirolf authored
90 else
a3e0807 @mdirolf ints are little endian too
authored
91 if int = 0 then
b0c3d80 @mdirolf clean up zero constants
authored
92 zeroByte::(helper 0 (count - 1))
a3e0807 @mdirolf ints are little endian too
authored
93 else
94 let
95 val word = Word8.fromInt (IntInf.toInt int)
96 val int' = IntInf.~>> (int, Word.fromInt 8)
97 in
98 word::(helper int' (count - 1))
99 end
de34e64 WIP: switching machines
Mike Dirolf authored
100 in
a3e0807 @mdirolf ints are little endian too
authored
101 helper (Int.toLarge int) 4
de34e64 WIP: switching machines
Mike Dirolf authored
102 end
103 fun elementToBSON (name, element) =
104 let
105 val tp = elementType element
106 val name = toCString name
107 fun listAsArray list =
108 let
109 fun helper l index =
110 case l of
111 nil => nil
112 | hd::tl => (Int.toString index, hd)::(helper tl (index + 1))
113 in
114 helper list 0
115 end
116 fun toList vec = Word8Vector.foldr (op ::) [] vec
117 val element = case element of
6409f98 @mdirolf complete the refactoring
authored
118 MD.Document d => fromDocument (MD.fromList d)
119 | MD.Array a => fromDocument (MD.fromList (listAsArray a))
b0c3d80 @mdirolf clean up zero constants
authored
120 | MD.Bool b => if b then [Word8.fromInt 1] else [zeroByte]
6409f98 @mdirolf complete the refactoring
authored
121 | MD.Int i => intToWord8List i
122 | MD.Float f => toList (PackRealLittle.toBytes f)
123 | MD.String s =>
de34e64 WIP: switching machines
Mike Dirolf authored
124 let
125 val cs = toCString s
126 in
127 intToWord8List (length cs) @ cs
128 end
129 in
130 (tp::name) @ element
131 end
132 and fromDocument document =
133 let
1a51a9c @mdirolf don't need to worry about dups here, part of MongoDoc contract now
authored
134 val document' = MD.toList document
135 val objectData = List.concat(List.map elementToBSON document')
c0aa823 @mdirolf it should
authored
136 (* overhead for the size bytes and eoo *)
de34e64 WIP: switching machines
Mike Dirolf authored
137 val overhead = 5
138 val size = intToWord8List (length objectData + overhead)
139 in
b0c3d80 @mdirolf clean up zero constants
authored
140 List.concat [size, objectData, [zeroByte]]
de34e64 WIP: switching machines
Mike Dirolf authored
141 end
142 fun toDocument value = raise UnimplementedError
143 end
Something went wrong with that request. Please try again.