wip

lib/sql_writer.ml

@@ -211,6 +211,22 @@ ORDER BY t.created_at DESC, t.id DESC, p.id DESC
     Db.find Q.insert_transaction (string_of_date date, narration)
     |> raise_if_error
 
+  let insert_transactions (module Db : Caqti_lwt.CONNECTION)
+      (txs : Model.transaction list) =
+    (* FIXME: SQL injection *)
+    let query =
+      txs
+      |> List.map (fun (tx : Model.transaction) ->
+             Printf.sprintf "('%s', '%s')" (string_of_date tx.date) tx.narration)
+      |> String.concat " "
+      |> Printf.sprintf
+           {|INSERT INTO transactions (created_at, narration) VALUES %s RETURNING id|}
+    in
+    let open Caqti_request.Infix in
+    let open Caqti_type.Std in
+    Db.fold_s ((unit ->* int) query) (fun x xs -> Lwt.return_ok (x :: xs)) () []
+    |> raise_if_error
+
   let insert_posting (module Db : Caqti_lwt.CONNECTION) ~account_id
       ~transaction_id ~amount ~narration =
     Db.exec Q.insert_posting (account_id, transaction_id, amount, narration)
@@ -241,7 +257,103 @@ ORDER BY t.created_at DESC, t.id DESC, p.id DESC
           (Caqti_error.show e)
 end
 
+module StringMap = Map.Make (String)
+
+let rec list_last = function
+  | [] -> failwith "list_last"
+  | [ x ] -> x
+  | _ :: xs -> list_last xs
+
+let dump_account_id_map (model : Model.t) =
+  (* (partial) account name -> int *)
+  model.accounts
+  |> List.map (fun (a : Model.open_account) -> a.account)
+  |> List.flatten |> List.sort_uniq compare
+  |> List.mapi (fun i n -> (n, i))
+  |> List.to_seq |> StringMap.of_seq
+
+let dump_tag_id_map (model : Model.t) =
+  (model.accounts |> List.map (fun (a : Model.open_account) -> a.tags))
+  @ (model.transactions |> List.map (fun (t : Model.transaction) -> t.tags))
+  |> List.flatten |> List.sort_uniq compare
+  |> List.mapi (fun i n -> (n, i))
+  |> List.to_seq |> StringMap.of_seq
+
+let dump_account_records (model : Model.t) account_id_map =
+  (* (id, name, currency, parent_id, kind) list *)
+  model.accounts
+  |> List.map (fun (a : Model.open_account) ->
+         a.account
+         |> List.fold_left
+              (fun (parent_id, recs) name ->
+                let id = account_id_map |> StringMap.find name in
+                (Some id, (id, name, a.currency, parent_id, a.kind) :: recs))
+              (None, [])
+         |> snd)
+  |> List.flatten |> List.sort_uniq compare
+
+let dump_account_tag_records (model : Model.t) account_id_map tag_id_map =
+  (* (account_id, tag_id) list *)
+  model.accounts
+  |> List.map (fun (a : Model.open_account) ->
+         let a_id = account_id_map |> StringMap.find (list_last a.account) in
+         a.tags
+         |> List.map (fun tag ->
+                let tag_id = tag_id_map |> StringMap.find tag in
+                (a_id, tag_id)))
+  |> List.flatten |> List.sort_uniq compare
+
+let dump_transaction_records_and_posting_records (model : Model.t)
+    account_id_map =
+  (* (id, date, narration) list *)
+  (* (id, account_id, transaction_id, amount, narration) list *)
+  model.transactions
+  |> List.fold_left
+       (fun (tx_recs, ps_recs) (tx : Model.transaction) ->
+         let tx_id = List.length tx_recs in
+         let tx_recs' =
+           (tx_id, Store.string_of_date tx.date, tx.narration) :: tx_recs
+         in
+         let ps_recs' =
+           (tx.postings
+           |> List.mapi (fun i (p : Model.posting) ->
+                  let ps_id = List.length ps_recs + i in
+                  let acc_id =
+                    account_id_map |> StringMap.find (list_last p.account)
+                  in
+                  (ps_id, acc_id, tx_id, Option.get p.amount, p.narration)))
+           @ ps_recs
+         in
+         (tx_recs', ps_recs'))
+       ([], [])
+
+let dump_transaction_tag_records (model : Model.t) transaction_records
+    tag_id_map =
+  (* (transaction_id, tag_id) list *)
+  model.transactions
+  |> List.map (fun (t : Model.transaction) ->
+         let tx_id = List.length transaction_records in
+         t.tags
+         |> List.map (fun tag ->
+                let tag_id = tag_id_map |> StringMap.find tag in
+                (tx_id, tag_id)))
+  |> List.flatten |> List.sort_uniq compare
+
 let dump uri (model : Model.t) =
+  (* Prepare data for insertion *)
+  let account_id_map = dump_account_id_map model in
+  let tag_id_map = dump_tag_id_map model in
+  let account_records = dump_account_records model account_id_map in
+  let account_tag_records =
+    dump_account_tag_records model account_id_map tag_id_map
+  in
+  let transaction_records, posting_records =
+    dump_transaction_records_and_posting_records model account_id_map
+  in
+  let transaction_tag_records =
+    dump_transaction_tag_records model transaction_records tag_id_map
+  in
+
   let%lwt con = Caqti_lwt.connect (Uri.of_string uri) >>= Caqti_lwt.or_fail in
   Store.create_accounts con;%lwt
   Store.create_transactions con;%lwt
@@ -250,6 +362,19 @@ let dump uri (model : Model.t) =
   Store.create_transaction_tags con;%lwt
   Store.create_account_tags con;%lwt
 
+  (* Insert accounts *)
+  let _ =
+    Printf.sprintf
+      {|INSERT INTO accounts (id, name, currency, parent_id, kind) VALUES %s|}
+      (account_records
+      |> List.map (fun (id, name, currency, parent_id, kind) ->
+             Printf.sprintf "(%d, %s, %s, %s, %d)" id name currency
+               (parent_id
+               |> Option.fold ~none:"NULL" ~some:(fun i -> string_of_int i))
+               (Model.int_of_account_kind kind))
+      |> String.concat " ")
+  in
+
   (model.accounts
   |> Lwt_list.iter_s @@ fun (acc : Model.open_account) ->
      let%lwt acc_id =
@@ -266,6 +391,23 @@ let dump uri (model : Model.t) =
 
   Store.create_full_accounts_view con;%lwt
 
+  let%lwt tx_ids = Store.insert_transactions con model.transactions in
+
+  let tags =
+    model.transactions
+    |> List.map (fun (tx : Model.transaction) -> tx.tags)
+    |> List.flatten |> List.sort_uniq compare
+  in
+  let%lwt tag_ids = Store.insert_tags con tags in
+  let tag_name_to_id =
+    List.compose tags tag_ids |> List.to_seq |> Hashtbl.of_seq
+  in
+  List.compose model.transactions tx_ids
+  |> List.map (fun ((tx : Model.transaction), tx_id) ->
+         tx.tags
+         |> List.map (fun name -> (tx_id, Hashtbl.find name tag_name_to_id)))
+  |> List.flatten |> Store.insert_transaction_tags;%lwt
+
   (model.transactions
   |> Lwt_list.iter_s @@ fun (tx : Model.transaction) ->
      let%lwt tx_id =