1module Data.Time.Format.Format.Class 2 ( 3 -- * Formatting 4 formatTime, 5 FormatNumericPadding, 6 FormatOptions(..), 7 FormatTime(..), 8 ShowPadded,PadOption, 9 formatGeneral,formatString,formatNumber,formatNumberStd, 10 showPaddedFixed,showPaddedFixedFraction, 11 quotBy,remBy, 12 ) 13 where 14 15import Data.Char 16import Data.Maybe 17import Data.Fixed 18import Data.Time.Calendar.Private 19import Data.Time.Format.Locale 20 21type FormatNumericPadding = Maybe Char 22 23data FormatOptions = MkFormatOptions { 24 foLocale :: TimeLocale, 25 foPadding :: Maybe FormatNumericPadding, 26 foWidth :: Maybe Int 27} 28 29-- <http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html> 30class FormatTime t where 31 -- | @since 1.9.1 32 formatCharacter :: Bool -> Char -> Maybe (FormatOptions -> t -> String) 33 34 35-- the weird UNIX logic is here 36getPadOption :: Bool -> Bool -> Int -> Char -> Maybe FormatNumericPadding -> Maybe Int -> PadOption 37getPadOption trunc fdef idef cdef mnpad mi = let 38 c = case mnpad of 39 Just (Just c') -> c' 40 Just Nothing -> ' ' 41 _ -> cdef 42 i = case mi of 43 Just i' -> case mnpad of 44 Just Nothing -> i' 45 _ -> if trunc then i' else max i' idef 46 Nothing -> idef 47 f = case mi of 48 Just _ -> True 49 Nothing -> case mnpad of 50 Nothing -> fdef 51 Just Nothing -> False 52 Just (Just _) -> True 53 in if f then Pad i c else NoPad 54 55formatGeneral :: Bool -> Bool -> Int -> Char -> (TimeLocale -> PadOption -> t -> String) -> (FormatOptions -> t -> String) 56formatGeneral trunc fdef idef cdef ff fo = ff (foLocale fo) $ getPadOption trunc fdef idef cdef (foPadding fo) (foWidth fo) 57 58formatString :: (TimeLocale -> t -> String) -> (FormatOptions -> t -> String) 59formatString ff = formatGeneral False False 1 ' ' $ \locale pado -> showPadded pado . ff locale 60 61formatNumber :: (ShowPadded i) => Bool -> Int -> Char -> (t -> i) -> (FormatOptions -> t -> String) 62formatNumber fdef idef cdef ff = formatGeneral False fdef idef cdef $ \_ pado -> showPaddedNum pado . ff 63 64formatNumberStd :: Int -> (t -> Integer) -> (FormatOptions -> t -> String) 65formatNumberStd n = formatNumber False n '0' 66 67showPaddedFixed :: HasResolution a => PadOption -> PadOption -> Fixed a -> String 68showPaddedFixed padn padf x | x < 0 = '-' : showPaddedFixed padn padf (negate x) 69showPaddedFixed padn padf x = let 70 ns = showPaddedNum padn $ (floor x :: Integer) 71 fs = showPaddedFixedFraction padf x 72 ds = if null fs then "" else "." 73 in ns ++ ds ++ fs 74 75showPaddedFixedFraction :: HasResolution a => PadOption -> Fixed a -> String 76showPaddedFixedFraction pado x = let 77 digits = dropWhile (=='.') $ dropWhile (/='.') $ showFixed True x 78 n = length digits 79 in case pado of 80 NoPad -> digits 81 Pad i c -> if i < n 82 then take i digits 83 else digits ++ replicate (i - n) c 84 85 86-- | Substitute various time-related information for each %-code in the string, as per 'formatCharacter'. 87-- 88-- The general form is @%\<modifier\>\<width\>\<alternate\>\<specifier\>@, where @\<modifier\>@, @\<width\>@, and @\<alternate\>@ are optional. 89-- 90-- == @\<modifier\>@ 91-- glibc-style modifiers can be used before the specifier (here marked as @z@): 92-- 93-- [@%-z@] no padding 94-- 95-- [@%_z@] pad with spaces 96-- 97-- [@%0z@] pad with zeros 98-- 99-- [@%^z@] convert to upper case 100-- 101-- [@%#z@] convert to lower case (consistently, unlike glibc) 102-- 103-- == @\<width\>@ 104-- Width digits can also be used after any modifiers and before the specifier (here marked as @z@), for example: 105-- 106-- [@%4z@] pad to 4 characters (with default padding character) 107-- 108-- [@%_12z@] pad with spaces to 12 characters 109-- 110-- == @\<alternate\>@ 111-- An optional @E@ character indicates an alternate formatting. Currently this only affects @%Z@ and @%z@. 112-- 113-- [@%Ez@] alternate formatting 114-- 115-- == @\<specifier\>@ 116-- 117-- For all types (note these three are done by 'formatTime', not by 'formatCharacter'): 118-- 119-- [@%%@] @%@ 120-- 121-- [@%t@] tab 122-- 123-- [@%n@] newline 124-- 125-- === 'TimeZone' 126-- For 'TimeZone' (and 'ZonedTime' and 'UTCTime'): 127-- 128-- [@%z@] timezone offset in the format @±HHMM@ 129-- 130-- [@%Ez@] timezone offset in the format @±HH:MM@ 131-- 132-- [@%Z@] timezone name (or else offset in the format @±HHMM@) 133-- 134-- [@%EZ@] timezone name (or else offset in the format @±HH:MM@) 135-- 136-- === 'LocalTime' 137-- For 'LocalTime' (and 'ZonedTime' and 'UTCTime' and 'UniversalTime'): 138-- 139-- [@%c@] as 'dateTimeFmt' @locale@ (e.g. @%a %b %e %H:%M:%S %Z %Y@) 140-- 141-- === 'TimeOfDay' 142-- For 'TimeOfDay' (and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'): 143-- 144-- [@%R@] same as @%H:%M@ 145-- 146-- [@%T@] same as @%H:%M:%S@ 147-- 148-- [@%X@] as 'timeFmt' @locale@ (e.g. @%H:%M:%S@) 149-- 150-- [@%r@] as 'time12Fmt' @locale@ (e.g. @%I:%M:%S %p@) 151-- 152-- [@%P@] day-half of day from ('amPm' @locale@), converted to lowercase, @am@, @pm@ 153-- 154-- [@%p@] day-half of day from ('amPm' @locale@), @AM@, @PM@ 155-- 156-- [@%H@] hour of day (24-hour), 0-padded to two chars, @00@ - @23@ 157-- 158-- [@%k@] hour of day (24-hour), space-padded to two chars, @ 0@ - @23@ 159-- 160-- [@%I@] hour of day-half (12-hour), 0-padded to two chars, @01@ - @12@ 161-- 162-- [@%l@] hour of day-half (12-hour), space-padded to two chars, @ 1@ - @12@ 163-- 164-- [@%M@] minute of hour, 0-padded to two chars, @00@ - @59@ 165-- 166-- [@%S@] second of minute (without decimal part), 0-padded to two chars, @00@ - @60@ 167-- 168-- [@%q@] picosecond of second, 0-padded to twelve chars, @000000000000@ - @999999999999@. 169-- 170-- [@%Q@] decimal point and fraction of second, up to 12 second decimals, without trailing zeros. 171-- For a whole number of seconds, @%Q@ omits the decimal point unless padding is specified. 172-- 173-- === 'UTCTime' and 'ZonedTime' 174-- For 'UTCTime' and 'ZonedTime': 175-- 176-- [@%s@] number of whole seconds since the Unix epoch. For times before 177-- the Unix epoch, this is a negative number. Note that in @%s.%q@ and @%s%Q@ 178-- the decimals are positive, not negative. For example, 0.9 seconds 179-- before the Unix epoch is formatted as @-1.1@ with @%s%Q@. 180-- 181-- === 'DayOfWeek' 182-- For 'DayOfWeek' (and 'Day' and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'): 183-- 184-- [@%u@] day of week number for Week Date format, @1@ (= Monday) - @7@ (= Sunday) 185-- 186-- [@%w@] day of week number, @0@ (= Sunday) - @6@ (= Saturday) 187-- 188-- [@%a@] day of week, short form ('snd' from 'wDays' @locale@), @Sun@ - @Sat@ 189-- 190-- [@%A@] day of week, long form ('fst' from 'wDays' @locale@), @Sunday@ - @Saturday@ 191-- 192-- === 'Day' 193-- For 'Day' (and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'): 194-- 195-- [@%D@] same as @%m\/%d\/%y@ 196-- 197-- [@%F@] same as @%Y-%m-%d@ 198-- 199-- [@%x@] as 'dateFmt' @locale@ (e.g. @%m\/%d\/%y@) 200-- 201-- [@%Y@] year, no padding. Note @%0Y@ and @%_Y@ pad to four chars 202-- 203-- [@%y@] year of century, 0-padded to two chars, @00@ - @99@ 204-- 205-- [@%C@] century, no padding. Note @%0C@ and @%_C@ pad to two chars 206-- 207-- [@%B@] month name, long form ('fst' from 'months' @locale@), @January@ - @December@ 208-- 209-- [@%b@, @%h@] month name, short form ('snd' from 'months' @locale@), @Jan@ - @Dec@ 210-- 211-- [@%m@] month of year, 0-padded to two chars, @01@ - @12@ 212-- 213-- [@%d@] day of month, 0-padded to two chars, @01@ - @31@ 214-- 215-- [@%e@] day of month, space-padded to two chars, @ 1@ - @31@ 216-- 217-- [@%j@] day of year, 0-padded to three chars, @001@ - @366@ 218-- 219-- [@%f@] century for Week Date format, no padding. Note @%0f@ and @%_f@ pad to two chars 220-- 221-- [@%V@] week of year for Week Date format, 0-padded to two chars, @01@ - @53@ 222-- 223-- [@%U@] week of year where weeks start on Sunday (as 'sundayStartWeek'), 0-padded to two chars, @00@ - @53@ 224-- 225-- [@%W@] week of year where weeks start on Monday (as 'mondayStartWeek'), 0-padded to two chars, @00@ - @53@ 226-- 227-- == Duration types 228-- The specifiers for 'DiffTime', 'NominalDiffTime', 'CalendarDiffDays', and 'CalendarDiffTime' are semantically 229-- separate from the other types. 230-- Specifiers on negative time differences will generally be negative (think 'rem' rather than 'mod'). 231-- 232-- === 'NominalDiffTime' and 'DiffTime' 233-- Note that a "minute" of 'DiffTime' is simply 60 SI seconds, rather than a minute of civil time. 234-- Use 'NominalDiffTime' to work with civil time, ignoring any leap seconds. 235-- 236-- For 'NominalDiffTime' and 'DiffTime': 237-- 238-- [@%w@] total whole weeks 239-- 240-- [@%d@] total whole days 241-- 242-- [@%D@] whole days of week 243-- 244-- [@%h@] total whole hours 245-- 246-- [@%H@] whole hours of day 247-- 248-- [@%m@] total whole minutes 249-- 250-- [@%M@] whole minutes of hour 251-- 252-- [@%s@] total whole seconds 253-- 254-- [@%Es@] total seconds, with decimal point and up to \<width\> (default 12) decimal places, without trailing zeros. 255-- For a whole number of seconds, @%Es@ omits the decimal point unless padding is specified. 256-- 257-- [@%0Es@] total seconds, with decimal point and \<width\> (default 12) decimal places. 258-- 259-- [@%S@] whole seconds of minute 260-- 261-- [@%ES@] seconds of minute, with decimal point and up to \<width\> (default 12) decimal places, without trailing zeros. 262-- For a whole number of seconds, @%ES@ omits the decimal point unless padding is specified. 263-- 264-- [@%0ES@] seconds of minute as two digits, with decimal point and \<width\> (default 12) decimal places. 265-- 266-- === 'CalendarDiffDays' 267-- For 'CalendarDiffDays' (and 'CalendarDiffTime'): 268-- 269-- [@%y@] total years 270-- 271-- [@%b@] total months 272-- 273-- [@%B@] months of year 274-- 275-- [@%w@] total weeks, not including months 276-- 277-- [@%d@] total days, not including months 278-- 279-- [@%D@] days of week 280-- 281-- === 'CalendarDiffTime' 282-- For 'CalendarDiffTime': 283-- 284-- [@%h@] total hours, not including months 285-- 286-- [@%H@] hours of day 287-- 288-- [@%m@] total minutes, not including months 289-- 290-- [@%M@] minutes of hour 291-- 292-- [@%s@] total whole seconds, not including months 293-- 294-- [@%Es@] total seconds, not including months, with decimal point and up to \<width\> (default 12) decimal places, without trailing zeros. 295-- For a whole number of seconds, @%Es@ omits the decimal point unless padding is specified. 296-- 297-- [@%0Es@] total seconds, not including months, with decimal point and \<width\> (default 12) decimal places. 298-- 299-- [@%S@] whole seconds of minute 300-- 301-- [@%ES@] seconds of minute, with decimal point and up to \<width\> (default 12) decimal places, without trailing zeros. 302-- For a whole number of seconds, @%ES@ omits the decimal point unless padding is specified. 303-- 304-- [@%0ES@] seconds of minute as two digits, with decimal point and \<width\> (default 12) decimal places. 305formatTime :: (FormatTime t) => TimeLocale -> String -> t -> String 306formatTime _ [] _ = "" 307formatTime locale ('%':cs) t = case formatTime1 locale cs t of 308 Just result -> result 309 Nothing -> '%':(formatTime locale cs t) 310formatTime locale (c:cs) t = c:(formatTime locale cs t) 311 312formatTime1 :: (FormatTime t) => TimeLocale -> String -> t -> Maybe String 313formatTime1 locale ('_':cs) t = formatTime2 locale id (Just (Just ' ')) cs t 314formatTime1 locale ('-':cs) t = formatTime2 locale id (Just Nothing) cs t 315formatTime1 locale ('0':cs) t = formatTime2 locale id (Just (Just '0')) cs t 316formatTime1 locale ('^':cs) t = formatTime2 locale (fmap toUpper) Nothing cs t 317formatTime1 locale ('#':cs) t = formatTime2 locale (fmap toLower) Nothing cs t 318formatTime1 locale cs t = formatTime2 locale id Nothing cs t 319 320getDigit :: Char -> Maybe Int 321getDigit c | c < '0' = Nothing 322getDigit c | c > '9' = Nothing 323getDigit c = Just $ (ord c) - (ord '0') 324 325pullNumber :: Maybe Int -> String -> (Maybe Int,String) 326pullNumber mx [] = (mx,[]) 327pullNumber mx s@(c:cs) = case getDigit c of 328 Just i -> pullNumber (Just $ (fromMaybe 0 mx)*10+i) cs 329 Nothing -> (mx,s) 330 331formatTime2 :: (FormatTime t) => TimeLocale -> (String -> String) -> Maybe FormatNumericPadding -> String -> t -> Maybe String 332formatTime2 locale recase mpad cs t = let 333 (mwidth,rest) = pullNumber Nothing cs 334 in formatTime3 locale recase mpad mwidth rest t 335 336formatTime3 :: (FormatTime t) => TimeLocale -> (String -> String) -> Maybe FormatNumericPadding -> Maybe Int -> String -> t -> Maybe String 337formatTime3 locale recase mpad mwidth ('E':cs) = formatTime4 True recase (MkFormatOptions locale mpad mwidth) cs 338formatTime3 locale recase mpad mwidth cs = formatTime4 False recase (MkFormatOptions locale mpad mwidth) cs 339 340formatTime4 :: (FormatTime t) => Bool -> (String -> String) -> FormatOptions -> String -> t -> Maybe String 341formatTime4 alt recase fo (c:cs) t = Just $ (recase (formatChar alt c fo t)) ++ (formatTime (foLocale fo) cs t) 342formatTime4 _alt _recase _fo [] _t = Nothing 343 344formatChar :: (FormatTime t) => Bool -> Char -> FormatOptions -> t -> String 345formatChar _ '%' = formatString $ \_ _ -> "%" 346formatChar _ 't' = formatString $ \_ _ -> "\t" 347formatChar _ 'n' = formatString $ \_ _ -> "\n" 348formatChar alt c = case formatCharacter alt c of 349 Just f -> f 350 _ -> \_ _ -> "" 351