module Data.Time.Format
(
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
_ -> ""
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
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))
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))
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)
formatCharacter 'M' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . todMin)
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)
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
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))
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)
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)
formatCharacter 'd' = Just (\_ opt -> (show2 (fromMaybe (Just '0') opt)) . (\(_,_,d) -> d) . toGregorian)
formatCharacter 'e' = Just (\_ opt -> (show2 (fromMaybe (Just ' ') opt)) . (\(_,_,d) -> d) . toGregorian)
formatCharacter 'j' = Just (\_ opt -> (show3 (fromMaybe (Just '0') opt)) . snd . toOrdinalDate)
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)
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)
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)