steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
char-rename
Björn Lindqvist 2017-01-04 12:47:45 +01:00
parent c48319cb35
commit b17590db24
7 changed files with 66 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
basis/calendar/format/format-tests.factor
View File

@ -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

8
basis/calendar/format/format.factor
View File

@ -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 ;

13
basis/calendar/parser/parser.factor
View File

@ -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 ;

4
basis/db/postgresql/lib/lib.factor
View File

@ -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 ] }

4
basis/db/sqlite/lib/lib.factor
View File

@ -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 ] }

9
basis/db/sqlite/sqlite.factor
View File

@ -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 ;

75
basis/db/tuples/tuples-tests.factor
View File

@ -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 ;