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.

diff --git a/basis/calendar/format/format-tests.factor b/basis/calendar/format/format-tests.factor
index 4b92c7dad7b39000ce2d9d756d082fc394e326a4..349a493e4aeab3d5bfe001ff322068d9246455a6 100644 (file)
--- a/basis/calendar/format/format-tests.factor
+++ b/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

diff --git a/basis/calendar/format/format.factor b/basis/calendar/format/format.factor
index 4e1cd2adaa9541a4214cdcfd283baa262ca33cbd..9506bda581cda08f071f9e4d2693921d3b3ea9e1 100644 (file)
--- a/basis/calendar/format/format.factor
+++ b/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 ;

diff --git a/basis/calendar/parser/parser.factor b/basis/calendar/parser/parser.factor
index 03398f97735f18557fc886ab55929b16930b2313..5f0894cde622f00a98c7e4c7edc71103cbae251e 100644 (file)
--- a/basis/calendar/parser/parser.factor
+++ b/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 ;

diff --git a/basis/db/postgresql/lib/lib.factor b/basis/db/postgresql/lib/lib.factor
index a90bdf3783caa75e621e966b84110f607eed80f7..701e0f96638432e3ce4575813a52b75c8ecbf977 100644 (file)
--- a/basis/db/postgresql/lib/lib.factor
+++ b/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 ] }

diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor
index f6c26f4d07bb542a54db44208caf558ff7b59570..edc8a39f9e948017b4fc13576095b7bbd93ff532 100644 (file)
--- a/basis/db/sqlite/lib/lib.factor
+++ b/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 ] }

diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor
index 62b4bde10528ae550038d51542c919a3ce033105..29abb0422ad9d0adc8261d34d8a064b787ac2047 100644 (file)
--- a/basis/db/sqlite/sqlite.factor
+++ b/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
-db.queries db.sqlite.errors db.sqlite.ffi db.sqlite.lib
-db.tuples db.tuples.private db.types destructors interpolate
-kernel locals math math.parser namespaces nmake random sequences
-sequences.deep ;
+USING: accessors classes.tuple combinators db db.private db.queries
+db.sqlite.errors db.sqlite.ffi db.sqlite.lib db.tuples
+db.tuples.private db.types destructors interpolate kernel locals math
+math.parser namespaces nmake random sequences sequences.deep ;
 IN: db.sqlite
 
 TUPLE: sqlite-db path ;

diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor
index 4a04e0c32cfb5ece5aaddd6505fe9959e7aa0c41..4958ef9f6ae2f644cc73908cfbb7548766d3c244 100644 (file)
--- a/basis/db/tuples/tuples-tests.factor
+++ b/basis/db/tuples/tuples-tests.factor
@@ -1,16 +1,13 @@
 ! 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
-db.types continuations namespaces math
-prettyprint calendar sequences db.sqlite math.intervals
-db.postgresql accessors random math.bitwise system
-math.ranges strings urls fry db.tuples.private db.private
-db.tester ;
+USING: accessors calendar calendar.parser classes continuations
+db.tester db.tuples db.types kernel math math.intervals math.ranges
+namespaces random sequences strings tools.test urls ;
 FROM: math.ranges => [a,b] ;
 IN: db.tuples.tests
 
 TUPLE: person the-id the-name the-number the-real
-ts date time blob factor-blob url ;
+    ts date time blob factor-blob url ;
 
 : <person> ( name age real ts date time blob factor-blob url -- person )
     person new
@@ -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
-        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 } }
-        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 ;
+    teddy-data <person> person3 set
+    eddie-data <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
-        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 } }
-        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 ;
-
+    3 teddy-data <user-assigned-person> person3 set
+    4 eddie-data <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 ;