Extract common parts of this code

I have the following piece of code (I tried to simplify it for the example):

open Base

type ('state, 'event, 'command) decider =
  { 
   decide : 'command -> 'state -> 'event
  }

type event_a =
  | Summed
[@@deriving yojson]

type cmd_a =
  | Plus

let decider_a =
  { 
   decide =
      (fun cmd _state ->
        match cmd with
        | Plus -> Summed
      )
  }

type event_b =
  | Added
[@@deriving yojson]

type cmd_b =
  | Add

let decider_b =
  { 
   decide =
      (fun cmd _state ->
        match cmd with
        | Add ->  Added
      )
  }

type all_cmd =
  | A of cmd_a
  | B of cmd_b


module Store = struct
  type input = string
  type output = {a: string}

  let table = Hashtbl.create (module String)

  let add key a = 
    let for_output = {a} in
    Hashtbl.update table key ~f:(function
      | None -> [for_output]
      | Some x -> for_output :: x)

  let read key = Hashtbl.find table key |> Option.value ~default:[]
end

let router cmd =
  match cmd with
  | A cmd_a -> (
    let key = "a" in
    let current = Store.read key in
    let current_for_a = List.map ~f:(fun {a} -> a |> Yojson.Safe.from_string |> event_a_of_yojson) current in
    let event = decider_a.decide cmd_a current_for_a in
    let data = event |> yojson_of_event_a |> Yojson.Safe.to_string in
    Store.add key data
  )

  | B cmd_b -> (
    let key = "b" in
    let current = Store.read key in
    let current_for_b = List.map ~f:(fun {a} -> a |> Yojson.Safe.from_string |> event_b_of_yojson) current in
    let event = decider_b.decide cmd_b current_for_b in
    let data = event |> yojson_of_event_b |> Yojson.Safe.to_string in
    Store.add key data
  )

let%expect_test "test store" =
  let _1 = router (A Plus) in
  let _2 = router (A Plus) in
  let _2 = router (B Add) in
  let events_a = Store.read "a" in
  List.iter ~f:(fun {a} -> Stdlib.print_endline a) events_a;
  let events_b = Store.read "b" in
  List.iter ~f:(fun {a} -> Stdlib.print_endline a) events_b;
  [%expect
    {|
    ["Summed"]
    ["Summed"]
    ["Added"] |}]

If you look at the router a lot of code is duplicated. How can I extract it?

I tried something like this, where I extract the key, decode, encode and decider:

Simplified:

type ('cmd, 'event) for_router = {
  key: 'cmd -> string;
  decode: Store.output -> 'event
  ...
}

let router2 cmd =
  match cmd with
  | A _cmd_a -> {
    key = (fun _ -> "a");
    decode = (fun {a} -> a |> Yojson.Safe.from_string |> event_a_of_yojson)
  }
  | B _cmd_b -> {
    key = (fun _ -> "b");
    decode = (fun {a} -> a |> Yojson.Safe.from_string |> event_b_of_yojson)
}

But that doesn’t work obviously. I was looking into polymorphic annotations as a possible solution, but that’s rather new to me and I didn’t get it working (I’m not even sure if that’s a solution).

Anyone who can point me in the right direction?

I don’t know if it would work in your real program, but for your example you can factor the code that way:

let router_gen cmd key decider event_of_yojson yojson_of_event =
  let current = Store.read key in
  let current_decoded = List.map ~f:(fun {a} -> a |> Yojson.Safe.from_string |> event_of_yojson) current in
  let event = decider.decide current_decoded in
  let data = event |> yojson_of_event |> Yojson.Safe.to_string in
  Store.add key data

let router cmd =
  match cmd with
  | A cmd_a -> router_gen cmd_a decider_a event_a_of_yojson yojson_of_event_a
  | B cmd_b -> router_gen cmd_b decider_b event_b_of_yojson yojson_of_event_b

You could make it a bit cleaner using either a record type or module for grouping functions together:

type ('cmd, 'event) router_ops =
{ key : string;
  decider : ('event list, 'event, 'cmd) decider;
  event_of_yojson : Yojson.Safe.t -> 'event;
  yojson_of_event : 'event -> Yojson.Safe.t;
}

(* Typing annotation is facultative *)
let ops_a : (cmd_a, event_a) router_ops =
  { key = "a";
    decide = decider_a;
    event_of_yojson = event_a_of_yojson;
    yojson_of_event = yojson_of_event_a;
  }

let router_from_ops cmd ops =
  ...
1 Like