Permalink
Browse files

Use new CouchDB interface

  • Loading branch information...
VictorNicollet committed Aug 30, 2012
1 parent 1eaa839 commit c7d07d8f19cab2732f9023350754f6d00b81002c
@@ -86,7 +86,7 @@ struct
end)
module MyDB = CouchDB.Database(Db)
- module MyTable = CouchDB.Table(MyDB)(MyId)(Data)
+ module Tbl = CouchDB.Table(MyDB)(MyId)(Data)
module Design = struct
module Database = MyDB
@@ -95,7 +95,7 @@ struct
let create ?size ?(init=Config.empty) () =
let! time = ohmctx (#time) in
- MyTable.create (object
+ Tbl.create (object
method size = BatOption.map (fun s -> (0,s)) size
method data = init
method time = time
@@ -114,7 +114,7 @@ struct
method finished = old # finished
method size = BatOption.map (fun (n,s) -> n + steps, s) (old # size)
end in
- Run.map ignore (MyTable.transaction id (MyTable.update f))
+ Tbl.update id f
let finish id =
let! time = ohmctx (#time) in
@@ -124,7 +124,7 @@ struct
method data = old # data
method size = old # size
end in
- Run.map ignore (MyTable.transaction id (MyTable.update f))
+ Tbl.update id f
let compute_progress data =
match data # size with
@@ -133,28 +133,27 @@ struct
| None -> None
let progress id =
- Run.map (BatOption.bind compute_progress) (MyTable.get id)
+ Run.map (BatOption.bind compute_progress) (Tbl.get id)
- let delete id =
- Run.map ignore MyTable.(transaction id remove)
+ let delete id = Tbl.delete id
let finished id =
- Run.map (BatOption.map (#finished)) (MyTable.get id)
+ Tbl.using id (#finished)
- let is_finished data =
+ let if_finished data =
if data # finished then Some (data # data) else None
let download id =
- Run.map (BatOption.bind is_finished) (MyTable.get id)
+ Run.map (BatOption.bind if_finished) (Tbl.get id)
let get_state = function
| None -> `Missing
- | Some data -> match is_finished data with
+ | Some data -> match if_finished data with
| Some whole -> `Complete whole
| None -> `Incomplete (compute_progress data)
let state id =
- Run.map get_state (MyTable.get id)
+ Tbl.get id |> Run.map get_state
module LastTouchedView = CouchDB.MapView(struct
module Key = Fmt.Float
@@ -68,7 +68,6 @@ module Make = functor(Config:CONFIG) -> struct
(* Minor operations on the metadata *)
let poll ~delay source =
- let id = Id.gen () in
let info = PollInfo.({
fetched = 0.0 ;
wait = delay ;
@@ -77,21 +76,16 @@ module Make = functor(Config:CONFIG) -> struct
gc = 0 ;
errors = 0 ;
}) in
- let! _ = ohm $ Run.edit_context Config.couchDB
- (InfoTable.transaction id (InfoTable.insert info)) in
- return id
+ Run.edit_context Config.couchDB
+ (InfoTable.create info)
let disable id =
- let update info = PollInfo.({ info with gc = 999 }) in
- let! _ = ohm $ Run.edit_context Config.couchDB
- (InfoTable.transaction id (InfoTable.update update)) in
- return ()
+ Run.edit_context Config.couchDB
+ (InfoTable.update id (fun info -> PollInfo.({ info with gc = 999 })))
let insist id =
- let update info = PollInfo.({ info with fetched = 0.0 }) in
- let! _ = ohm $ Run.edit_context Config.couchDB
- (InfoTable.transaction id (InfoTable.update update)) in
- return ()
+ Run.edit_context Config.couchDB
+ (InfoTable.update id (fun info -> PollInfo.({ info with fetched = 0.0 })))
let get id =
let! data = ohm_req_or (return None) $
@@ -124,9 +118,8 @@ module Make = functor(Config:CONFIG) -> struct
in
if info.PollInfo.digest = digest then return (`keep,digest) else
let content = Lazy.force lazy_content in
- let insert = ContentData.({content}) in
- let! _ = ohm $ Run.edit_context Config.couchDB
- (ContentTable.transaction id (ContentTable.insert insert)) in
+ let! () = ohm $ Run.edit_context Config.couchDB
+ (ContentTable.set id ContentData.({content})) in
let! keep = ohm $ Signals.change_call (id,info.PollInfo.source,content) in
return begin
if keep then `keep, digest else (
@@ -147,9 +140,8 @@ module Make = functor(Config:CONFIG) -> struct
(* "lock" the task to avoid multiple processing *)
let fetched = Unix.gettimeofday () in
- let update info = PollInfo.({ info with fetched }) in
- let! _ = ohm $ Run.edit_context Config.couchDB
- (InfoTable.transaction id (InfoTable.update update)) in
+ let! () = ohm $ Run.edit_context Config.couchDB
+ (InfoTable.update id (fun info -> PollInfo.({ info with fetched }))) in
(* Perform the processing *)
let! status, digest = ohm $ download id info in
@@ -163,8 +155,8 @@ module Make = functor(Config:CONFIG) -> struct
gc = (1 + info.gc) * gc ;
errors = (1 + info.errors) * err
}) in
- let! _ = ohm $ Run.edit_context Config.couchDB
- (InfoTable.transaction id (InfoTable.update update)) in
+ let! () = ohm $ Run.edit_context Config.couchDB
+ (InfoTable.update id update) in
return None
@@ -44,18 +44,16 @@ module Make = functor(Db:CouchDB.DATABASE) -> struct
type json t = < key : string >
end)
- module MyTable = CouchDB.Table(Db)(Id)(Key)
+ module Tbl = CouchDB.Table(Db)(Id)(Key)
let id = Id.of_string "key"
let key =
Run.eval (new CouchDB.init_ctx) begin
- let! found = ohm $ MyTable.get id in
+ let! found = ohm $ Tbl.get id in
match found with Some found -> return (found # key) | None ->
let key = generate () in
- let! _ = ohm $ MyTable.transaction id
- (MyTable.insert (object method key = key end))
- in
+ let! () = ohm $ Tbl.set id (object method key = key end) in
return key
end
@@ -342,8 +342,7 @@ module Make = functor(T:TABULAR) -> struct
hint = hint
}) in
- let! _ = ohm $ LineTable.transaction (LineId.of_id id) (LineTable.insert line) in
- return ()
+ LineTable.set (LineId.of_id id) line
let update_at_key lid ?(hint=false) ?evaluator key =
@@ -383,13 +382,9 @@ module Make = functor(T:TABULAR) -> struct
let remove item =
let id = LineId.of_id (item # id) in
- let checked_remove id =
- (* Check whether the version is still the one to be removed!
- Maybe another process came around and updated the line to another version. *)
- let! line = ohm_req_or (return ((),`keep)) $ LineTable.get id in
- if line.LineData.version <> version then return ((),`keep) else return ((), `delete)
- in
- LineTable.transaction id checked_remove
+ (* Check whether the version is still the one to be removed!
+ Maybe another process came around and updated the line to another version. *)
+ LineTable.delete_if id (fun line -> line.LineData.version = version)
in
let! _ = ohm $ Run.list_map remove sample in
@@ -427,22 +422,27 @@ module Make = functor(T:TABULAR) -> struct
let lid = ListId.of_id (next # id) in
(* Determine what should be done, and lock the task. *)
- let! what = ohm_req_or (return false) $ decay (ListTable.transaction lid begin fun lid ->
- let abort = return (None, `keep) in
- let! list = ohm_req_or abort $ ListTable.get lid in
- if list.ListData.next > Unix.gettimeofday () then
+ let! what = ohm_req_or (return false) $ decay
+ (ListTable.Raw.transaction lid begin fun lid ->
+
+ let abort = return (None, `keep) in
+ let! list = ohm_req_or abort $ ListTable.get lid in
+
+ if list.ListData.next > Unix.gettimeofday () then
(* Concurrent access : abort. *)
- abort
- else
- let! task, lock = req_or abort $ start_processing list in
- return (Some task, `put lock)
- end) in
+ abort
+ else
+ let! task, lock = req_or abort $ start_processing list in
+ return (Some task, `put lock)
+
+ end)
+ in
(* Perform the task and determine if something should be done next. *)
let! continue = ohm $ process_update lid what in
(* Unlock the task. *)
- let! () = ohm $ decay (ListTable.transaction lid begin fun lid ->
+ let! () = ohm $ decay (ListTable.Raw.transaction lid begin fun lid ->
let! list = ohm_req_or (return ((), `keep)) $ ListTable.get lid in
return ((), `put (finish_processing what continue list))
end) in
@@ -454,19 +454,15 @@ module Make = functor(T:TABULAR) -> struct
(* Publish the API *)
let set_list lid ~columns ~source ~filter =
- decay $ ListTable.transaction lid begin fun lid ->
- let! current = ohm $ ListTable.get lid in
- let updated = update_or_create_list ~columns ~source ~filter current in
- return ((), `put updated)
+ decay $ ListTable.replace lid begin fun current ->
+ update_or_create_list ~columns ~source ~filter current
end
let set_columns lid columns =
- decay $ ListTable.transaction lid begin fun lid ->
- let! current = ohm_req_or (return ((), `keep)) $ ListTable.get lid in
+ decay $ ListTable.update lid begin fun current ->
let source = current.ListData.source in
let filter = current.ListData.filter in
- let updated = update_or_create_list ~columns ~source ~filter (Some current) in
- return ((), `put updated)
+ update_or_create_list ~columns ~source ~filter (Some current)
end
let get_list lid =
@@ -483,35 +479,28 @@ module Make = functor(T:TABULAR) -> struct
let schedule_list item =
let lid = ListId.of_id (item # id) in
- decay $ ListTable.transaction lid begin fun lid ->
- let! current = ohm $ ListTable.get lid in
- match current with
- | None -> return ((), `keep)
- | Some list -> return ((), `put (schedule_update_at key list))
+ decay $ ListTable.transact lid begin function
+ | None -> return ((), `keep)
+ | Some list -> return ((), `put (schedule_update_at key list))
end
in
- let! _ = ohm $ Run.list_map schedule_list lists in
- return ()
+ Run.list_iter schedule_list lists
let update_all key =
let! lists = ohm $ decay (KeyView.by_key (Key.to_id key)) in
let lists = List.map (#value |- ListId.of_id) lists in
let schedule_list lid =
- decay $ ListTable.transaction lid begin fun lid ->
- let! current = ohm $ ListTable.get lid in
- match current with
- | None -> return ((), `keep)
- | Some list -> return ((), `put (schedule_update_at key list))
+ decay $ ListTable.transact lid begin function
+ | None -> return ((), `keep)
+ | Some list -> return ((), `put (schedule_update_at key list))
end
in
- let! _ = ohm $ Run.list_map schedule_list lists in
- return ()
+ Run.list_iter schedule_list lists
-
let hint lid key evaluator =
update_at_key lid ~hint:true ~evaluator key
@@ -35,14 +35,14 @@ module Make = functor (DB:CouchDB.DATABASE) -> struct
let get value =
let id = Id.gen () in
let fresh = lazy (object method id = id end) in
- MyTable.transaction value (MyTable.ensure fresh) |> Run.map id_of
+ Run.map id_of (MyTable.ensure value fresh)
let remove value =
- MyTable.transaction value MyTable.remove |> Run.map ignore
+ MyTable.delete value
let remove_atomic value current_id =
let has_id uniq = uniq # id = current_id in
- MyTable.transaction value (MyTable.remove_if has_id) |> Run.map ignore
+ MyTable.delete_if value has_id
module Design = struct
module Database = DB
@@ -68,7 +68,7 @@ module Make = functor (DB:CouchDB.DATABASE) -> struct
| None -> return (id, `put (object method id = id end))
| Some x -> return (id_of x, `keep)
in
- MyTable.transaction value update
+ MyTable.Raw.transaction value update
end
Oops, something went wrong.

0 comments on commit c7d07d8

Please sign in to comment.