Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 6e99e9585a
Fetching contributors…

Cannot retrieve contributors at this time

file 65 lines (46 sloc) 1.429 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
(* Ohm is © 2012 Victor Nicollet *)

open BatPervasives

module type RESET = sig

  val run : unit -> (#CouchDB.ctx,unit) Run.t

  val check_wrapper : ('a -> unit) -> 'a -> unit

  val resetting : unit -> bool

  val check : unit -> unit

end

module Make =
  functor (DB : CouchDB.DATABASE) ->
struct

  let id = Id.of_string "reset"

  module Reset = Fmt.Make(struct
    type json t = <
      t : string ;
      time : string
    >
  end)

  module MyTable = CouchDB.Table(DB)(Id)(Reset)

  let _default = Util.string_of_time (Unix.gettimeofday ())

  let _get () =
    let time = function
      | Some value -> value # time
      | None -> _default
    in
    MyTable.get id |> Run.map time

  let _initial = Run.eval (new CouchDB.init_ctx) (_get ())

  let run () =
    Run.context |> Run.bind begin fun ctx ->
      let reset = object
method t = "rset"
method time = Util.string_of_time (ctx # time)
      end in
      MyTable.transaction id (MyTable.insert reset)
      |> Run.map (fun _ -> Util.log "Reset.perform : request sent")
    end

  let resetting () =
    Run.eval (new CouchDB.init_ctx) (_get () |> Run.map (fun x -> x <> _initial))

  let check () =
    if resetting () then begin
      Util.log "Reset.check: reset requested at %s, shutting down" _initial ;
      exit 0
    end
       
  let check_wrapper f a =
    try f a ; check () with exn -> check () ; raise exn

end
Something went wrong with that request. Please try again.