]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/calendar/format/format.factor
Support Link Time Optimization (off by default)
[factor.git] / basis / calendar / format / format.factor
index 38e0a202b25c1f1fa4024866423a205b6ee6cab2..a85f24af7207974120dbd25b883d2c1fc7460041 100644 (file)
@@ -1,9 +1,9 @@
 ! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays calendar calendar.english combinators
+! See https://factorcode.org/license.txt for BSD license.
+USING: accessors calendar calendar.english combinators
 formatting grouping io io.streams.string kernel make math
-math.order math.parser math.parser.private math.ranges present
-quotations sequences splitting strings words ;
+math.order math.parser present quotations ranges sequences
+splitting strings words ;
 IN: calendar.format
 
 MACRO: formatted ( spec -- quot )
@@ -11,7 +11,7 @@ MACRO: formatted ( spec -- quot )
         {
             { [ dup word? ] [ 1quotation ] }
             { [ dup quotation? ] [ ] }
-            [ [ nip write ] curry [ ] like ]
+            [ [ nip write ] curry ]
         } cond
     ] map [ cleave ] curry ;
 
@@ -29,10 +29,7 @@ MACRO: formatted ( spec -- quot )
 
 : ss ( timestamp -- ) second>> >integer write-00 ;
 
-! Should be enough for anyone, allows to not do a fancy
-! algorithm to detect infinite decimals (e.g 1/3)
-: ss.SSSSSS ( timestamp -- )
-    second>> >float "0" 9 6 "f" "C" format-float write ;
+: ss.SSSSSS ( timestamp -- ) second>> "%09.6f" printf ;
 
 : hhmm ( timestamp -- ) [ hh ] [ mm ] bi ;
 
@@ -73,11 +70,11 @@ M: timestamp day.
     [ number>string ] [ month-name ] bi* swap " " glue 20 center. ;
 
 : days-header. ( -- )
-    day-abbreviations2 " " join print ;
+    day-abbreviations2 join-words print ;
 
 : days. ( year month -- )
     [ 1 (day-of-week) dup [ "   " write ] times ]
-    [ (days-in-month) ] 2bi [1,b] [
+    [ (days-in-month) ] 2bi [1..b] [
         [ day. ] [ + 7 mod zero? [ nl ] [ bl ] if ] bi
     ] with each nl ;
 
@@ -90,11 +87,11 @@ PRIVATE>
 GENERIC: year. ( obj -- )
 
 M: integer year.
-    dup number>string 64 center. nl 12 [1,b] [
+    dup number>string 64 center. nl 12 [1..b] [
         [
             [ month-name 20 center. ]
             [ days-header. days. nl nl ] bi
-        ] with-string-writer string-lines
+        ] with-string-writer split-lines
     ] with map 3 <groups>
     [ first3 [ "%-20s  %-20s  %-20s\n" printf ] 3each ] each ;
 
@@ -110,7 +107,7 @@ M: timestamp year. year>> year. ;
     [ hh:mm:ss ] with-string-writer ;
 
 : timestamp>ymdhms ( timestamp -- str )
-    [ >gmt YYYY-MM-DD " " hh:mm:ss ] with-string-writer ;
+    [ >gmt { YYYY-MM-DD " " hh:mm:ss } formatted ] with-string-writer ;
 
 : write-gmt-offset-hhmm ( gmt-offset -- )
     [ hour>> dup 0 < "-" "+" ? write abs write-00 ] [ mm ] bi ;
@@ -126,7 +123,7 @@ M: timestamp year. year>> year. ;
 
 : write-rfc1036 ( timestamp -- )
     {
-        DAY ", " DD "-" MONTH "-" YYYY " " hh ":" mm ":" ss " "
+        DAY ", " DD "-" MONTH "-" YYYY " " hh:mm:ss " "
         [ gmt-offset>> write-gmt-offset ]
     } formatted ;
 
@@ -139,7 +136,7 @@ ALIAS: timestamp>rfc850 timestamp>rfc1036
 
 : write-rfc2822 ( timestamp -- )
     {
-        DAY ", " D " " MONTH " " YYYY " " hh ":" mm ":" ss " "
+        DAY ", " D " " MONTH " " YYYY " " hh:mm:ss " "
         [ gmt-offset>> write-gmt-offset ]
     } formatted ;
 
@@ -152,7 +149,7 @@ ALIAS: timestamp>rfc822 timestamp>rfc2822
 
 : write-rfc3339 ( timestamp -- )
     {
-        YYYY "-" MM "-" DD "T" hh ":" mm ":" ss.SSSSSS
+        YYYY-MM-DD "T" hh:mm:ss.SSSSSS
         [ gmt-offset>> write-gmt-offset-z ]
     } formatted ;
 
@@ -161,7 +158,7 @@ ALIAS: timestamp>rfc822 timestamp>rfc2822
 
 : write-iso8601 ( timestamp -- )
     {
-        YYYY "-" MM "-" DD "T" hh ":" mm ":" ss.SSSSSS
+        YYYY-MM-DD "T" hh:mm:ss.SSSSSS
         [ gmt-offset>> write-gmt-offset-hh:mm ]
     } formatted ;
 
@@ -170,7 +167,7 @@ ALIAS: timestamp>rfc822 timestamp>rfc2822
 
 : write-ctime ( timestamp -- )
     {
-        DAY " " MONTH " " DD " " hh ":" mm ":" ss " " YYYY
+        DAY " " MONTH " " DD " " hh:mm:ss " " YYYY
     } formatted ;
 
 : timestamp>ctime-string ( timestamp -- str )
@@ -179,7 +176,7 @@ ALIAS: timestamp>rfc822 timestamp>rfc2822
 : timestamp>git-string ( timestamp -- str )
     [
         {
-            DAY " " MONTH " " D " " hh ":" mm ":" ss " " YYYY " "
+            DAY " " MONTH " " D " " hh:mm:ss " " YYYY " "
             [ gmt-offset>> write-gmt-offset-hhmm ]
         } formatted
     ] with-string-writer ;
@@ -191,7 +188,7 @@ ALIAS: timestamp>rfc822 timestamp>rfc2822
     >gmt timestamp>rfc1036 ;
 
 : write-timestamp ( timestamp -- )
-    { DAY ", " D " " MONTH " " YYYY " " hh ":" mm ":" ss } formatted ;
+    { DAY ", " D " " MONTH " " YYYY " " hh:mm:ss } formatted ;
 
 : timestamp>string ( timestamp -- str )
     [ write-timestamp ] with-string-writer ;
@@ -203,24 +200,48 @@ M: timestamp present timestamp>string ;
     [ duration>minutes >integer 60 mod pad-00 ] bi ":" glue ;
 
 : duration>hms ( duration -- str )
-    [ duration>hm ] [ second>> >integer 60 mod pad-00 ] bi ":" glue ;
+    [ duration>hm ]
+    [ duration>seconds >integer 60 mod pad-00 ] bi ":" glue ;
 
 : duration>human-readable ( duration -- string )
     [
-        [
-            duration>years >integer
-            [
-                [ number>string write ]
-                [ 1 > " years, " " year, " ? write ] bi
-            ] unless-zero
-        ] [
-            duration>days >integer 365 mod
+        {
             [
-                [ number>string write ]
-                [ 1 > " days, " " day, " ? write ] bi
-            ] unless-zero
-        ] [ duration>hms write ] tri
-    ] with-string-writer ;
+                duration>years >integer
+                [
+                    [ number>string ]
+                    [ 1 > " years" " year" ? append , ] bi
+                ] unless-zero
+            ] [
+                duration>days >integer 365 mod
+                [
+                    [ number>string ]
+                    [ 1 > " days" " day" ? append , ] bi
+                ] unless-zero
+            ] [
+                duration>hours >integer 24 mod
+                [
+                    [ number>string ]
+                    [ 1 > " hours" " hour" ? append , ] bi
+                ] unless-zero
+            ] [
+                duration>minutes >integer 60 mod
+                [
+                    [ number>string ]
+                    [ 1 > " minutes" " minute" ? append , ] bi
+                ] unless-zero
+            ] [
+                duration>seconds >integer 60 mod
+                [
+                    number>string " seconds" append ,
+                ] unless-zero
+            ]
+        } cleave
+    ] { } make [ "0 seconds" ] [
+        unclip-last-slice over empty? [ nip ] [
+            [ ", " join ] [ " and " glue ] bi*
+        ] if
+    ] if-empty ;
 
 GENERIC: elapsed-time ( seconds -- string )
 
@@ -237,7 +258,7 @@ M: integer elapsed-time
             [ first [ /mod ] [ dup ] if* ] [ second ] bi swap
             dup 0 > [ number>string prepend , ] [ 2drop ] if
         ] each drop
-    ] { } make [ "0s" ] [ reverse " " join ] if-empty ;
+    ] { } make [ "0s" ] [ reverse join-words ] if-empty ;
 
 M: real elapsed-time
     >integer elapsed-time ;
@@ -246,9 +267,8 @@ M: duration elapsed-time
     duration>seconds elapsed-time ;
 
 M: timestamp elapsed-time
-    now swap time- elapsed-time ;
+    ago elapsed-time ;
 
-! XXX: Anything up to 2 hours is "about an hour"
 : relative-time-offset ( seconds -- string )
     abs {
         { [ dup 1 < ] [ drop "just now" ] }
@@ -276,4 +296,4 @@ M: duration relative-time
     duration>seconds relative-time ;
 
 M: timestamp relative-time
-    now swap time- relative-time ;
+    ago relative-time ;