Permalink
Browse files

[enhance] compiler, dbgen, mongo: enhance error message on feature wh…

…ich not yet implemented
  • Loading branch information...
1 parent 959c892 commit 32e38cc7d0b1946134153fdf873ee1d0b8290261 @BourgerieQuentin BourgerieQuentin committed Jan 30, 2012
Showing with 18 additions and 9 deletions.
  1. +9 −7 libqmlcompil/qmlDbGen.ml
  2. +9 −2 opa/pass_MongoAccessGeneration.ml
View
@@ -235,8 +235,8 @@ module Schema = struct
| C.Multi_edge (C.Kfields _) -> DbSet next.C.ty
| _ -> assert false
end
- | [] -> raise Not_found
- | _ -> raise Not_found
+ | [] -> OManager.i_error "Found any successors from a multi node"
+ | _ -> OManager.i_error "Found multiple successors from a multi node"
in
match fragment with
| DbAst.ExprKey expr ->
@@ -252,22 +252,24 @@ module Schema = struct
| _ ->
match kind, nlabel.C.plain with
| Compose _, true -> Plain
+ | Compose c, false -> Compose c
| Partial (sum, path, part), _ ->
Partial (sum && is_sum node, path, key::part)
| Plain, _ -> Partial (is_sum node, path, key::[])
- | Compose c, false -> Compose c
- | _, _ -> assert false
+ | SetAccess _, _ -> raise (Base.NotImplemented "Selection inside a multi node")
in let path = key::path
in (next, kind, path)
| DbAst.Query query ->
begin match kind with
| SetAccess (_k, path, None) ->
let kind = SetAccess (get_setkind llschema node, path, Some (false, query)) in
(next, kind, path)
- | SetAccess (_, _path, Some _) -> assert false
- | _ -> assert false
+ | SetAccess (_, _path, Some _) ->
+ raise (Base.NotImplemented "Selection inside a multi node")
+ | _ ->
+ raise (Base.NotImplemented "Query in a non multi node")
end
- | DbAst.NewKey -> OManager.error "new key is not yep supported"
+ | DbAst.NewKey -> raise (Base.NotImplemented "New key")
in
let (node, kind, _path) =
List.fold_left f (get_root llschema, Compose [], []) path in
@@ -264,6 +264,13 @@ module Generator = struct
fields
| _ -> None
+ let get_node ~context schema path =
+ try
+ DbSchema.get_node schema path
+ with Base.NotImplemented s ->
+ QmlError.error context
+ "Can't generates mongo access because : %s is not yet implemented"
+ s
let rec compose_path ~context gamma annotmap schema kind subs =
let subkind =
@@ -292,7 +299,7 @@ module Generator = struct
(* vv FIXME !?!?! vv *)
let node =
let strpath = List.map (fun k -> DbAst.FldKey k) strpath in
- DbSchema.get_node schema strpath in
+ get_node ~context schema strpath in
(* ^^ FIXME !?!?! ^^ *)
let dataty = node.DbSchema.ty in
match kind with
@@ -560,7 +567,7 @@ module Generator = struct
let path ~context gamma annotmap schema (kind, dbpath) =
(* Format.eprintf "Path %a" QmlPrint.pp#path (dbpath, kind); *)
- let node = DbSchema.get_node schema dbpath in
+ let node = get_node ~context schema dbpath in
match node.DbSchema.kind with
| DbSchema.SetAccess (setkind, path, query) ->
dbset_path ~context gamma annotmap (kind, path) setkind node query

0 comments on commit 32e38cc

Please sign in to comment.