]> gitweb.factorcode.org Git - factor.git/commitdiff
calendar.format: moving parsing words to a new vocab calendar.parser
authorBjörn Lindqvist <bjourne@gmail.com>
Wed, 4 Jan 2017 07:50:24 +0000 (08:50 +0100)
committerBjörn Lindqvist <bjourne@gmail.com>
Wed, 4 Jan 2017 07:50:24 +0000 (08:50 +0100)
The vocab was getting big so the idea is to have all the time parsing in
calendar.parsing and only keep formatting words in calendar.format.

20 files changed:
basis/calendar/format/format-tests.factor
basis/calendar/format/format.factor
basis/calendar/format/macros/macros-tests.factor [deleted file]
basis/calendar/format/macros/macros.factor [deleted file]
basis/calendar/format/macros/summary.txt [deleted file]
basis/calendar/parser/parser-tests.factor [new file with mode: 0644]
basis/calendar/parser/parser.factor [new file with mode: 0644]
basis/calendar/parser/summary.txt [new file with mode: 0644]
basis/db/postgresql/lib/lib.factor
basis/db/sqlite/lib/lib.factor
basis/http/http.factor
basis/http/server/static/static.factor
basis/logging/parser/parser.factor
basis/syndication/syndication.factor
extra/imap/imap-tests.factor
extra/imap/imap.factor
extra/robots/robots.factor
extra/subrip-subtitles/subrip-subtitles.factor
extra/yaml/conversion/conversion.factor
extra/zeromq/examples/echo-client.factor

index 6ad41f03c2053ec062df7e0d38e8ba96cb536f57..4b92c7dad7b39000ce2d9d756d082fc394e326a4 100644 (file)
@@ -1,131 +1,9 @@
 USING: accessors calendar calendar.format io io.streams.string
 kernel math.order sequences tools.test ;
-
-{ 0 } [
-    "Z" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
-] unit-test
-
-{ 1 } [
-    "+01" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
-] unit-test
-
-{ -1 } [
-    "-01" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
-] unit-test
-
-{ -1-1/2 } [
-    "-01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
-] unit-test
-
-{ 1+1/2 } [
-    "+01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
-] unit-test
+IN: calendar.format.tests
 
 { } [ now timestamp>rfc3339 drop ] unit-test
 { } [ now timestamp>rfc822 drop ] unit-test
 
-{ 8/1000 -4 } [
-    "2008-04-19T04:56:00.008-04:00" rfc3339>timestamp
-    [ second>> ] [ gmt-offset>> hour>> ] bi
-] unit-test
-
-{ T{ duration f 0 0 0 0 0 0 } } [
-    "GMT" parse-rfc822-gmt-offset
-] unit-test
-
-{ T{ duration f 0 0 0 -5 0 0 } } [
-    "-0500" parse-rfc822-gmt-offset
-] unit-test
-
-{ T{ duration f 0 0 0 -1 0 0 } } [
-    "A" parse-rfc822-gmt-offset
-] unit-test
-
-{ T{ duration f 0 0 0 12 0 0 } } [
-    "Y" parse-rfc822-gmt-offset
-] unit-test
-
-{ T{ duration f 0 0 0 -8 0 0 } } [
-    "PST" parse-rfc822-gmt-offset
-] unit-test
-
-{ T{ timestamp f 2008 4 22 14 36 12 T{ duration f 0 0 0 0 0 0 } } } [
-    "Tue, 22 Apr 2008 14:36:12 GMT" rfc822>timestamp
-] unit-test
-
-{ t } [ now dup timestamp>rfc822 rfc822>timestamp time- 1 seconds before? ] unit-test
-
-{ t } [ now dup timestamp>cookie-string cookie-string>timestamp time- 1 seconds before? ] unit-test
-
-{ "Sun, 4 May 2008 07:00:00" } [
-    "Sun May 04 07:00:00 2008 GMT" cookie-string>timestamp
-    timestamp>string
-] unit-test
-
-{ "20080504070000" } [
-    "Sun May 04 07:00:00 2008 GMT" cookie-string>timestamp
-    timestamp>mdtm
-] unit-test
-
-{
-    T{ timestamp f
-        2008
-        5
-        26
-        0
-        37
-        42+2469/20000
-        T{ duration f 0 0 0 -5 0 0 }
-    }
-} [ "2008-05-26T00:37:42.12345-05:00" rfc3339>timestamp ] unit-test
-
-{
-    T{ timestamp
-        { year 2008 }
-        { month 10 }
-        { day 2 }
-        { hour 23 }
-        { minute 59 }
-        { second 59 }
-        { gmt-offset T{ duration f 0 0 0 0 0 0 } }
-    }
-} [ "Thursday, 02-Oct-2008 23:59:59 GMT" cookie-string>timestamp ] unit-test
-
-
 { }
 [ { 2008 2009 } [ year. ] each ] unit-test
-
-{
-    T{ timestamp
-        { year 2013 }
-        { month 4 }
-        { day 23 }
-        { hour 13 }
-        { minute 50 }
-        { second 24 }
-    }
-} [ "2013-04-23T13:50:24" rfc3339>timestamp ] unit-test
-
-{ "2001-12-14T21:59:43.100000-05:00" } [ "2001-12-14T21:59:43.1-05:00" rfc3339>timestamp timestamp>rfc3339 ] unit-test
-
-{
-    T{ timestamp
-        { year 2001 }
-        { month 12 }
-        { day 15 }
-        { hour 02 }
-        { minute 59 }
-        { second 43+1/10 }
-    }
-} [ "2001-12-15 02:59:43.1Z" rfc3339>timestamp ] unit-test
-
-{
-    T{ timestamp
-        { year 2001 }
-        { month 12 }
-        { day 15 }
-        { hour 02 }
-        { minute 59 }
-        { second 43+1/10 }
-    }
-} [ "2001-12-15        02:59:43.1Z" rfc3339>timestamp ] unit-test
index 2ec8942389f554680229f157fa4bfbb030e53486..b721f360cdf866051442ab5f4146ce09d22d8dff 100644 (file)
@@ -1,11 +1,19 @@
 ! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs calendar calendar.english
-calendar.format.macros combinators io io.streams.string kernel math
-math.functions math.order math.parser math.parser.private present
-sequences typed ;
+USING: accessors arrays calendar calendar.english combinators io
+io.streams.string kernel macros math math.order math.parser
+math.parser.private present quotations sequences typed words ;
 IN: calendar.format
 
+MACRO: formatted ( spec -- quot )
+    [
+        {
+            { [ dup word? ] [ 1quotation ] }
+            { [ dup quotation? ] [ ] }
+            [ [ nip write ] curry [ ] like ]
+        } cond
+    ] map [ cleave ] curry ;
+
 : pad-00 ( n -- str ) number>string 2 CHAR: 0 pad-head ;
 
 : pad-0000 ( n -- str ) number>string 4 CHAR: 0 pad-head ;
@@ -38,20 +46,6 @@ IN: calendar.format
 
 : YYYYY ( time -- ) year>> write-00000 ;
 
-: expect ( str -- )
-    read1 swap member? [ "Parse error" throw ] unless ;
-
-: read-00 ( -- n ) 2 read string>number ;
-
-: read-000 ( -- n ) 3 read string>number ;
-
-: read-0000 ( -- n ) 4 read string>number ;
-
-: hhmm>timestamp ( hhmm -- timestamp )
-    [
-        0 0 0 read-00 read-00 0 instant <timestamp>
-    ] with-string-reader ;
-
 GENERIC: day. ( obj -- )
 
 M: integer day. ( n -- )
@@ -161,162 +155,6 @@ M: timestamp year. ( timestamp -- )
 : timestamp>rfc3339 ( timestamp -- str )
     [ (timestamp>rfc3339) ] with-string-writer ;
 
-: signed-gmt-offset ( dt ch -- dt' )
-    { { CHAR: + [ 1 ] } { CHAR: - [ -1 ] } } case time* ;
-
-: read-rfc3339-gmt-offset ( ch -- dt )
-    {
-        { f [ instant ] }
-        { CHAR: Z [ instant ] }
-        [
-            [
-                read-00 hours
-                read1 { { CHAR: : [ read-00 ] } { f [ 0 ] } } case minutes
-                time+
-            ] dip signed-gmt-offset
-        ]
-    } case ;
-
-: read-ymd ( -- y m d )
-    read-0000 "-" expect read-00 "-" expect read-00 ;
-
-: read-hms ( -- h m s )
-    read-00 ":" expect read-00 ":" expect read-00 ;
-
-: read-rfc3339-seconds ( s -- s' ch )
-    "+-Z" read-until [
-        [ string>number ] [ length 10^ ] bi / +
-    ] dip ;
-
-: (rfc3339>timestamp) ( -- timestamp )
-    read-ymd
-    "Tt \t" expect
-    read-hms
-    read1 { { CHAR: . [ read-rfc3339-seconds ] } [ ] } case
-    read-rfc3339-gmt-offset
-    <timestamp> ;
-
-: rfc3339>timestamp ( str -- timestamp )
-    [ (rfc3339>timestamp) ] with-string-reader ;
-
-ERROR: invalid-timestamp-format ;
-
-: check-timestamp ( obj/f -- obj )
-    [ invalid-timestamp-format ] unless* ;
-
-: read-token ( seps -- token )
-    [ read-until ] keep member? check-timestamp drop ;
-
-: read-sp ( -- token ) " " read-token ;
-
-: checked-number ( str -- n )
-    string>number check-timestamp ;
-
-CONSTANT: rfc822-named-zones H{
-    { "EST" -5 }
-    { "EDT" -4 }
-    { "CST" -6 }
-    { "CDT" -5 }
-    { "MST" -7 }
-    { "MDT" -6 }
-    { "PST" -8 }
-    { "PDT" -7 }
-}
-
-: parse-rfc822-military-offset ( string -- dt )
-    first CHAR: A - {
-        -1 -2 -3 -4 -5 -6 -7 -8 -9 f -10 -11 -12
-        1 2 3 4 5 6 7 8 9 10 11 12 0
-    } nth hours ;
-
-: parse-rfc822-gmt-offset ( string -- dt )
-    {
-        { [ dup { "UTC" "GMT" } member? ] [ drop instant ] }
-        { [ dup length 1 = ] [ parse-rfc822-military-offset ] }
-        { [ dup rfc822-named-zones key? ] [ rfc822-named-zones at hours ] }
-        [
-            unclip [
-                2 cut [ string>number ] bi@ [ hours ] [ minutes ] bi* time+
-            ] dip signed-gmt-offset
-        ]
-    } cond ;
-
-: (rfc822>timestamp) ( -- timestamp )
-    timestamp new
-        "," read-token day-abbreviations3 member? check-timestamp drop
-        read1 CHAR: \s assert=
-        read-sp checked-number >>day
-        read-sp month-abbreviations index 1 + check-timestamp >>month
-        read-sp checked-number >>year
-        ":" read-token checked-number >>hour
-        ":" read-token checked-number >>minute
-        read-sp checked-number >>second
-        readln parse-rfc822-gmt-offset >>gmt-offset ;
-
-: rfc822>timestamp ( str -- timestamp )
-    [ (rfc822>timestamp) ] with-string-reader ;
-
-: check-day-name ( str -- )
-    [ day-abbreviations3 member? ] [ day-names member? ] bi or
-    check-timestamp drop ;
-
-: (cookie-string>timestamp-1) ( -- timestamp )
-    timestamp new
-        "," read-token check-day-name
-        read1 CHAR: \s assert=
-        "-" read-token checked-number >>day
-        "-" read-token month-abbreviations index 1 + check-timestamp >>month
-        read-sp checked-number >>year
-        ":" read-token checked-number >>hour
-        ":" read-token checked-number >>minute
-        read-sp checked-number >>second
-        readln parse-rfc822-gmt-offset >>gmt-offset ;
-
-: cookie-string>timestamp-1 ( str -- timestamp )
-    [ (cookie-string>timestamp-1) ] with-string-reader ;
-
-: (cookie-string>timestamp-2) ( -- timestamp )
-    timestamp new
-        read-sp check-day-name
-        read-sp month-abbreviations index 1 + check-timestamp >>month
-        read-sp checked-number >>day
-        ":" read-token checked-number >>hour
-        ":" read-token checked-number >>minute
-        read-sp checked-number >>second
-        read-sp checked-number >>year
-        readln parse-rfc822-gmt-offset >>gmt-offset ;
-
-: cookie-string>timestamp-2 ( str -- timestamp )
-    [ (cookie-string>timestamp-2) ] with-string-reader ;
-
-: cookie-string>timestamp ( str -- timestamp )
-    {
-        [ cookie-string>timestamp-1 ]
-        [ cookie-string>timestamp-2 ]
-        [ rfc822>timestamp ]
-    } attempt-all-quots ;
-
-: (ymdhms>timestamp) ( -- timestamp )
-    read-ymd " " expect read-hms instant <timestamp> ;
-
-: 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> ;
-
-: ymd>timestamp ( str -- timestamp )
-    [ (ymd>timestamp) ] with-string-reader ;
-
 : (timestamp>ymd) ( timestamp -- )
     { YYYY "-" MM "-" DD } formatted ;
 
diff --git a/basis/calendar/format/macros/macros-tests.factor b/basis/calendar/format/macros/macros-tests.factor
deleted file mode 100644 (file)
index 5c95129..0000000
+++ /dev/null
@@ -1,15 +0,0 @@
-USING: tools.test kernel accessors ;
-IN: calendar.format.macros
-
-{ 2 } [ { [ 2 ] } attempt-all-quots ] unit-test
-
-{ 2 } [ { [ 1 throw ] [ 2 ] } attempt-all-quots ] unit-test
-
-[ { [ 1 throw ] } attempt-all-quots ] [ 1 = ] must-fail-with
-
-: compiled-test-1 ( -- n )
-    { [ 1 throw ] [ 2 ] } attempt-all-quots ;
-
-\ compiled-test-1 def>> must-infer
-
-{ 2 } [ compiled-test-1 ] unit-test
diff --git a/basis/calendar/format/macros/macros.factor b/basis/calendar/format/macros/macros.factor
deleted file mode 100644 (file)
index 901fe22..0000000
+++ /dev/null
@@ -1,19 +0,0 @@
-USING: macros kernel words quotations io sequences combinators
-continuations ;
-IN: calendar.format.macros
-
-MACRO: formatted ( spec -- quot )
-    [
-        {
-            { [ dup word? ] [ 1quotation ] }
-            { [ dup quotation? ] [ ] }
-            [ [ nip write ] curry [ ] like ]
-        } cond
-    ] map [ cleave ] curry ;
-
-MACRO: attempt-all-quots ( quots -- quot )
-    dup length 1 = [ first ] [
-        unclip swap
-        [ nip attempt-all-quots ] curry
-        [ recover ] 2curry
-    ] if ;
diff --git a/basis/calendar/format/macros/summary.txt b/basis/calendar/format/macros/summary.txt
deleted file mode 100644 (file)
index 92c347a..0000000
+++ /dev/null
@@ -1 +0,0 @@
-Implementation details for calendar.format
diff --git a/basis/calendar/parser/parser-tests.factor b/basis/calendar/parser/parser-tests.factor
new file mode 100644 (file)
index 0000000..66f8596
--- /dev/null
@@ -0,0 +1,151 @@
+USING: accessors calendar calendar.format calendar.parser io
+io.streams.string kernel math.order tools.test ;
+IN: calendar.parser.tests
+
+! attempt-all-quots
+{ 2 } [ { [ 2 ] } attempt-all-quots ] unit-test
+
+{ 2 } [ { [ 1 throw ] [ 2 ] } attempt-all-quots ] unit-test
+
+[ { [ 1 throw ] } attempt-all-quots ] [ 1 = ] must-fail-with
+
+: compiled-test-1 ( -- n )
+    { [ 1 throw ] [ 2 ] } attempt-all-quots ;
+
+\ compiled-test-1 def>> must-infer
+
+{ 2 } [ compiled-test-1 ] unit-test
+
+! cookie-string>timestamp
+{
+    T{ timestamp
+        { year 2008 }
+        { month 10 }
+        { day 2 }
+        { hour 23 }
+        { minute 59 }
+        { second 59 }
+        { gmt-offset T{ duration f 0 0 0 0 0 0 } }
+    }
+} [ "Thursday, 02-Oct-2008 23:59:59 GMT" cookie-string>timestamp ] unit-test
+
+{ "Sun, 4 May 2008 07:00:00" } [
+    "Sun May 04 07:00:00 2008 GMT" cookie-string>timestamp
+    timestamp>string
+] unit-test
+
+{ "20080504070000" } [
+    "Sun May 04 07:00:00 2008 GMT" cookie-string>timestamp
+    timestamp>mdtm
+] unit-test
+
+{ t } [
+    now dup timestamp>cookie-string cookie-string>timestamp
+    time- 1 seconds before?
+] unit-test
+
+! parse-rfc822-gmt-offset
+{ T{ duration f 0 0 0 0 0 0 } } [
+    "GMT" parse-rfc822-gmt-offset
+] unit-test
+
+{ T{ duration f 0 0 0 -5 0 0 } } [
+    "-0500" parse-rfc822-gmt-offset
+] unit-test
+
+{ T{ duration f 0 0 0 -1 0 0 } } [
+    "A" parse-rfc822-gmt-offset
+] unit-test
+
+{ T{ duration f 0 0 0 12 0 0 } } [
+    "Y" parse-rfc822-gmt-offset
+] unit-test
+
+{ T{ duration f 0 0 0 -8 0 0 } } [
+    "PST" parse-rfc822-gmt-offset
+] unit-test
+
+! read-rfc3339-gmt-offset
+{ 1+1/2 } [
+    "+01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
+] unit-test
+
+{ -1-1/2 } [
+    "-01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
+] unit-test
+
+{ 0 } [
+    "Z" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
+] unit-test
+
+{ 1 } [
+    "+01" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
+] unit-test
+
+{ -1 } [
+    "-01" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
+] unit-test
+
+! rfc3339>timestamp
+{
+    T{ timestamp
+        { year 2013 }
+        { month 4 }
+        { day 23 }
+        { hour 13 }
+        { minute 50 }
+        { second 24 }
+    }
+} [ "2013-04-23T13:50:24" rfc3339>timestamp ] unit-test
+
+{
+    T{ timestamp
+        { year 2001 }
+        { month 12 }
+        { day 15 }
+        { hour 02 }
+        { minute 59 }
+        { second 43+1/10 }
+    }
+} [ "2001-12-15 02:59:43.1Z" rfc3339>timestamp ] unit-test
+
+{
+    T{ timestamp
+        { year 2001 }
+        { month 12 }
+        { day 15 }
+        { hour 02 }
+        { minute 59 }
+        { second 43+1/10 }
+    }
+} [ "2001-12-15        02:59:43.1Z" rfc3339>timestamp ] unit-test
+
+{
+    T{ timestamp f
+        2008
+        5
+        26
+        0
+        37
+        42+2469/20000
+        T{ duration f 0 0 0 -5 0 0 }
+    }
+} [ "2008-05-26T00:37:42.12345-05:00" rfc3339>timestamp ] unit-test
+
+{ 8/1000 -4 } [
+    "2008-04-19T04:56:00.008-04:00" rfc3339>timestamp
+    [ second>> ] [ gmt-offset>> hour>> ] bi
+] unit-test
+
+{ "2001-12-14T21:59:43.100000-05:00" } [
+    "2001-12-14T21:59:43.1-05:00" rfc3339>timestamp timestamp>rfc3339
+] unit-test
+
+! rfc822>timestamp
+{ t } [
+    now dup timestamp>rfc822 rfc822>timestamp time- 1 seconds before?
+] unit-test
+
+{ T{ timestamp f 2008 4 22 14 36 12 T{ duration f 0 0 0 0 0 0 } } } [
+    "Tue, 22 Apr 2008 14:36:12 GMT" rfc822>timestamp
+] unit-test
diff --git a/basis/calendar/parser/parser.factor b/basis/calendar/parser/parser.factor
new file mode 100644 (file)
index 0000000..5ef80f2
--- /dev/null
@@ -0,0 +1,183 @@
+! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs calendar calendar.english combinators
+continuations io io.streams.string kernel macros math math.functions
+math.parser sequences ;
+IN: calendar.parser
+
+: read-00 ( -- n ) 2 read string>number ;
+
+: read-000 ( -- n ) 3 read string>number ;
+
+: read-0000 ( -- n ) 4 read string>number ;
+
+: expect ( str -- )
+    read1 swap member? [ "Parse error" throw ] unless ;
+
+ERROR: invalid-timestamp-format ;
+
+: check-timestamp ( obj/f -- obj )
+    [ invalid-timestamp-format ] unless* ;
+
+: checked-number ( str -- n )
+    string>number check-timestamp ;
+
+: read-token ( seps -- token )
+    [ read-until ] keep member? check-timestamp drop ;
+
+: read-sp ( -- token ) " " read-token ;
+
+: hhmm>timestamp ( hhmm -- timestamp )
+    [
+        0 0 0 read-00 read-00 0 instant <timestamp>
+    ] with-string-reader ;
+
+: signed-gmt-offset ( dt ch -- dt' )
+    { { CHAR: + [ 1 ] } { CHAR: - [ -1 ] } } case time* ;
+
+: read-rfc3339-gmt-offset ( ch -- dt )
+    {
+        { f [ instant ] }
+        { CHAR: Z [ instant ] }
+        [
+            [
+                read-00 hours
+                read1 { { CHAR: : [ read-00 ] } { f [ 0 ] } } case minutes
+                time+
+            ] dip signed-gmt-offset
+        ]
+    } case ;
+
+: read-ymd ( -- y m d )
+    read-0000 "-" expect read-00 "-" expect read-00 ;
+
+: read-hms ( -- h m s )
+    read-00 ":" expect read-00 ":" expect read-00 ;
+
+: read-rfc3339-seconds ( s -- s' ch )
+    "+-Z" read-until [
+        [ string>number ] [ length 10^ ] bi / +
+    ] dip ;
+
+: (rfc3339>timestamp) ( -- timestamp )
+    read-ymd
+    "Tt \t" expect
+    read-hms
+    read1 { { CHAR: . [ read-rfc3339-seconds ] } [ ] } case
+    read-rfc3339-gmt-offset
+    <timestamp> ;
+
+: rfc3339>timestamp ( str -- timestamp )
+    [ (rfc3339>timestamp) ] with-string-reader ;
+
+: parse-rfc822-military-offset ( string -- dt )
+    first CHAR: A - {
+        -1 -2 -3 -4 -5 -6 -7 -8 -9 f -10 -11 -12
+        1 2 3 4 5 6 7 8 9 10 11 12 0
+    } nth hours ;
+
+CONSTANT: rfc822-named-zones H{
+    { "EST" -5 }
+    { "EDT" -4 }
+    { "CST" -6 }
+    { "CDT" -5 }
+    { "MST" -7 }
+    { "MDT" -6 }
+    { "PST" -8 }
+    { "PDT" -7 }
+}
+
+: parse-rfc822-gmt-offset ( string -- dt )
+    {
+        { [ dup { "UTC" "GMT" } member? ] [ drop instant ] }
+        { [ dup length 1 = ] [ parse-rfc822-military-offset ] }
+        { [ dup rfc822-named-zones key? ] [ rfc822-named-zones at hours ] }
+        [
+            unclip [
+                2 cut [ string>number ] bi@ [ hours ] [ minutes ] bi* time+
+            ] dip signed-gmt-offset
+        ]
+    } cond ;
+
+: (rfc822>timestamp) ( -- timestamp )
+    timestamp new
+        "," read-token day-abbreviations3 member? check-timestamp drop
+        read1 CHAR: \s assert=
+        read-sp checked-number >>day
+        read-sp month-abbreviations index 1 + check-timestamp >>month
+        read-sp checked-number >>year
+        ":" read-token checked-number >>hour
+        ":" read-token checked-number >>minute
+        read-sp checked-number >>second
+        readln parse-rfc822-gmt-offset >>gmt-offset ;
+
+: rfc822>timestamp ( str -- timestamp )
+    [ (rfc822>timestamp) ] with-string-reader ;
+
+: check-day-name ( str -- )
+    [ day-abbreviations3 member? ] [ day-names member? ] bi or
+    check-timestamp drop ;
+
+: (cookie-string>timestamp-1) ( -- timestamp )
+    timestamp new
+        "," read-token check-day-name
+        read1 CHAR: \s assert=
+        "-" read-token checked-number >>day
+        "-" read-token month-abbreviations index 1 + check-timestamp >>month
+        read-sp checked-number >>year
+        ":" read-token checked-number >>hour
+        ":" read-token checked-number >>minute
+        read-sp checked-number >>second
+        readln parse-rfc822-gmt-offset >>gmt-offset ;
+
+: cookie-string>timestamp-1 ( str -- timestamp )
+    [ (cookie-string>timestamp-1) ] with-string-reader ;
+
+: (cookie-string>timestamp-2) ( -- timestamp )
+    timestamp new
+        read-sp check-day-name
+        read-sp month-abbreviations index 1 + check-timestamp >>month
+        read-sp checked-number >>day
+        ":" read-token checked-number >>hour
+        ":" read-token checked-number >>minute
+        read-sp checked-number >>second
+        read-sp checked-number >>year
+        readln parse-rfc822-gmt-offset >>gmt-offset ;
+
+: cookie-string>timestamp-2 ( str -- timestamp )
+    [ (cookie-string>timestamp-2) ] with-string-reader ;
+
+MACRO: attempt-all-quots ( quots -- quot )
+    dup length 1 = [ first ] [
+        unclip swap
+        [ nip attempt-all-quots ] curry
+        [ recover ] 2curry
+    ] if ;
+
+: cookie-string>timestamp ( str -- timestamp )
+    {
+        [ cookie-string>timestamp-1 ]
+        [ cookie-string>timestamp-2 ]
+        [ rfc822>timestamp ]
+    } attempt-all-quots ;
+
+: (ymdhms>timestamp) ( -- timestamp )
+    read-ymd " " expect read-hms instant <timestamp> ;
+
+: 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> ;
+
+: ymd>timestamp ( str -- timestamp )
+    [ (ymd>timestamp) ] with-string-reader ;
diff --git a/basis/calendar/parser/summary.txt b/basis/calendar/parser/summary.txt
new file mode 100644 (file)
index 0000000..5fc7b1b
--- /dev/null
@@ -0,0 +1 @@
+Parsing dates and times
index 7f350d17ee82251b41d37bd7de35d327862d02d4..a90bdf3783caa75e621e966b84110f607eed80f7 100644 (file)
@@ -1,12 +1,10 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays continuations db io kernel math namespaces
-quotations sequences db.postgresql.ffi alien alien.c-types
-alien.data db.types tools.walker ascii splitting math.parser
-combinators libc calendar.format byte-arrays destructors
-prettyprint accessors strings serialize io.encodings.binary
-io.encodings.utf8 alien.strings io.streams.byte-array summary
-present urls specialized-arrays db.private ;
+USING: accessors alien.c-types alien.data alien.strings arrays ascii
+calendar.format calendar.parser combinators db db.postgresql.ffi
+db.types destructors io.encodings.utf8 kernel libc math math.parser
+namespaces present sequences serialize specialized-arrays splitting
+strings summary urls ;
 SPECIALIZED-ARRAY: uint
 SPECIALIZED-ARRAY: void*
 IN: db.postgresql.lib
index 862df5b8ed1b0ee4749c2d3eefa25a55f8e41bfa..f6c26f4d07bb542a54db44208caf558ff7b59570 100644 (file)
@@ -1,11 +1,9 @@
 ! Copyright (C) 2008 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types alien.data arrays assocs kernel math math.parser
-namespaces sequences db.sqlite.ffi db combinators
-continuations db.types calendar.format serialize
-io.streams.byte-array byte-arrays io.encodings.binary
-io.backend db.errors present urls io.encodings.utf8
-io.encodings.string accessors shuffle io db.private ;
+USING: accessors alien.c-types alien.data arrays calendar.format
+calendar.parser combinators db db.errors db.sqlite.ffi db.types
+io.backend io.encodings.string io.encodings.utf8 kernel math
+namespaces present sequences serialize urls ;
 IN: db.sqlite.lib
 
 ERROR: sqlite-error < db-error n string ;
index 7dde8a9ad6a271b4f4890210976740e00c87c9fc..45efd1f39b8c8c498b288e080bb0ab899b9743cd 100644 (file)
@@ -1,11 +1,9 @@
 ! Copyright (C) 2003, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel combinators math namespaces make assocs
-sequences splitting sorting sets strings vectors hashtables
-quotations arrays byte-arrays math.parser calendar
-calendar.format present urls fry io io.encodings
-io.encodings.iana io.encodings.binary io.encodings.utf8 io.crlf
-ascii io.encodings.8-bit.latin1 http.parsers base64 mime.types ;
+USING: accessors arrays assocs base64 calendar calendar.format
+calendar.parser combinators fry hashtables http.parsers io io.crlf
+io.encodings.iana io.encodings.utf8 kernel make math math.parser
+mime.types present sequences sets sorting splitting urls ;
 IN: http
 
 CONSTANT: max-redirects 10
index 8469e90f32da8828ba1f9bb9205102eea87bb024..ba794f047c19691547e9f251b731afd95280a586 100644 (file)
@@ -5,7 +5,7 @@ DEFER: file-responder ! necessary for cgi-docs
 DEFER: <static> ! necessary for cgi-docs
 USING: calendar kernel math math.order math.parser namespaces
 parser sequences strings assocs hashtables debugger mime.types
-sorting logging calendar.format accessors splitting io io.files
+sorting logging calendar.parser accessors splitting io io.files
 io.files.info io.directories io.pathnames io.encodings.binary
 fry xml.entities destructors urls html xml.syntax
 html.templates.fhtml http http.server http.server.responses
index a680ee42c795f8a7d01ee7ad06cc7436393b2e88..6b23b7dd58756fa2328595f633b07dae2d07a7ce 100644 (file)
@@ -1,9 +1,9 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors peg peg.parsers memoize kernel sequences
-logging arrays words strings vectors io io.files
-io.encodings.utf8 namespaces make combinators logging.server
-calendar calendar.format assocs prettyprint ;
+USING: accessors assocs calendar calendar.format calendar.parser
+combinators io io.encodings.utf8 io.files kernel logging
+logging.server make namespaces peg peg.parsers prettyprint sequences
+strings vectors words ;
 IN: logging.parser
 
 TUPLE: log-entry date level word-name message ;
index 86ab6db5fe15252d0772e752a56835eb3a2976a5..0961e50675ecbcfceb6167dc4359d1a0317cad15 100644 (file)
@@ -4,8 +4,8 @@
 USING: xml.traversal kernel assocs math.order strings sequences
 xml.data xml.writer io.streams.string combinators xml
 xml.entities.html io.files io http.client namespaces make
-xml.syntax hashtables calendar.format accessors continuations
-urls present byte-arrays ;
+xml.syntax hashtables calendar.format calendar.parser accessors
+continuations urls present byte-arrays ;
 IN: syndication
 
 : any-tag-named ( tag names -- tag-inside )
index 79536c61ea829933cb2e1b6af51cc6229aed08d1..37faf126145bc281e301f094b7749759c1fab8a5 100644 (file)
@@ -1,4 +1,4 @@
-USING: accessors arrays assocs calendar calendar.format
+USING: accessors arrays assocs calendar calendar.format calendar.parser
 combinators continuations destructors formatting fry grouping.extras imap
 imap.private io.streams.duplex kernel math math.parser math.ranges
 namespaces random sequences sets sorting uuid
index 21a9934dd88ef06739d2b9f4b6d8770dd583a625..b2db9b5d01edc731b96cd54c40965357351befbb 100644 (file)
@@ -1,5 +1,5 @@
 USING: accessors arrays assocs calendar calendar.english calendar.format
-calendar.format.macros formatting fry grouping io io.crlf io.encodings.ascii
+calendar.parser formatting fry grouping io io.crlf io.encodings.ascii
 io.encodings.binary io.encodings.string io.encodings.utf7 io.encodings.utf8
 io.sockets io.sockets.secure io.streams.duplex io.streams.string kernel math
 math.parser sequences splitting strings ;
index 33ac216f394e6da68a82240540896e2cd7c9ab96..f1f93b8f44a11b2b6642268ccea5b6e3e5d99c34 100644 (file)
@@ -1,10 +1,9 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs calendar.format combinators
-combinators.short-circuit fry globs http.client kernel make
-math.parser multiline namespaces present regexp
-regexp.combinators sequences sets splitting splitting.monotonic
-unicode urls ;
+USING: accessors arrays assocs calendar.parser combinators
+combinators.short-circuit fry globs http.client kernel math.parser
+namespaces present regexp regexp.combinators sequences splitting
+splitting.monotonic unicode urls ;
 IN: robots
 
 ! visit-time is GMT, request-rate is pages/second
index 57d448b39e9f9f507e9e3c396246fdbae7899282..e20cf9140594d79a68e7e3d4b80d2d608a6aab12 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2014 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays calendar calendar.format
+USING: accessors arrays calendar calendar.parser
 io.encodings.utf8 io.files io.streams.string kernel math
 math.parser sequences splitting ascii ;
 IN: subrip-subtitles
index daee389da74d0e15727abb833ea499713502664f..88d21c2ad2e2455a9b1a83948298a420a426158c 100644 (file)
@@ -3,7 +3,7 @@
 USING: accessors assocs base64 byte-arrays combinators
 combinators.extras hash-sets kernel linked-assocs math
 math.parser regexp sequences strings yaml.ffi
-calendar calendar.format ;
+calendar calendar.format calendar.parser ;
 IN: yaml.conversion
 
 ! http://yaml.org/type/
index acc80ebba602a0b77d42e13e8ddab116e9473a38..f691689fdf36c715d387b534a41a5b6ad790e442 100644 (file)
@@ -1,9 +1,7 @@
 ! Copyright (C) 2013 John Benediktsson.
 ! See http://factorcode.org/license.txt for BSD license.
-
-USING: byte-arrays calendar calendar.format destructors io
-kernel present strings threads zeromq zeromq.ffi ;
-
+USING: byte-arrays calendar destructors io kernel present strings
+threads zeromq zeromq.ffi ;
 IN: zeromq.examples.echo-client
 
 : echo-client ( -- )