Skip to content

Commit

Permalink
wip
Browse files Browse the repository at this point in the history
  • Loading branch information
ushitora-anqou committed Aug 26, 2023
1 parent 2fa9c1a commit 94c1301
Show file tree
Hide file tree
Showing 3 changed files with 168 additions and 0 deletions.
5 changes: 5 additions & 0 deletions bin/main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,11 @@ let () =
required & pos 0 (some string) None & info ~docv:"IN-FILE" [])
$ Arg.(
required & pos 1 (some string) None & info ~docv:"OUT-FILE" []));
v (info "dump-csv")
Term.(
const dump_csv
$ Arg.(
required & pos 0 (some string) None & info ~docv:"IN-FILE" []));
v (info "generate")
Term.(
const generate
Expand Down
5 changes: 5 additions & 0 deletions lib/command.ml
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,11 @@ let dump in_filename out_filename =
in
Lwt.return_unit

let dump_csv in_filename =
let m, _ = Loader.load_file in_filename in
Sql_writer.dump_csv m;
()

let serve =
let interface, port =
match
Expand Down
158 changes: 158 additions & 0 deletions lib/sql_writer.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -241,6 +257,116 @@ 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_csv (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 oc = open_out "accounts.csv" in
account_records
|> List.iter (fun (id, name, currency, parent_id, kind) ->
Printf.fprintf oc "%d,%s,%s,%s,%d\n" id name currency
(parent_id
|> Option.fold ~none:"NULL" ~some:(fun id -> string_of_int id))
(Model.int_of_account_kind kind));
close_out oc;
let oc = open_out "tags.csv" in
()
let dump uri (model : Model.t) =
let%lwt con = Caqti_lwt.connect (Uri.of_string uri) >>= Caqti_lwt.or_fail in
Store.create_accounts con;%lwt
Expand All @@ -250,6 +376,20 @@ 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 =
Expand All @@ -266,6 +406,24 @@ 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 =
Expand Down

0 comments on commit 94c1301

Please sign in to comment.