minisql.sml (11893B)
1 type columnref = string 2 type tableref = string 3 (* Object containing (key, value) pairs. *) 4 type row = JSON.value 5 (* List of values that gets displayed to user. *) 6 type rowvals = JSON.value list 7 8 datatype value = String of string | Int of int | Column of columnref | 9 CurColumn of columnref | Time of int | Sub of value * value 10 datatype binop = Eq of value * value | Gt of value * value 11 datatype pred = Expr of binop | And of pred * pred | Or of pred * pred | 12 Not of pred | Next of pred | Until of pred * pred | True 13 datatype targets = Columns of columnref list | All 14 datatype query = Select of (targets * tableref * pred option * int option) 15 16 exception Parse 17 exception BadQuery 18 exception Type 19 exception MalformedData 20 exception NoSuchFile 21 22 (* Constructed predicate types - no need to do additional work in the engine. *) 23 fun Neq (x, y) = Not(Expr(Eq (x, y))) 24 fun Lt (x, y) = And(Not(Expr(Gt (x, y))), Not(Expr(Eq (x, y)))) 25 26 fun Eventually x = Until(True, x) 27 fun Henceforth x = Not(Eventually(Not x)) 28 fun WeakUntil (x, y) = Or(Until(x, y), Henceforth x) 29 fun Release (x, y) = Not(Until(Not x, Not y)) 30 fun StrongRelease (x, y) = Not(WeakUntil(Not x, Not y)) 31 fun Within (x, 0) = x 32 | Within (x, i) = Or(Next(x), Next(Within(x, i-1))) 33 34 35 (*--------------------------- Parsing logic. -----------------------------*) 36 37 structure P = ParserComb 38 39 fun skipWS parser = P.skipBefore Char.isSpace parser 40 41 (* Sequentially combines two parsers. *) 42 fun *> (a, b) = P.seq (a, b) 43 infixr 3 *> 44 (* Combines two parsers, ignoring whitespace. *) 45 fun +> (a, b) = P.seq (a, skipWS(b)) 46 infixr 3 +> 47 (* Only keeps the right hand result. *) 48 fun %> (a, b) = P.wrap(a +> b, #2) 49 infixr 3 %> 50 (* Only keeps the left hand result. *) 51 fun @> (a, b) = P.wrap(a +> b, #1) 52 infixr 3 @> 53 54 (* Parses "ref" values: e.g. name of column or table *) 55 fun parseRef getc = (P.token (fn x => Char.isAlphaNum x orelse x = #"_")) getc 56 57 (* Parses a list of one or more target columns (including wildcard) *) 58 fun parseCols getc = P.or( 59 P.wrap(P.string "*", (fn _ => All)), 60 P.wrap(parseRef +> P.zeroOrMore((P.char #",") %> parseRef), (Columns o op::)) 61 ) getc 62 63 fun middle (_, (x, _)) = x 64 fun isQuote x = (x = #"'" orelse x = #"\"") 65 66 fun parseTime getc = P.or'([ 67 P.wrap((Int.scan StringCvt.DEC) @> P.string "seconds", Time), 68 P.wrap((Int.scan StringCvt.DEC) @> P.string "minutes", fn x => Time(x*60)), 69 P.wrap((Int.scan StringCvt.DEC) @> P.string "hours", fn x => Time(x*60*60)), 70 P.wrap((Int.scan StringCvt.DEC) @> P.string "days", fn x => Time(x*60*60*24)), 71 P.wrap((Int.scan StringCvt.DEC) @> P.string "weeks", fn x => Time(x*60*60*24*7)) 72 ]) getc 73 74 fun parseSimpleValue getc = P.or'([ 75 P.wrap((P.eatChar isQuote) *> P.token (fn x => not (isQuote x)) 76 *> (P.eatChar isQuote), (String o middle)), 77 parseTime, 78 P.wrap(Int.scan StringCvt.DEC, Int), 79 P.wrap(P.string "cur." *> parseRef, CurColumn o #2), 80 P.wrap(parseRef, Column) 81 ]) getc 82 and parseValue getc = P.or( 83 P.wrap(parseSimpleValue +> P.char #"-" %> parseSimpleValue, Sub), 84 parseSimpleValue 85 ) getc 86 87 fun parseExpr getc = P.or'([ 88 P.wrap(parseValue +> P.char #"=" %> parseValue, Expr o Eq), 89 P.wrap(parseValue +> P.char #">" %> parseValue, Expr o Gt), 90 P.wrap(parseValue +> P.char #"<" %> parseValue, Lt), 91 P.wrap(parseValue +> P.string "!=" %> parseValue, Neq) 92 ]) getc 93 94 fun parseSubexpr getc = P.or'([ 95 parseExpr, 96 parseUnary, 97 parseNested, 98 parseLiteral 99 ]) getc 100 and parseLiteral getc = P.or( 101 P.wrap(P.string("TRUE"), fn _ => True), 102 P.wrap(P.string("FALSE"), fn _ => Not(True)) 103 ) getc 104 and parseUnary getc = P.or'([ 105 P.wrap(P.string "NOT" %> parseSubexpr, Not), 106 P.wrap(P.string "NEXT" %> parseSubexpr, Next), 107 P.wrap(P.string "EVENTUALLY" %> parseSubexpr, Eventually), 108 P.wrap(P.string "HENCEFORTH" %> parseSubexpr, Henceforth) 109 ]) getc 110 and parseBinary getc = P.or'([ 111 P.wrap(parseSubexpr +> P.string "AND" %> parseSubexpr, And), 112 P.wrap(parseSubexpr +> P.string "OR" %> parseSubexpr, Or), 113 P.wrap(parseSubexpr +> P.string "UNTIL" %> parseSubexpr, Until), 114 P.wrap(parseSubexpr +> P.string "WEAK UNTIL" %> parseSubexpr, WeakUntil), 115 P.wrap(parseSubexpr +> P.string "RELEASE" %> parseSubexpr, Release), 116 P.wrap(parseSubexpr +> P.string "STRONG RELEASE" %> parseSubexpr, StrongRelease), 117 P.wrap(parseSubexpr +> P.string "WITHIN" %> (Int.scan StringCvt.DEC), Within) 118 ]) getc 119 and parseNested getc = (P.char #"(" %> parseBinary @> P.char #")") getc 120 121 fun parsePredicate getc = (P.or'([parseUnary, parseBinary, parseExpr, parseLiteral])) getc 122 123 (* Optionally applies a parser. On failure, parses to NONE instead of passing 124 * an actual failure up and causing the overall parse to fail. *) 125 fun parseOptional parser getc = P.or (P.wrap (parser, SOME), P.result NONE) getc 126 127 fun parseSelect getc = 128 P.wrap((P.string "SELECT ") %> parseCols +> (P.string "FROM ") %> parseRef 129 *> parseOptional(skipWS(P.string "WHERE ") %> parsePredicate) 130 *> parseOptional(skipWS(P.string "LIMIT ") %> (Int.scan StringCvt.DEC)) 131 @> P.char(#";"), (fn (cs, (t, (p, l))) => Select (cs, t, p, l))) getc 132 133 fun parse s = Option.valOf (StringCvt.scanString parseSelect s) 134 handle Option => raise Parse 135 136 (*--------------------------- Execution engine. -----------------------------*) 137 138 fun getCol (row : row) (col : columnref) = 139 Option.valOf (JSONUtil.findField row col) 140 141 fun jsonEqual (JSON.INT x) (JSON.INT y) = x = y 142 | jsonEqual (JSON.STRING x) (JSON.STRING y) = x = y 143 | jsonEqual _ _ = raise Type 144 145 fun colInt row c = JSONUtil.asInt (getCol row c) 146 fun colStr row c = JSONUtil.asString (getCol row c) 147 148 fun equal row x y cur = 149 if x = y then true else 150 (case (x, y) of 151 ((String _), (Int _)) => raise Type 152 | ((Int x), (Column c)) => x = colInt row c 153 | ((Time x), (Column c)) => x = colInt row c 154 | ((String x), (Column c)) => x = colStr row c 155 | ((Column c1), (Column c2)) => jsonEqual (getCol row c1) (getCol row c2) 156 | ((CurColumn c1), (Column c2)) => jsonEqual (getCol cur c1) (getCol row c2) 157 | ((Time x), (Time y)) => x = y (* sml doesn't recognize Time as an eq type? *) 158 | ((CurColumn c1), _) => raise Type 159 | ((Time _), _) => raise Type 160 | (x,y) => equal row y x cur) 161 handle Option => raise BadQuery 162 163 (* TODO could be cleaned *) 164 fun greater row x y cur = 165 (case (x, y) of 166 ((Int x), (Int y)) => x > y 167 | ((Time x), (Time y)) => x > y 168 | ((Int x), (Column c)) => x > (colInt row c) 169 | ((Column c), (Int x)) => (colInt row c) > x 170 | ((Time x), (Column c)) => x > (colInt row c) 171 | ((Column c), (Time x)) => (colInt row c) > x 172 | ((Column c1), (Column c2)) => (colInt row c1) > (colInt row c2) 173 | ((CurColumn c1), (Column c2)) => (colInt cur c1) > (colInt row c2) 174 | ((Column c1), (CurColumn c2)) => (colInt row c1) > (colInt cur c2) 175 | _ => raise Type) 176 handle Option => raise BadQuery 177 178 fun eval (Sub(x, y)) row cur = 179 (case (x,y) of 180 (Column(c1), Column(c2)) => Time((colInt row c1) - (colInt row c2)) 181 | (CurColumn(c1), CurColumn(c2)) => Time((colInt cur c1) - (colInt cur c2)) 182 | (Column(c1), CurColumn(c2)) => Time((colInt row c1) - (colInt cur c2)) 183 | (CurColumn(c1), Column(c2)) => Time((colInt cur c1) - (colInt row c2)) 184 | _ => raise Type) 185 | eval x _ _ = x 186 187 (* Given a predicate and a row, check if the row satisfies the predicate. *) 188 fun check p row (start, future) = let 189 val st = Option.getOpt (start, row) 190 val S = (start, future) 191 in 192 (case (p, future) of 193 (Expr(Eq(x, y)), _) => equal row (eval x row st) (eval y row st) st 194 | (Expr(Gt(x, y)), _) => greater row (eval x row st) (eval y row st) st 195 | (And(p1, p2), ft) => check p1 row S andalso check p2 row S 196 | (Or(p1, p2), ft) => check p1 row S orelse check p2 row S 197 | (Not(p), f) => not (check p row S) 198 | (Next(_), []) => false 199 | (Next(p), (next::ft)) => check p next (SOME st, ft) 200 | (Until(p1, p2), []) => check p2 row (SOME st, []) 201 | (Until(p1, p2), (next::rest)) => 202 check p2 row (SOME st, next::rest) orelse 203 ((check p1 row (SOME st, next::rest)) andalso 204 (check (Until(p1, p2)) next (SOME st, rest))) 205 | (True, _) => true) 206 end 207 208 fun subset A B = List.all (fn x => List.exists (fn y => x = y) B) A 209 210 (* Returns list of all fields of JSON object, which given this challenge's 211 * assumptions should be the list of all columns in the table. *) 212 fun getCols ((JSON.OBJECT r) : row) : columnref list = List.map (fn (name, _) => name) r 213 | getCols _ = raise MalformedData 214 215 fun filterWith f [] = [] 216 | filterWith f (x::xs) = if f (x,xs) then x::(filterWith f xs) else filterWith f xs 217 218 (* Optionally filters rows for those matching given predicate (if it exists). *) 219 fun predFilter (SOME p) L = filterWith (fn (r,rs) => check p r (NONE, rs)) L 220 | predFilter NONE L = L 221 222 (* Optionally filters for the first n elements of a list. *) 223 fun optTake (SOME n) L = if n >= List.length L then L else List.take (L, n) 224 | optTake NONE L = L 225 226 fun execute (Select(req, table, pred, lim)) : rowvals list * columnref list = 227 let 228 val fname = table ^ ".json" 229 val (r::rs) = (case JSONParser.parseFile fname of JSON.ARRAY x => x) 230 val cols = getCols r 231 val targets = (case req of All => cols | Columns(c) => c) 232 val () = if not (subset targets (getCols r)) then raise BadQuery else () 233 in 234 (List.map (fn row => List.map (fn c => getCol row c) targets) 235 (optTake lim (predFilter pred (r::rs))), 236 targets) 237 end handle Match => raise MalformedData 238 | Io => raise NoSuchFile 239 240 (*--------------------------- Display utilities. -----------------------------*) 241 242 (* Coerce JSON values in list of row values to string types *) 243 fun stringifyRow (row : rowvals) = 244 List.map (fn (JSON.STRING x) => x 245 | (JSON.INT x) => IntInf.toString x) row 246 247 (* Returns a list of the max widths of each columns for padding. *) 248 fun getMaxSizes L = let 249 val rows = (map (fn x => map String.size x) L) 250 in 251 List.foldr (fn (x,y) => map Int.max (ListPair.zip (x,y))) (hd rows) rows 252 end 253 254 (* Pad rows to align nicely when printed out. *) 255 fun padRows rows = let 256 val maxs = getMaxSizes rows 257 val rec pad = (fn 0 => "" | n =>" " ^ pad (n-1)) 258 in 259 List.map (fn x => map (fn (x,y) => x ^ (pad (y - (String.size x)))) 260 (ListPair.zip (x,maxs))) rows 261 end 262 263 (* Delimits a list of strings by a delimiter. *) 264 fun delimit delim strings = List.foldr (fn (x, y) => x ^ delim ^ y) "" strings 265 266 (* Given a set of rows and columns, pretty prints them to stdout. *) 267 fun display ((rows, cols) : rowvals list * columnref list) = 268 (print o (delimit "\n") o (List.map (fn row => delimit " | " row)) o padRows) 269 (cols::(map stringifyRow rows)) 270 271 (* Main execution loop of program. *) 272 fun loop () : unit = 273 let 274 val () = print "minisql> " 275 val input = Option.valOf (TextIO.inputLine TextIO.stdIn) 276 handle Option => raise Parse 277 in 278 loop ((display o execute o parse) input 279 handle BadQuery => print "bad query\n" 280 | MalformedData => print "malformed data\n" 281 | Type => print "type error\n" 282 | Parse => print "parse error\n" 283 | NoSuchFile => print "no such file\n") 284 end 285 286 structure Main = 287 struct 288 fun main (_, _) = let 289 val () = loop () 290 in 291 OS.Process.success 292 end 293 end