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