diff --git a/extra/money/money-tests.factor b/extra/money/money-tests.factor index 78c168015f..226b712676 100644 --- a/extra/money/money-tests.factor +++ b/extra/money/money-tests.factor @@ -12,10 +12,14 @@ IN: money.tests [ 1/10 ] [ DECIMAL: .1 ] unit-test [ 1/10 ] [ DECIMAL: 0.1 ] unit-test [ 1/10 ] [ DECIMAL: 00.10 ] unit-test - - +[ 23 ] [ DECIMAL: 23 ] unit-test +[ -23 ] [ DECIMAL: -23 ] unit-test +[ -23-1/100 ] [ DECIMAL: -23.01 ] unit-test [ "DECIMAL: ." eval ] must-fail [ "DECIMAL: f" eval ] must-fail [ "DECIMAL: 0.f" eval ] must-fail [ "DECIMAL: f.0" eval ] must-fail + +[ "$100.00" ] [ DECIMAL: 100.0 money>string ] unit-test +[ "$0.00" ] [ DECIMAL: 0.0 money>string ] unit-test diff --git a/extra/money/money.factor b/extra/money/money.factor index 5fa76d5f53..b7da97ca06 100644 --- a/extra/money/money.factor +++ b/extra/money/money.factor @@ -3,28 +3,31 @@ namespaces make sequences splitting grouping combinators continuations ; IN: money +SYMBOL: currency-token +CHAR: $ \ currency-token set-global + : dollars/cents ( dollars -- dollars cents ) 100 * 100 /mod round ; +: (money>string) ( dollars cents -- string ) + [ number>string ] bi@ + [ 3 group "," join ] + [ 2 CHAR: 0 pad-left ] bi* "." swap 3append ; + : money>string ( object -- string ) - dollars/cents [ - "$" % - swap number>string - 3 group "," join % - "." % number>string 2 CHAR: 0 pad-left % - ] "" make ; + dollars/cents (money>string) currency-token get prefix ; -: money. ( object -- ) - money>string print ; +: money. ( object -- ) money>string print ; -ERROR: not-a-decimal x ; +ERROR: not-an-integer x ; : parse-decimal ( str -- ratio ) "." split1 - >r dup "-" head? [ drop t "0" ] [ f swap ] if r> + [ "-" ?head swap ] dip [ [ "0" ] when-empty ] bi@ - dup length - >r [ dup string>number [ nip ] [ not-a-decimal ] if* ] bi@ r> + [ + [ dup string>number [ nip ] [ not-an-integer ] if* ] bi@ + ] keep length 10 swap ^ / + swap [ neg ] when ; : DECIMAL: