Reddit DailyProgrammer - "Little Accountant"

challenge-304-accounts.reb

Rebol [
    see: https://www.reddit.com/r/dailyprogrammer/comments/5wnbsi/20170228_challenge_304_easy_little_accountant/
]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Helper functions

tie: function [s delim /string] [
    s: next s
    forskip s 2 [insert s delim]
    if string [return to-string head s]
    head s
]

make-months-rule: does [tie map-each n system/locale/months [copy/part n 3] '|]

starts-with?: function [s s?] [(copy/part s length? s?) = s?]

range-of: function [data where from til] [
    trigger: off
    if from = "*" [trigger: on]
    collect [
        foreach d data [
            if starts-with? d/:where from [trigger: on]
            if starts-with? d/:where til  [til: d/:where trigger: off]
            if any [trigger  til = d/:where] [keep d]
        ]
    ]
]

max-length?: function [s] [first maximum-of sort map-each n s [length? to-string n]]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; parser

digits: charset "1234567890"
number: [some digits]
months: make-months-rule
MMM-YY: [months "-" 2 digits]

parse-journal: function [journal-input] [
    data: make block! 0
    total-debit: total-credit: 0

    account: [copy a: number]
    period:  [copy p: MMM-YY]
    debit:   [copy d: number (d: to-integer d)]
    credit:  [copy c: number (c: to-integer c)]
    journal: [
        account ";" period ";" debit ";" credit ";" [newline | end] (
            total-debit:  total-debit  + d
            total-credit: total-credit + c
            append data object [account: a  period: p  debit: d  credit: c]
        )
    ]

    unless parse journal-input [
        {ACCOUNT;PERIOD;DEBIT;CREDIT;} newline
        some journal
    ][do make error! {Unable to parse journal file}]

    unless zero? (balance: total-debit - total-credit) [do make error! {Journal not balanced}]

    append data object [
        account: "TOTAL" description: {} debit: total-debit credit: total-credit balance: balance
    ]
]

parse-accounts: function [accounts-input] [
    data: make block! 0
    account: [copy a: number]
    label:   [copy l: to ";"]
    accounts: [
        account ";" label ";" [newline | end] (
            append data object [account: a description: l debit: credit: balance: 0]
        )
    ]

    unless parse accounts-input [
        {ACCOUNT;LABEL;} newline
        some accounts
    ][do make error! {Unable to parse Chart of accounts file}]

    data
]

parse-input: function [s] [
    unless parse s [
        copy ac-start:     ["*" | number] space
        copy ac-end:       ["*" | number] space
        copy period-start: ["*" | MMM-YY] space
        copy period-end:   ["*" | MMM-YY] space
        copy output:       ["CSV" | "TEXT"]
    ][do make error! {Invalid input}]

    object compose [
        ac-start:     (ac-start)     ac-end:     (ac-end)
        period-start: (period-start) period-end: (period-end)
        output:       (output)
    ]
]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; accounts logic

tally-accounts: function [ac-start ac-end period-start period-end] [
    journal-data: parse-journal  to-string read %journal.txt
    account-data: parse-accounts to-string read %accounts.txt
    footer: take/last journal-data

    ;; filter journal/account ranges
    journals: range-of journal-data 'period period-start period-end
    accounts: collect [
        foreach s range-of account-data 'account ac-start ac-end [keep s/account keep s]
    ]
    journal-periods: map-each n journals [n/period]

    ;; remove journals outside of account range
    account-nos: extract/index accounts 2 1
    remove-each n journals [not find account-nos n/account]

    ;; remove accounts that have no journal
    journal-acs: map-each n journals [n/account]
    remove-each [n s] accounts [not find journal-acs n]

    foreach j journals [
        a: select accounts j/account
        a/debit:   a/debit  + j/debit
        a/credit:  a/credit + j/credit
        a/balance: a/debit  - a/credit
    ]

    debit: credit: balance: 0
    forskip accounts 2 [
        debit:   debit   + accounts/2/debit
        credit:  credit  + accounts/2/credit
        balance: balance + accounts/2/balance
    ]

    header: object [
        ac-start:     first account-nos      ac-end:     last account-nos
        period-start: first journal-periods  period-end: last journal-periods
        debit:        footer/debit           credit:     footer/credit
        header:       map-each n words-of footer [uppercase to-string n]
    ]

    append footer compose [debit: (debit) credit: (credit) balance: (balance)]

    data: extract/index accounts 2 2
    insert data header
    append data footer
]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; rendering

render: function [data output] [
    header: take data
    rejoin [
        {Total Debit :} header/debit { Total Credit :} header/credit newline
        {Balance from account } header/ac-start { to } header/ac-end space
        {from period } header/period-start { to } header/period-end newline
        newline {Balance:}

        switch/default output [
            "csv" [
                rejoin [
                    newline tie/string header/header ";" ";"
                    map-each n data [rejoin [newline tie/string values-of n ";" ";"]]
                ]
            ]
            "text" [
                cols:   length? header/header
                width:  max 16 max-length? map-each n data [n/description] ;; widest column
                width-: negate width
                f:      reduce [newline width "|" width "|" width- "|" width- "|" width- "|"]
                rejoin [
                    format f header/header
                    newline append/dup copy {} "-" width * cols + cols
                    map-each d data [
                        format f reduce [
                            d/account d/description
                            d/debit   d/credit   d/balance
                        ]
                    ]
                ]
            ]
        ][do make error! {Invalid output type}]
    ]
]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; main

challenge-304: function [s] [
    u: parse-input s
    print render tally-accounts u/ac-start u/ac-end u/period-start u/period-end u/output
]