Skip to content

Commit

Permalink
Merge pull request #663 from andreas/irmin-graphql-schema-suggestions
Browse files Browse the repository at this point in the history 
GraphQL schema suggestions
  • Loading branch information
@zshipko
zshipko committed Mar 28, 2019
2 parents fa664dd + d3e4fbd commit 489c0fe
Showing 1 changed file with 62 additions and 86 deletions.
148 changes: 62 additions & 86 deletions src/irmin-graphql/server.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -123,10 +123,6 @@ module Make_ext(Server: Cohttp_lwt.S.Server)(Config: CONFIG)(Store : Irmin.S)(Pr
of_irmin_result (Irmin.Type.of_string Store.metadata_t s)
| _ -> Error "invalid metadata encoding"

let coerce_step = function
| `String s -> of_irmin_result (Irmin.Type.of_string Store.step_t s)
| _ -> Error "invalid step encoding"

let coerce_branch = function
| `String s -> of_irmin_result @@ Irmin.Type.of_string Store.branch_t s
| _ -> Error "invalid branch encoding"
Expand All @@ -144,7 +140,6 @@ module Make_ext(Server: Cohttp_lwt.S.Server)(Config: CONFIG)(Store : Irmin.S)(Pr
| _ -> Error "invalid hash encoding"

let key = Schema.Arg.(scalar "Key" ~coerce:coerce_key)
let step = Schema.Arg.(scalar "Step" ~coerce:coerce_step)
let commit_hash = Schema.Arg.(scalar "CommitHash" ~coerce:coerce_hash)
let branch = Schema.Arg.(scalar "BranchName" ~coerce:coerce_branch)
let remote = Schema.Arg.(scalar "Remote" ~coerce:coerce_remote)
Expand Down Expand Up @@ -227,58 +222,46 @@ module Make_ext(Server: Cohttp_lwt.S.Server)(Config: CONFIG)(Store : Irmin.S)(Pr

and node : ('ctx, (Store.tree * Store.key) option) Schema.typ Lazy.t = lazy Schema.(
obj "Node"
~fields:(fun node -> [
~fields:(fun _ -> [
field "key"
~typ:(non_null string)
~args:[]
~resolve:(fun _ (_, key) -> Irmin.Type.to_string Store.key_t key)
;
~resolve:(fun _ (_, key) ->
Irmin.Type.to_string Store.key_t key
);
io_field "get"
~args:Arg.[arg "step" ~typ:Input.step]
~typ:node
~resolve:(fun _ (tree, key) step ->
Store.Tree.get_tree tree key >>= fun tree ->
let key =
match step with
| Some s -> Store.Key.v [s]
| None -> Store.Key.empty
in
Lwt.return_ok (Some (tree, key))
)
;
io_field "value"
~args:[]
~typ:Presentation.Contents.schema_typ
~resolve:(fun _ (tree, key) ->
Store.Tree.find tree key >|=
Option.map Presentation.Contents.to_src >|=
Result.ok
~args:Arg.[arg "key" ~typ:(non_null Input.key)]
~typ:tree
~resolve:(fun _ (tree, _) key ->
Store.Tree.kind tree key >>= function
| Some `Contents ->
Store.Tree.get_all tree key >|= fun (c, m) ->
Ok (Some (Lazy.(force contents_as_tree (c, m, key))))
| Some `Node ->
Store.Tree.get_tree tree key >|= fun t ->
Ok (Some (Lazy.(force node_as_tree (t, key))))
| None -> Lwt.return_ok None
);
io_field "metadata"
~args:[]
~typ:Presentation.Metadata.schema_typ
~resolve:(fun _ (tree, key) ->
Store.Tree.find_all tree key >|=
Option.map snd >|=
Option.map Presentation.Metadata.to_src >|=
Result.ok
);
io_field "hash"
field "hash"
~typ:(non_null string)
~args:[]
~resolve:(fun _ (tree, key) ->
Store.Tree.get_tree tree key >>= fun tree ->
Lwt.return_ok (Irmin.Type.to_string Store.Hash.t (Store.Tree.hash tree))
~resolve:(fun _ (tree, _) ->
let hash = Store.Tree.hash tree in
Irmin.Type.to_string Store.Hash.t hash
);
io_field "tree"
~typ:(non_null (list (non_null tree)))
~args:[]
~resolve:(fun _ (tree, key) ->
Store.Tree.list tree key >>= Lwt_list.map_p (fun (step, kind) ->
Store.Tree.list tree Store.Key.empty >>= Lwt_list.map_p (fun (step, kind) ->
let key' = Store.Key.rcons key step in
match kind with
| `Contents -> Lwt.return (Lazy.(force contents_as_tree) (tree, key'))
| `Node -> Lwt.return (Lazy.(force node_as_tree) (tree, key'))
| `Contents ->
Store.Tree.get_all tree key' >|= fun (c, m) ->
Lazy.(force contents_as_tree (c, m, key'))
| `Node ->
Store.Tree.get_tree tree key' >|= fun t ->
Lazy.(force node_as_tree (t, key'))
) >>= Lwt.return_ok
);
])
Expand Down Expand Up @@ -312,19 +295,20 @@ module Make_ext(Server: Cohttp_lwt.S.Server)(Config: CONFIG)(Store : Irmin.S)(Pr
;
io_field "get_tree"
~args:Arg.[arg "key" ~typ:(non_null Input.key)]
~typ:(list (non_null @@ Lazy.force contents))
~typ:(list (non_null Lazy.(force contents)))
~resolve:(fun _ (t, _) key ->
let rec tree_list base tree key acc =
let rec tree_list tree key acc =
match tree with
| `Contents (_, _) ->
(Store.Tree.of_concrete base, key) :: acc
| `Contents (c, m) -> [c, m, key]
| `Tree l ->
List.fold_right (fun (step, t) acc -> tree_list base t (Store.Key.rcons key step) [] @ acc) l acc
List.fold_right (fun (step, t) acc ->
tree_list t (Store.Key.rcons key step) [] @ acc
) l acc
in
Store.find_tree t key >>= function
| Some tree ->
Store.Tree.to_concrete tree >>= fun tree ->
let l = tree_list tree tree Store.Key.empty [] in
let l = tree_list tree Store.Key.empty [] in
Lwt.return_ok (Some l)
| None -> Lwt.return_ok None
)
Expand All @@ -335,8 +319,8 @@ module Make_ext(Server: Cohttp_lwt.S.Server)(Config: CONFIG)(Store : Irmin.S)(Pr
~resolve:(fun _ (t, _) key ->
Store.mem_tree t key >>= function
| true ->
Store.get_tree t Store.Key.empty >>= fun tree ->
Lwt.return_ok (Some (tree, key))
Store.get_all t Store.Key.empty >>= fun (c, m) ->
Lwt.return_ok (Some (c, m, key))
| false -> Lwt.return_ok None
)
;
Expand All @@ -357,44 +341,34 @@ module Make_ext(Server: Cohttp_lwt.S.Server)(Config: CONFIG)(Store : Irmin.S)(Pr
])
)

and contents : ('ctx, (Store.tree * Store.key) option) Schema.typ Lazy.t = lazy Schema.(
and contents : ('ctx, (Store.contents * Store.metadata * Store.key) option) Schema.typ Lazy.t = lazy Schema.(
obj "Contents"
~fields:(fun _contents -> [
field "key"
~typ:(non_null string)
~args:[]
~resolve:(fun _ (_, key) -> Irmin.Type.to_string Store.key_t key)
;
io_field "metadata"
~typ:Presentation.Metadata.schema_typ
~resolve:(fun _ (_, _, key) ->
Irmin.Type.to_string Store.key_t key
);
field "metadata"
~typ:(non_null Presentation.Metadata.schema_typ)
~args:[]
~resolve:(fun _ (tree, key) ->
Store.Tree.find_all tree key >|=
Option.map snd >|=
Option.map Presentation.Metadata.to_src >|=
Result.ok
)
;
io_field "value"
~typ:Presentation.Contents.schema_typ
~resolve:(fun _ (_, metadata, _) ->
Presentation.Metadata.to_src metadata
);
field "value"
~typ:(non_null Presentation.Contents.schema_typ)
~args:[]
~resolve:(fun _ (tree, key) ->
Store.Tree.find tree key >|=
Option.map Presentation.Contents.to_src >|=
Result.ok
)
;
io_field "hash"
~typ:string
~resolve:(fun _ (contents, _, _) ->
Presentation.Contents.to_src contents
);
field "hash"
~typ:(non_null string)
~args:[]
~resolve:(fun _ (tree, key) ->
Store.Tree.find tree key >|= function
| None -> Ok None
| Some contents ->
let contents = Store.Contents.hash contents in
Ok (Some (Irmin.Type.to_string Store.Hash.t contents))
)
;
~resolve:(fun _ (contents, _, _) ->
let hash = Store.Contents.hash contents in
Irmin.Type.to_string Store.Hash.t hash
);
])
)

Expand Down Expand Up @@ -774,13 +748,15 @@ module Make_ext(Server: Cohttp_lwt.S.Server)(Config: CONFIG)(Store : Irmin.S)(Pr
Store.Commit.of_hash s hash >>= Lwt.return_ok
);
io_field "branches"
~typ:(non_null (list (non_null string)))
~typ:(non_null (list (non_null Lazy.(force branch))))
~args:[]
~resolve:(fun _ _ ->
Store.Branch.list s >|= fun l ->
let branches = List.map (fun b ->
Irmin.Type.to_string Store.branch_t b) l
in Ok branches
Store.Branch.list s >>=
Lwt_list.map_p (fun branch ->
Store.of_branch s branch >|= fun store ->
store, branch
) >|=
Result.ok
);
io_field "master"
~typ:(Lazy.force branch)
Expand Down

0 comments on commit 489c0fe

Please sign in to comment.