1 files changed, 109 insertions(+), 4 deletions(-)

M inventory.retro

@@ 1,7 1,95 @@
 #!/usr/local/bin/retro
 
+# Time routines
+
+RETRO Forth comes with limited support for time: it's got the "clock:"
+namespace, but it only supports retrieval of current time.  I need
+much more to compare expiry dates.
+
+First, I need to parse a date.  I expect all dates to be of the
+YYYY.MM.DD format.  I am going to represent them as numbers of days
+since 1999.12.31 (so 2000.01.01 becomes 1).
+
+~~~
+:date:month-days (n-m)
+   #0 [  #0 ] case
+   #1 [ #31 ] case
+   #2 [ #28 ] case
+   #3 [ #31 ] case
+   #4 [ #30 ] case
+   #5 [ #31 ] case
+   #6 [ #30 ] case
+   #7 [ #31 ] case
+   #8 [ #31 ] case
+   #9 [ #30 ] case
+  #10 [ #31 ] case
+  #11 [ #30 ] case
+  #12 [ #31 ] case
+  'ERROR:_Invalid_month_%n s:format s:put nl ;
+
+:date:years-since (n-m)
+  #2000 - ;
+
+{{
+'Month var
+'DaysTotal var
+
+:done? (-f) @Month #1 lteq? ;
+:next-month (-n)
+  &Month v:dec
+  @Month date:month-days
+  &DaysTotal v:inc-by ;
+---reveal---
+:date:month-as-days (n-m)
+  !Month
+  #0 !DaysTotal
+  [ next-month done? ] until
+  @DaysTotal ;
+}}
+
+:date:tokenize (s-a)
+  $. s:tokenize [ s:to-number ] a:map ;
+
+:date:parse (s-)
+  date:tokenize
+  [ #0 a:fetch date:years-since #365 * ]
+  [ #1 a:fetch date:month-as-days ]
+  [ #2 a:fetch ] tri + +
+  ;
+
+:date:from-clock (-n)
+  clock:year date:years-since #365 *
+  clock:month date:month-as-days +
+  clock:day + ;
+~~~
+
+```
+#2010 date:years-since
+  dup #10 eq? [ 'date:years-since_SUCCESS=%n ] [ 'date:years-since_FAIL=%n ] choose s:format s:put nl
+
+#2 date:month-days
+  dup #28 eq? [ 'date:month-days_SUCCESS=%n ] [ 'date:month-days_FAIL=%n ] choose s:format s:put nl
+
+#4 date:month-as-days
+  dup #90 eq? [ 'date:month-as-days_SUCCESS=%n s:format ] [ 'date:month-as-days_FAIL=%n ] choose s:format s:put nl
+
+'2020.04.01 date:parse
+  dup #7391 eq? [ 'date:parse_SUCCESS=%n ] [ 'date:parse_FAIL=%n ] choose s:format s:put nl
+
+date:from-clock
+  'date:from-clock=%n s:format s:put nl
+```
+
+
 # Inventorty database parser
 
+First, let's prepare to report parsing errors.
+
+~~~
+:err:unrecognised-input (s-)
+  'ERROR:_Unrecognized_input:_%s s:format s:put nl ;
+~~~
+
 1st level headers begin sections of items of similar types, 2nd level
 headers provide fine-grained groups for products.
 


@@ 23,7 111,13 @@ semicolons.
 
 ~~~
 :parse-product (s-a)
-  $; s:tokenize [ s:trim ] a:map ;
+  $; s:tokenize [ s:trim ] a:map
+  [ [ #2 a:fetch date:parse ] sip
+    #2 a:th store ] sip ;
+
+:show-product-summary (a-)
+  [ #2 a:fetch date:from-clock - ] [ #1 a:fetch ] [ #0 a:fetch ] tri
+  '%s_(%s,_%n_days_left) s:format s:put nl ;
 ~~~
 
 Each inventory line is either a markdown header (only levels 1 and 2


@@ 35,11 129,22 @@ are supported) or a list item.  Anything else will be ignored.
   [ s:trim ] dip
   '#  [ set-section    ] s:case
   '## [ set-subsection ] s:case
-  '-  [ parse-product  ] s:case
-  'Unrecognized_input:_%s s:format s:put nl ;
+  '-  [ parse-product show-product-summary ] s:case
+      err:unrecognised-input ;
 ~~~
 
+The main inventory file defaults to /home/pfm/inw.md.
+
+~~
+'/usr/home/pfm/projects/inw/inw.md 'INVENTORY_FILE s:const
+
+INVENTORY_FILE [ load-line ] file:for-each-line
+~~
+
 ```
 '#_Pasta load-line
-&Section 'Pasta s:eq? [ 'PASS s:put nl ] if
+&Section 'Pasta s:eq? [ 'Loading_sections:_PASS s:put nl ] if
+
+'-_lact.free-milk;_10;_2021.03.10 load-line
+'-_oat-milk;_1l;_2021.01.14 load-line
 ```