1{-# OPTIONS -fno-warn-orphans #-} 2module Data.Time.Format.Format.Instances () where 3 4import Data.Char 5import Data.Fixed 6import Data.Time.Clock.Internal.DiffTime 7import Data.Time.Clock.Internal.NominalDiffTime 8import Data.Time.Clock.Internal.UniversalTime 9import Data.Time.Clock.Internal.UTCTime 10import Data.Time.Clock.POSIX 11import Data.Time.Calendar.Days 12import Data.Time.Calendar.CalendarDiffDays 13import Data.Time.Calendar.Gregorian 14import Data.Time.Calendar.Week 15import Data.Time.Calendar.WeekDate 16import Data.Time.Calendar.OrdinalDate 17import Data.Time.Calendar.Private 18import Data.Time.LocalTime.Internal.CalendarDiffTime 19import Data.Time.LocalTime.Internal.TimeZone 20import Data.Time.LocalTime.Internal.TimeOfDay 21import Data.Time.LocalTime.Internal.LocalTime 22import Data.Time.LocalTime.Internal.ZonedTime 23import Data.Time.Format.Locale 24import Data.Time.Format.Format.Class 25 26 27instance FormatTime LocalTime where 28 formatCharacter _ 'c' = Just $ \fo -> formatTime (foLocale fo) $ dateTimeFmt $ foLocale fo 29 formatCharacter alt c = case formatCharacter alt c of 30 Just f -> Just $ \fo dt -> f fo (localDay dt) 31 Nothing -> case formatCharacter alt c of 32 Just f -> Just $ \fo dt -> f fo (localTimeOfDay dt) 33 Nothing -> Nothing 34 35todAMPM :: TimeLocale -> TimeOfDay -> String 36todAMPM locale day = let 37 (am,pm) = amPm locale 38 in if (todHour day) < 12 then am else pm 39 40tod12Hour :: TimeOfDay -> Int 41tod12Hour day = (mod (todHour day - 1) 12) + 1 42 43instance FormatTime TimeOfDay where 44 -- Aggregate 45 formatCharacter _ 'R' = Just $ formatString $ \locale -> formatTime locale "%H:%M" 46 formatCharacter _ 'T' = Just $ formatString $ \locale -> formatTime locale "%H:%M:%S" 47 formatCharacter _ 'X' = Just $ formatString $ \locale -> formatTime locale (timeFmt locale) 48 formatCharacter _ 'r' = Just $ formatString $ \locale -> formatTime locale (time12Fmt locale) 49 -- AM/PM 50 formatCharacter _ 'P' = Just $ formatString $ \locale -> map toLower . todAMPM locale 51 formatCharacter _ 'p' = Just $ formatString $ \locale -> todAMPM locale 52 -- Hour 53 formatCharacter _ 'H' = Just $ formatNumber True 2 '0' todHour 54 formatCharacter _ 'I' = Just $ formatNumber True 2 '0' tod12Hour 55 formatCharacter _ 'k' = Just $ formatNumber True 2 ' ' todHour 56 formatCharacter _ 'l' = Just $ formatNumber True 2 ' ' tod12Hour 57 -- Minute 58 formatCharacter _ 'M' = Just $ formatNumber True 2 '0' todMin 59 -- Second 60 formatCharacter _ 'S' = Just $ formatNumber True 2 '0' $ (floor . todSec :: TimeOfDay -> Int) 61 formatCharacter _ 'q' = Just $ formatGeneral True True 12 '0' $ \_ pado -> showPaddedFixedFraction pado . todSec 62 formatCharacter _ 'Q' = Just $ formatGeneral True False 12 '0' $ \_ pado -> dotNonEmpty . showPaddedFixedFraction pado . todSec where 63 dotNonEmpty "" = "" 64 dotNonEmpty s = '.':s 65 66 -- Default 67 formatCharacter _ _ = Nothing 68 69instance FormatTime ZonedTime where 70 formatCharacter _ 'c' = Just $ formatString $ \locale -> formatTime locale (dateTimeFmt locale) 71 formatCharacter _ 's' = Just $ formatNumber True 1 '0' $ (floor . utcTimeToPOSIXSeconds . zonedTimeToUTC :: ZonedTime -> Integer) 72 formatCharacter alt c = case formatCharacter alt c of 73 Just f -> Just $ \fo dt -> f fo (zonedTimeToLocalTime dt) 74 Nothing -> case formatCharacter alt c of 75 Just f -> Just $ \fo dt -> f fo (zonedTimeZone dt) 76 Nothing -> Nothing 77 78instance FormatTime TimeZone where 79 formatCharacter False 'z' = Just $ formatGeneral False True 4 '0' $ \_ -> timeZoneOffsetString'' False 80 formatCharacter True 'z' = Just $ formatGeneral False True 5 '0' $ \_ -> timeZoneOffsetString'' True 81 formatCharacter alt 'Z' = Just $ \fo z -> let 82 n = timeZoneName z 83 idef = if alt then 5 else 4 84 in if null n then formatGeneral False True idef '0' (\_ -> timeZoneOffsetString'' alt) fo z else formatString (\_ -> timeZoneName) fo z 85 formatCharacter _ _ = Nothing 86 87instance FormatTime DayOfWeek where 88 formatCharacter _ 'u' = Just $ formatNumber True 1 '0' $ fromEnum 89 formatCharacter _ 'w' = Just $ formatNumber True 1 '0' $ \wd -> (mod (fromEnum wd) 7) 90 formatCharacter _ 'a' = Just $ formatString $ \locale wd -> snd $ (wDays locale) !! (mod (fromEnum wd) 7) 91 formatCharacter _ 'A' = Just $ formatString $ \locale wd -> fst $ (wDays locale) !! (mod (fromEnum wd) 7) 92 formatCharacter _ _ = Nothing 93 94instance FormatTime Day where 95 -- Aggregate 96 formatCharacter _ 'D' = Just $ formatString $ \locale -> formatTime locale "%m/%d/%y" 97 formatCharacter _ 'F' = Just $ formatString $ \locale -> formatTime locale "%Y-%m-%d" 98 formatCharacter _ 'x' = Just $ formatString $ \locale -> formatTime locale (dateFmt locale) 99 100 -- Year Count 101 formatCharacter _ 'Y' = Just $ formatNumber False 4 '0' $ fst . toOrdinalDate 102 formatCharacter _ 'y' = Just $ formatNumber True 2 '0' $ mod100 . fst . toOrdinalDate 103 formatCharacter _ 'C' = Just $ formatNumber False 2 '0' $ div100 . fst . toOrdinalDate 104 -- Month of Year 105 formatCharacter _ 'B' = Just $ formatString $ \locale -> fst . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian 106 formatCharacter _ 'b' = Just $ formatString $ \locale -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian 107 formatCharacter _ 'h' = Just $ formatString $ \locale -> snd . (\(_,m,_) -> (months locale) !! (m - 1)) . toGregorian 108 formatCharacter _ 'm' = Just $ formatNumber True 2 '0' $ (\(_,m,_) -> m) . toGregorian 109 -- Day of Month 110 formatCharacter _ 'd' = Just $ formatNumber True 2 '0' $ (\(_,_,d) -> d) . toGregorian 111 formatCharacter _ 'e' = Just $ formatNumber True 2 ' ' $ (\(_,_,d) -> d) . toGregorian 112 -- Day of Year 113 formatCharacter _ 'j' = Just $ formatNumber True 3 '0' $ snd . toOrdinalDate 114 115 -- ISO 8601 Week Date 116 formatCharacter _ 'G' = Just $ formatNumber False 4 '0' $ (\(y,_,_) -> y) . toWeekDate 117 formatCharacter _ 'g' = Just $ formatNumber True 2 '0' $ mod100 . (\(y,_,_) -> y) . toWeekDate 118 formatCharacter _ 'f' = Just $ formatNumber False 2 '0' $ div100 . (\(y,_,_) -> y) . toWeekDate 119 120 formatCharacter _ 'V' = Just $ formatNumber True 2 '0' $ (\(_,w,_) -> w) . toWeekDate 121 formatCharacter _ 'u' = Just $ formatNumber True 1 '0' $ (\(_,_,d) -> d) . toWeekDate 122 123 -- Day of week 124 formatCharacter _ 'a' = Just $ formatString $ \locale -> snd . ((wDays locale) !!) . snd . sundayStartWeek 125 formatCharacter _ 'A' = Just $ formatString $ \locale -> fst . ((wDays locale) !!) . snd . sundayStartWeek 126 formatCharacter _ 'U' = Just $ formatNumber True 2 '0' $ fst . sundayStartWeek 127 formatCharacter _ 'w' = Just $ formatNumber True 1 '0' $ snd . sundayStartWeek 128 formatCharacter _ 'W' = Just $ formatNumber True 2 '0' $ fst . mondayStartWeek 129 130 -- Default 131 formatCharacter _ _ = Nothing 132 133instance FormatTime UTCTime where 134 formatCharacter alt c = fmap (\f fo t -> f fo (utcToZonedTime utc t)) (formatCharacter alt c) 135 136instance FormatTime UniversalTime where 137 formatCharacter alt c = fmap (\f fo t -> f fo (ut1ToLocalTime 0 t)) (formatCharacter alt c) 138 139instance FormatTime NominalDiffTime where 140 formatCharacter _ 'w' = Just $ formatNumberStd 1 $ quotBy $ 7 * 86400 141 formatCharacter _ 'd' = Just $ formatNumberStd 1 $ quotBy 86400 142 formatCharacter _ 'D' = Just $ formatNumberStd 1 $ remBy 7 . quotBy 86400 143 formatCharacter _ 'h' = Just $ formatNumberStd 1 $ quotBy 3600 144 formatCharacter _ 'H' = Just $ formatNumberStd 2 $ remBy 24 . quotBy 3600 145 formatCharacter _ 'm' = Just $ formatNumberStd 1 $ quotBy 60 146 formatCharacter _ 'M' = Just $ formatNumberStd 2 $ remBy 60 . quotBy 60 147 formatCharacter False 's' = Just $ formatNumberStd 1 $ quotBy 1 148 formatCharacter True 's' = Just $ formatGeneral False False 12 '0' $ \_ padf t -> showPaddedFixed NoPad padf (realToFrac t :: Pico) 149 formatCharacter False 'S' = Just $ formatNumberStd 2 $ remBy 60 . quotBy 1 150 formatCharacter True 'S' = Just $ formatGeneral False False 12 '0' $ \_ padf t -> let 151 padn = case padf of 152 NoPad -> NoPad 153 Pad _ c -> Pad 2 c 154 in showPaddedFixed padn padf (realToFrac $ remBy 60 t :: Pico) 155 formatCharacter _ _ = Nothing 156 157instance FormatTime DiffTime where 158 formatCharacter _ 'w' = Just $ formatNumberStd 1 $ quotBy $ 7 * 86400 159 formatCharacter _ 'd' = Just $ formatNumberStd 1 $ quotBy 86400 160 formatCharacter _ 'D' = Just $ formatNumberStd 1 $ remBy 7 . quotBy 86400 161 formatCharacter _ 'h' = Just $ formatNumberStd 1 $ quotBy 3600 162 formatCharacter _ 'H' = Just $ formatNumberStd 2 $ remBy 24 . quotBy 3600 163 formatCharacter _ 'm' = Just $ formatNumberStd 1 $ quotBy 60 164 formatCharacter _ 'M' = Just $ formatNumberStd 2 $ remBy 60 . quotBy 60 165 formatCharacter False 's' = Just $ formatNumberStd 1 $ quotBy 1 166 formatCharacter True 's' = Just $ formatGeneral False False 12 '0' $ \_ padf t -> showPaddedFixed NoPad padf (realToFrac t :: Pico) 167 formatCharacter False 'S' = Just $ formatNumberStd 2 $ remBy 60 . quotBy 1 168 formatCharacter True 'S' = Just $ formatGeneral False False 12 '0' $ \_ padf t -> let 169 padn = case padf of 170 NoPad -> NoPad 171 Pad _ c -> Pad 2 c 172 in showPaddedFixed padn padf (realToFrac $ remBy 60 t :: Pico) 173 formatCharacter _ _ = Nothing 174 175instance FormatTime CalendarDiffDays where 176 formatCharacter _ 'y' = Just $ formatNumberStd 1 $ quotBy 12 . cdMonths 177 formatCharacter _ 'b' = Just $ formatNumberStd 1 $ cdMonths 178 formatCharacter _ 'B' = Just $ formatNumberStd 2 $ remBy 12 . cdMonths 179 formatCharacter _ 'w' = Just $ formatNumberStd 1 $ quotBy 7 . cdDays 180 formatCharacter _ 'd' = Just $ formatNumberStd 1 $ cdDays 181 formatCharacter _ 'D' = Just $ formatNumberStd 1 $ remBy 7 . cdDays 182 formatCharacter _ _ = Nothing 183 184instance FormatTime CalendarDiffTime where 185 formatCharacter _ 'y' = Just $ formatNumberStd 1 $ quotBy 12 . ctMonths 186 formatCharacter _ 'b' = Just $ formatNumberStd 1 $ ctMonths 187 formatCharacter _ 'B' = Just $ formatNumberStd 2 $ remBy 12 . ctMonths 188 formatCharacter alt c = fmap (\f fo t -> f fo (ctTime t)) (formatCharacter alt c) 189