module Data.Time.Format ( -- * UNIX-style formatting NumericPadOption,FormatTime(..),formatTime, module Data.Time.Format.Parse ) where import Data.Time.Format.Parse import Data.Time.LocalTime.TimeZone import Data.Time.LocalTime.TimeOfDay import Data.Time.LocalTime.LocalTime import Data.Time.Calendar.Days import Data.Time.Calendar.Gregorian import Data.Time.Calendar.WeekDate import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.Private import Data.Time.Clock.Scale import Data.Time.Clock.UTC import Data.Time.Clock.POSIX import Data.Maybe import Data.Char import Data.Fixed -- class FormatTime t where formatCharacter :: Char -> Maybe (TimeLocale -> Maybe NumericPadOption -> t -> String) formatChar :: (FormatTime t) => Char -> TimeLocale -> Maybe NumericPadOption -> t -> String formatChar '%' _ _ _ = "%" formatChar 't' _ _ _ = "\t" formatChar 'n' _ _ _ = "\n" formatChar c locale mpado t = case (formatCharacter c) of Just f -> f locale mpado t _ -> "" -- | Substitute various time-related information for each %-code in the string, as per 'formatCharacter'. -- -- For all types (note these three are done here, not by 'formatCharacter'): -- -- [@%%@] @%@ -- -- [@%t@] tab -- -- [@%n@] newline -- -- glibc-style modifiers can be used before the letter (here marked as @z@): -- -- [@%-z@] no padding -- -- [@%_z@] pad with spaces -- -- [@%0z@] pad with zeros -- -- [@%^z@] convert to upper case -- -- [@%#z@] convert to lower case (consistently, unlike glibc) -- -- For 'TimeZone' (and 'ZonedTime' and 'UTCTime'): -- -- [@%z@] timezone offset in the format @-HHMM@. -- -- [@%Z@] timezone name -- -- For 'LocalTime' (and 'ZonedTime' and 'UTCTime' and 'UniversalTime'): -- -- [@%c@] as 'dateTimeFmt' @locale@ (e.g. @%a %b %e %H:%M:%S %Z %Y@) -- -- For 'TimeOfDay' (and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'): -- -- [@%R@] same as @%H:%M@ -- -- [@%T@] same as @%H:%M:%S@ -- -- [@%X@] as 'timeFmt' @locale@ (e.g. @%H:%M:%S@) -- -- [@%r@] as 'time12Fmt' @locale@ (e.g. @%I:%M:%S %p@) -- -- [@%P@] day-half of day from ('amPm' @locale@), converted to lowercase, @am@, @pm@ -- -- [@%p@] day-half of day from ('amPm' @locale@), @AM@, @PM@ -- -- [@%H@] hour of day (24-hour), 0-padded to two chars, @00@ - @23@ -- -- [@%k@] hour of day (24-hour), space-padded to two chars, @ 0@ - @23@ -- -- [@%I@] hour of day-half (12-hour), 0-padded to two chars, @01@ - @12@ -- -- [@%l@] hour of day-half (12-hour), space-padded to two chars, @ 1@ - @12@ -- -- [@%M@] minute of hour, 0-padded to two chars, @00@ - @59@ -- -- [@%S@] second of minute (without decimal part), 0-padded to two chars, @00@ - @60@ -- -- [@%q@] picosecond of second, 0-padded to twelve chars, @000000000000@ - @999999999999@. -- -- [@%Q@] decimal point and fraction of second, up to 12 second decimals, without trailing zeros. -- For a whole number of seconds, @%Q@ produces the empty string. -- -- For 'UTCTime' and 'ZonedTime': -- -- [@%s@] number of whole seconds since the Unix epoch. For times before -- the Unix epoch, this is a negative number. Note that in @%s.%q@ and @%s%Q@ -- the decimals are positive, not negative. For example, 0.9 seconds -- before the Unix epoch is formatted as @-1.1@ with @%s%Q@. -- -- For 'Day' (and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'): -- -- [@%D@] same as @%m\/%d\/%y@ -- -- [@%F@] same as @%Y-%m-%d@ -- -- [@%x@] as 'dateFmt' @locale@ (e.g. @%m\/%d\/%y@) -- -- [@%Y@] year, no padding. Note @%0Y@ and @%_Y@ pad to four chars -- -- [@%y@] year of century, 0-padded to two chars, @00@ - @99@ -- -- [@%C@] century, no padding. Note @%0C@ and @%_C@ pad to two chars -- -- [@%B@] month name, long form ('fst' from 'months' @locale@), @January@ - @December@ -- -- [@%b@, @%h@] month name, short form ('snd' from 'months' @locale@), @Jan@ - @Dec@ -- -- [@%m@] month of year, 0-padded to two chars, @01@ - @12@ -- -- [@%d@] day of month, 0-padded to two chars, @01@ - @31@ -- -- [@%e@] day of month, space-padded to two chars, @ 1@ - @31@ -- -- [@%j@] day of year, 0-padded to three chars, @001@ - @366@ -- -- [@%G@] year for Week Date format, no padding. Note @%0G@ and @%_G@ pad to four chars -- -- [@%g@] year of century for Week Date format, 0-padded to two chars, @00@ - @99@ -- -- [@%f@] century for Week Date format, no padding. Note @%0f@ and @%_f@ pad to two chars -- -- [@%V@] week of year for Week Date format, 0-padded to two chars, @01@ - @53@ -- -- [@%u@] day of week for Week Date format, @1@ - @7@ -- -- [@%a@] day of week, short form ('snd' from 'wDays' @locale@), @Sun@ - @Sat@ -- -- [@%A@] day of week, long form ('fst' from 'wDays' @locale@), @Sunday@ - @Saturday@ -- -- [@%U@] week of year where weeks start on Sunday (as 'sundayStartWeek'), 0-padded to two chars, @00@ - @53@ -- -- [@%w@] day of week number, @0@ (= Sunday) - @6@ (= Saturday) -- -- [@%W@] week of year where weeks start on Monday (as 'mondayStartWeek'), 0-padded to two chars, @00@ - @53@ formatTime :: (FormatTime t) => TimeLocale -> String -> t -> String formatTime _ [] _ = "" formatTime locale ('%':'_':c:cs) t = (formatChar c locale (Just (Just ' ')) t) ++ (formatTime locale cs t) formatTime locale ('%':'-':c:cs) t = (formatChar c locale (Just Nothing) t) ++ (formatTime locale cs t) formatTime locale ('%':'0':c:cs) t = (formatChar c locale (Just (Just '0')) t) ++ (formatTime locale cs t) formatTime locale ('%':'^':c:cs) t = (fmap toUpper (formatChar c locale Nothing t)) ++ (formatTime locale cs t) formatTime locale ('%':'#':c:cs) t = (fmap toLower (formatChar c locale Nothing t)) ++ (formatTime locale cs t) formatTime locale ('%':c:cs) t = (formatChar c locale Nothing t) ++ (formatTime locale cs t) formatTime locale (c:cs) t = c:(formatTime locale cs t) instance FormatTime LocalTime where formatCharacter 'c' = Just (\locale _ -> formatTime locale (dateTimeFmt locale)) formatCharacter c = case (formatCharacter c) of Just f -> Just (\locale mpado dt -> f locale mpado (localDay dt)) Nothing -> case (formatCharacter c) of Just f -> Just (\locale mpado dt -> f locale mpado (localTimeOfDay dt)) Nothing -> Nothing instance FormatTime TimeOfDay where -- Aggregate formatCharacter 'R' = Just (\locale _ -> formatTime locale "%H:%M") formatCharacter 'T' = Just (\locale _ -> formatTime locale "%H:%M:%S") formatCharacter 'X' = Just (\locale _ -> formatTime locale (timeFmt locale)) formatCharacter 'r' = Just (\locale _ -> formatTime locale (time12Fmt locale)) -- AM/PM formatCharacter 'P' = Just (\locale _ day -> map toLower ((if (todHour day) < 12 then fst else snd) (amPm locale))) formatCharacter 'p' = Just (\locale _ day -> (if (todHour day) < 12 then fst else snd) (amPm locale)) -- Hour formatCharacter 'H' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . todHour) formatCharacter 'I' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\h -> (mod (h - 1) 12) + 1) . todHour) formatCharacter 'k' = Just (\_ opt -> (show2 (fromMaybe (Just ' ') opt)) . todHour) formatCharacter 'l' = Just (\_ opt -> (show2 (fromMaybe (Just ' ') opt)) . (\h -> (mod (h - 1) 12) + 1) . todHour) -- Minute formatCharacter 'M' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . todMin) -- Second formatCharacter 'S' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt) :: Int -> String) . truncate . todSec) formatCharacter 'q' = Just (\_ _ -> drop 1 . dropWhile (/='.') . showFixed False . todSec) formatCharacter 'Q' = Just (\_ _ -> dropWhile (/='.') . showFixed True . todSec) -- Default formatCharacter _ = Nothing instance FormatTime ZonedTime where formatCharacter 'c' = Just (\locale _ -> formatTime locale (dateTimeFmt locale)) formatCharacter 's' = Just (\_ _ zt -> show (floor (utcTimeToPOSIXSeconds (zonedTimeToUTC zt)) :: Integer)) formatCharacter c = case (formatCharacter c) of Just f -> Just (\locale mpado dt -> f locale mpado (zonedTimeToLocalTime dt)) Nothing -> case (formatCharacter c) of Just f -> Just (\locale mpado dt -> f locale mpado (zonedTimeZone dt)) Nothing -> Nothing instance FormatTime TimeZone where formatCharacter 'z' = Just (\_ opt -> timeZoneOffsetString' (fromMaybe (Just '0') opt)) formatCharacter 'Z' = Just (\_ opt z -> let n = timeZoneName z in if null n then timeZoneOffsetString' (fromMaybe (Just '0') opt) z else n) formatCharacter _ = Nothing instance FormatTime Day where -- Aggregate formatCharacter 'D' = Just (\locale _ -> formatTime locale "%m/%d/%y") formatCharacter 'F' = Just (\locale _ -> formatTime locale "%Y-%m-%d") formatCharacter 'x' = Just (\locale _ -> formatTime locale (dateFmt locale)) -- Year Count formatCharacter 'Y' = Just (\_ opt -> (show4 (fromMaybe Nothing opt)) . fst . toOrdinalDate) formatCharacter 'y' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . mod100 . fst . toOrdinalDate) formatCharacter 'C' = Just (\_ opt -> (show2 (fromMaybe Nothing opt)) . div100 . fst . toOrdinalDate) -- Month of Year formatCharacter 'B' = Just (\locale _ -> fst . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian) formatCharacter 'b' = Just (\locale _ -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian) formatCharacter 'h' = Just (\locale _ -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian) formatCharacter 'm' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\(_,m,_) -> m) . toGregorian) -- Day of Month formatCharacter 'd' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\(_,_,d) -> d) . toGregorian) formatCharacter 'e' = Just (\_ opt -> (show2 (fromMaybe (Just ' ') opt)) . (\(_,_,d) -> d) . toGregorian) -- Day of Year formatCharacter 'j' = Just (\_ opt -> (show3 (fromMaybe (Just '0') opt)) . snd . toOrdinalDate) -- ISO 8601 Week Date formatCharacter 'G' = Just (\_ opt -> (show4 (fromMaybe Nothing opt)) . (\(y,_,_) -> y) . toWeekDate) formatCharacter 'g' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . mod100 . (\(y,_,_) -> y) . toWeekDate) formatCharacter 'f' = Just (\_ opt -> (show2 (fromMaybe Nothing opt)) . div100 . (\(y,_,_) -> y) . toWeekDate) formatCharacter 'V' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\(_,w,_) -> w) . toWeekDate) formatCharacter 'u' = Just (\_ _ -> show . (\(_,_,d) -> d) . toWeekDate) -- Day of week formatCharacter 'a' = Just (\locale _ -> snd . ((wDays locale) !!) . snd . sundayStartWeek) formatCharacter 'A' = Just (\locale _ -> fst . ((wDays locale) !!) . snd . sundayStartWeek) formatCharacter 'U' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . fst . sundayStartWeek) formatCharacter 'w' = Just (\_ _ -> show . snd . sundayStartWeek) formatCharacter 'W' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . fst . mondayStartWeek) -- Default formatCharacter _ = Nothing instance FormatTime UTCTime where formatCharacter c = fmap (\f locale mpado t -> f locale mpado (utcToZonedTime utc t)) (formatCharacter c) instance FormatTime UniversalTime where formatCharacter c = fmap (\f locale mpado t -> f locale mpado (ut1ToLocalTime 0 t)) (formatCharacter c)