calendar.*: replacing hms>timestamp and timestamp>hms with duration variants

hms>duration is better because a timestamp without a date is
invalid. This also makes it so the SQL TIME column maps to duration. Now
we can add some validation so that you aren't allowed to create invalid
timestamps.

basis/calendar/format/format-tests.factor

@@ -7,3 +7,8 @@ IN: calendar.format.tests
 
 { }
 [ { 2008 2009 } [ year. ] each ] unit-test
+
+
+{ "03:01:59" } [
+    3 hours 1 >>minute 59 >>second duration>hms
+] unit-test

basis/calendar/format/format.factor

@@ -186,9 +186,11 @@ TYPED: timestamp>ymdhms ( timestamp: timestamp -- str )
 
 M: timestamp present timestamp>string ;
 
-TYPED: duration>hm ( duration: duration -- string )
+! Duration formatting
+TYPED: duration>hms ( duration: duration -- str )
     [ duration>hours >integer 24 mod pad-00 ]
-    [ duration>minutes >integer 60 mod pad-00 ] bi ":" glue ;
+    [ duration>minutes >integer 60 mod pad-00 ]
+    [ second>> >integer 60 mod pad-00 ] tri 3array ":" join ;
 
 TYPED: duration>human-readable ( duration: duration -- string )
     [
@@ -204,5 +206,5 @@ TYPED: duration>human-readable ( duration: duration -- string )
                 [ number>string write ]
                 [ 1 > " days, " " day, " ? write ] bi
             ] unless-zero
-        ] [ duration>hm write ] tri
+        ] [ duration>hms write ] tri
     ] with-string-writer ;

basis/calendar/parser/parser.factor

@@ -162,15 +162,6 @@ MACRO: attempt-all-quots ( quots -- quot )
 : ymdhms>timestamp ( str -- timestamp )
     [ (ymdhms>timestamp) ] with-string-reader ;
 
-: (hms>timestamp) ( -- timestamp )
-    0 0 0 read-hms instant <timestamp> ;
-
-: hms>timestamp ( str -- timestamp )
-    [ (hms>timestamp) ] with-string-reader ;
-
-: hm>timestamp ( str -- timestamp )
-    ":00" append hms>timestamp ;
-
 : (ymd>timestamp) ( -- timestamp )
     read-ymd <date-gmt> ;
 
@@ -180,3 +171,7 @@ MACRO: attempt-all-quots ( quots -- quot )
 ! Duration parsing
 : hhmm>duration ( hhmm -- duration )
     [ instant read-00 >>hour read-00 >>minute ] with-string-reader ;
+
+: hms>duration ( str -- duration )
+    [ read-hms ] with-string-reader
+    instant swap >>second swap >>minute swap >>hour ;

basis/db/postgresql/lib/lib.factor

@@ -83,7 +83,7 @@ M: postgresql-result-null summary ( obj -- str )
             ] }
             { BLOB [ dup [ malloc-byte-array/length ] [ 0 ] if ] }
             { DATE [ dup [ timestamp>ymd ] when default-param-value ] }
-            { TIME [ dup [ timestamp>hms ] when default-param-value ] }
+            { TIME [ dup [ duration>hms ] when default-param-value ] }
             { DATETIME [ dup [ timestamp>ymdhms ] when default-param-value ] }
             { TIMESTAMP [ dup [ timestamp>ymdhms ] when default-param-value ] }
             { URL [ dup [ present ] when default-param-value ] }
@@ -162,7 +162,7 @@ M: postgresql-malloc-destructor dispose ( obj -- )
         { TEXT [ pq-get-string ] }
         { VARCHAR [ pq-get-string ] }
         { DATE [ pq-get-string dup [ ymd>timestamp ] when ] }
-        { TIME [ pq-get-string dup [ hms>timestamp ] when ] }
+        { TIME [ pq-get-string dup [ hms>duration ] when ] }
         { TIMESTAMP [ pq-get-string dup [ ymdhms>timestamp ] when ] }
         { DATETIME [ pq-get-string dup [ ymdhms>timestamp ] when ] }
         { BLOB [ pq-get-blob ] }

basis/db/sqlite/lib/lib.factor

@@ -102,7 +102,7 @@ ERROR: sqlite-sql-error < sql-error n string ;
         { VARCHAR [ sqlite-bind-text-by-name ] }
         { DOUBLE [ sqlite-bind-double-by-name ] }
         { DATE [ timestamp>ymd sqlite-bind-text-by-name ] }
-        { TIME [ timestamp>hms sqlite-bind-text-by-name ] }
+        { TIME [ duration>hms sqlite-bind-text-by-name ] }
         { DATETIME [ timestamp>ymdhms sqlite-bind-text-by-name ] }
         { TIMESTAMP [ timestamp>ymdhms sqlite-bind-text-by-name ] }
         { BLOB [ sqlite-bind-blob-by-name ] }
@@ -171,7 +171,7 @@ ERROR: sqlite-sql-error < sql-error n string ;
         { TEXT [ sqlite3_column_text ] }
         { VARCHAR [ sqlite3_column_text ] }
         { DATE [ sqlite3_column_text dup [ ymd>timestamp ] when ] }
-        { TIME [ sqlite3_column_text dup [ hms>timestamp ] when ] }
+        { TIME [ sqlite3_column_text dup [ hms>duration ] when ] }
         { TIMESTAMP [ sqlite3_column_text dup [ ymdhms>timestamp ] when ] }
         { DATETIME [ sqlite3_column_text dup [ ymdhms>timestamp ] when ] }
         { BLOB [ sqlite-column-blob ] }

basis/db/sqlite/sqlite.factor

@@ -1,10 +1,9 @@
 ! Copyright (C) 2005, 2008 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors classes.tuple combinators db db.private
+USING: accessors classes.tuple combinators db db.private db.queries
-db.queries db.sqlite.errors db.sqlite.ffi db.sqlite.lib
+db.sqlite.errors db.sqlite.ffi db.sqlite.lib db.tuples
-db.tuples db.tuples.private db.types destructors interpolate
+db.tuples.private db.types destructors interpolate kernel locals math
-kernel locals math math.parser namespaces nmake random sequences
+math.parser namespaces nmake random sequences sequences.deep ;
-sequences.deep ;
 IN: db.sqlite
 
 TUPLE: sqlite-db path ;

basis/db/tuples/tuples-tests.factor

@@ -1,11 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io.files io.files.temp kernel tools.test db db.tuples classes
+USING: accessors calendar calendar.parser classes continuations
-db.types continuations namespaces math
+db.tester db.tuples db.types kernel math math.intervals math.ranges
-prettyprint calendar sequences db.sqlite math.intervals
+namespaces random sequences strings tools.test urls ;
-db.postgresql accessors random math.bitwise system
-math.ranges strings urls fry db.tuples.private db.private
-db.tester ;
 FROM: math.ranges => [a,b] ;
 IN: db.tuples.tests
 
@@ -87,7 +84,7 @@ SYMBOL: person4
             3.14
             T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } }
             T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } }
-            T{ timestamp f 0 0 0 12 34 56 T{ duration f 0 0 0 0 0 0 } }
+            T{ duration f 0 0 0 12 34 56 }
             B{ 115 116 111 114 101 105 110 97 98 108 111 98 }
         }
     ] [ T{ person f 3 } select-tuple ] unit-test
@@ -103,7 +100,7 @@ SYMBOL: person4
             3.14
             T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } }
             T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } }
-            T{ timestamp f 0 0 0 12 34 56 T{ duration f 0 0 0 0 0 0 } }
+            T{ duration f 0 0 0 12 34 56 }
             f
             H{ { 1 2 } { 3 4 } { 5 "lol" } }
             URL" http://www.google.com/search?hl=en&q=trailer+park+boys&btnG=Google+Search"
@@ -112,6 +109,21 @@ SYMBOL: person4
 
     [ ] [ person drop-table ] unit-test ;
 
+: teddy-data ( -- name age real ts date time blob factor-blob url )
+    "teddy" 10 3.14
+    "2008-03-05 16:24:11" ymdhms>timestamp
+    "2008-11-22 00:00:00" ymdhms>timestamp
+    "12:34:56" hms>duration
+    B{ 115 116 111 114 101 105 110 97 98 108 111 98 } f f ;
+
+: eddie-data ( -- name age real ts date time blob factor-blob url )
+    "eddie" 10 3.14
+    "2008-03-05 16:24:11" ymdhms>timestamp
+    "2008-11-22 00:00:00" ymdhms>timestamp
+    "12:34:56" hms>duration
+    f H{ { 1 2 } { 3 4 } { 5 "lol" } }
+    URL" http://www.google.com/search?hl=en&q=trailer+park+boys&btnG=Google+Search" ;
+
 : db-assigned-person-schema ( -- )
     person "PERSON"
     {
@@ -128,16 +140,8 @@ SYMBOL: person4
     } define-persistent
     "billy" 10 3.14 f f f f f f <person> person1 set
     "johnny" 10 3.14 f f f f f f <person> person2 set
-    "teddy" 10 3.14
+    teddy-data <person> person3 set
-        T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } }
+    eddie-data <person> person4 set ;
-        T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } }
-        T{ timestamp f 0 0 0 12 34 56 T{ duration f 0 0 0 0 0 0 } }
-        B{ 115 116 111 114 101 105 110 97 98 108 111 98 } f f <person> person3 set
-    "eddie" 10 3.14
-        T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } }
-        T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } }
-        T{ timestamp f 0 0 0 12 34 56 T{ duration f 0 0 0 0 0 0 } }
-        f H{ { 1 2 } { 3 4 } { 5 "lol" } } URL" http://www.google.com/search?hl=en&q=trailer+park+boys&btnG=Google+Search"  <person> person4 set ;
 
 : user-assigned-person-schema ( -- )
     person "PERSON"
@@ -155,18 +159,8 @@ SYMBOL: person4
     } define-persistent
     1 "billy" 10 3.14 f f f f f f <user-assigned-person> person1 set
     2 "johnny" 10 3.14 f f f f f f <user-assigned-person> person2 set
-    3 "teddy" 10 3.14
+    3 teddy-data <user-assigned-person> person3 set
-        T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } }
+    4 eddie-data <user-assigned-person> person4 set ;
-        T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } }
-        T{ timestamp f 0 0 0 12 34 56 T{ duration f 0 0 0 0 0 0 } }
-        B{ 115 116 111 114 101 105 110 97 98 108 111 98 }
-        f f <user-assigned-person> person3 set
-    4 "eddie" 10 3.14
-        T{ timestamp f 2008 3 5 16 24 11 T{ duration f 0 0 0 0 0 0 } }
-        T{ timestamp f 2008 11 22 0 0 0 T{ duration f 0 0 0 0 0 0 } }
-        T{ timestamp f 0 0 0 12 34 56 T{ duration f 0 0 0 0 0 0 } }
-        f H{ { 1 2 } { 3 4 } { 5 "lol" } } URL" http://www.google.com/search?hl=en&q=trailer+park+boys&btnG=Google+Search" <user-assigned-person> person4 set ;
-
 
 TUPLE: paste n summary author channel mode contents timestamp annotations ;
 TUPLE: annotation n paste-id summary author mode contents ;
@@ -625,6 +619,25 @@ compound-foo "COMPOUND_FOO"
 [ test-compound-primary-key ] test-sqlite
 [ test-compound-primary-key ] test-postgresql
 
+TUPLE: timez id time ;
+
+timez "TIMEZ"
+{
+    { "id" "ID" +db-assigned-id+ }
+    { "time" "TIME" TIME }
+} define-persistent
+
+: test-time-types ( -- )
+    timez ensure-table
+    timez new 3 hours >>time insert-tuple
+    {
+        T{ duration f 0 0 0 3 0 0 }
+    } [
+        timez new 3 hours >>time select-tuple time>>
+    ] unit-test ;
+
+[ test-time-types ] test-sqlite
+[ test-time-types ] test-postgresql
 
 TUPLE: example id data ;