aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/dml/executor.ml2
-rw-r--r--lib/drl/executor.ml6
-rw-r--r--lib/qualified_name.ml9
-rw-r--r--lib/qualified_name.mli2
4 files changed, 11 insertions, 8 deletions
diff --git a/lib/dml/executor.ml b/lib/dml/executor.ml
index 7e655e6..f149965 100644
--- a/lib/dml/executor.ml
+++ b/lib/dml/executor.ml
@@ -13,7 +13,7 @@ module Make (NT : Nt.S) = struct
let ( let* ) = Result.bind
let parse_fqn (s : string) : (Qualified_name.t, Condition.t) result =
- Qualified_name.try_parse s |> Result.map_error (fun s -> Error.unqualified_name s)
+ Qualified_name.try_parse s
let lookup_mg (ctx : Sublanguage_context.t) (mg_name : string) :
(Management.Multigroup.multigroup, Condition.t) result =
diff --git a/lib/drl/executor.ml b/lib/drl/executor.ml
index 666ca37..3900f73 100644
--- a/lib/drl/executor.ml
+++ b/lib/drl/executor.ml
@@ -5,7 +5,6 @@ module Make (NT : Nt.S) = struct
let parse_error error = condition "parse-error" ("message" |=| (of_string error))
let relation_not_found name = condition "relation-not-found" ("name" |=| (of_string name))
let unsupported_operator msg = condition "unsupported-operator" ("message" |=| (of_string msg))
- let unqualified_name name = condition "unqualified-name" ("name" |=| (of_string name))
end
let ( let* ) = Result.bind
@@ -18,9 +17,8 @@ module Make (NT : Nt.S) = struct
(q : Ast.query) : (Nt.plan_node, Condition.t) result =
match q with
| Ast.Base name ->
- (match Qualified_name.try_parse name with
- | Error s -> Error (Error.unqualified_name s)
- | Ok fqn -> Ok (Nt.Scan { path = resolve fqn; args = [] }))
+ let* fqn = Qualified_name.try_parse name in
+ Ok (Nt.Scan { path = resolve fqn; args = [] })
| Ast.Join (on_attrs, q1, q2) ->
let* p1 = compile resolve q1 in
let* p2 = compile resolve q2 in
diff --git a/lib/qualified_name.ml b/lib/qualified_name.ml
index 47134c8..d69e866 100644
--- a/lib/qualified_name.ml
+++ b/lib/qualified_name.ml
@@ -13,6 +13,11 @@
type t = { mg : string; name : string }
+module Error = struct
+ open Condition
+ let unqualified_name name = condition "unqualified-name" ("name" |=| (of_string name))
+end
+
exception Unqualified of string
let parse (s : string) : t =
@@ -24,8 +29,8 @@ let parse (s : string) : t =
if mg = "" || name = "" then raise (Unqualified s)
else { mg; name }
-let try_parse (s : string) : (t, string) result =
- try Ok (parse s) with Unqualified s -> Error s
+let try_parse (s : string) : (t, Condition.t) result =
+ try Ok (parse s) with Unqualified s -> Error (Error.unqualified_name s)
let make ~mg ~name = { mg; name }
diff --git a/lib/qualified_name.mli b/lib/qualified_name.mli
index 196dfbd..0e39ff2 100644
--- a/lib/qualified_name.mli
+++ b/lib/qualified_name.mli
@@ -11,7 +11,7 @@ val parse : string -> t
(** Splits on the first [:]. Raises [Unqualified] when no mg segment is
present (i.e. no colon, or empty mg / empty name). *)
-val try_parse : string -> (t, string) result
+val try_parse : string -> (t, Condition.t) result
val make : mg:string -> name:string -> t