test/main/Test/Format/ISO8601.hs

@@ -23,9 +23,10 @@ readShowProperty _ fmt val =
     case formatShowM fmt val of
         Nothing -> property Discard
         Just str ->
-            let found = formatParseM fmt str
+            let
+                found = formatParseM fmt str
                 expected = Just val
-             in property $
+                in property $
                     if expected == found
                         then succeeded
                         else failed{reason = show str ++ ": expected " ++ (show expected) ++ ", found " ++ (show found)}
@@ -68,13 +69,13 @@ instance Arbitrary (Durational CalendarDiffDays) where
         return $ MkDurational $ CalendarDiffDays mm dd
 
 instance Arbitrary (Durational CalendarDiffTime) where
-    arbitrary =
-        let limit = 40 * 86400
-            picofactor = 10 ^ (12 :: Int)
-         in do
-                mm <- choose (-10000, 10000)
-                ss <- choose (negate limit * picofactor, limit * picofactor)
-                return $ MkDurational $ CalendarDiffTime mm $ fromRational $ ss % picofactor
+    arbitrary = let
+        limit = 40 * 86400
+        picofactor = 10 ^ (12 :: Int)
+        in do
+            mm <- choose (-10000, 10000)
+            ss <- choose (negate limit * picofactor, limit * picofactor)
+            return $ MkDurational $ CalendarDiffTime mm $ fromRational $ ss % picofactor
 
 durationalFormat :: Format a -> Format (Durational a)
 durationalFormat (MkFormat sa ra) = MkFormat (\b -> sa $ unDurational b) (fmap MkDurational ra)
@@ -126,59 +127,67 @@ testReadShowFormat =
                 recurringIntervalFormat (localTimeFormat (calendarFormat fe) (timeOfDayFormat fe)) durationTimeFormat
         ]
 
-testShowFormat :: String -> Format t -> String -> t -> TestTree
-testShowFormat name fmt str t = nameTest (name ++ ": " ++ str) $ assertEqual "" (Just str) $ formatShowM fmt t
+testShowReadFormat :: (Show t, Eq t) => String -> Format t -> String -> t -> TestTree
+testShowReadFormat name fmt str val =
+    nameTest
+        (name ++ ": " ++ str)
+        [ nameTest "show" $ assertEqual "" (Just str) $ formatShowM fmt val
+        , nameTest "read" $ assertEqual "" (Just val) $ formatParseM fmt str
+        ]
+
+testReadFormat :: (Show t, Eq t) => String -> Format t -> String -> t -> TestTree
+testReadFormat name fmt str val = nameTest (name ++ ": " ++ str) $ assertEqual "" (Just val) $ formatParseM fmt str
 
 testShowFormats :: TestTree
 testShowFormats =
     nameTest
         "show format"
-        [ testShowFormat "durationDaysFormat" durationDaysFormat "P0D" $ CalendarDiffDays 0 0
-        , testShowFormat "durationDaysFormat" durationDaysFormat "P4Y" $ CalendarDiffDays 48 0
-        , testShowFormat "durationDaysFormat" durationDaysFormat "P7M" $ CalendarDiffDays 7 0
-        , testShowFormat "durationDaysFormat" durationDaysFormat "P5D" $ CalendarDiffDays 0 5
-        , testShowFormat "durationDaysFormat" durationDaysFormat "P2Y3M81D" $ CalendarDiffDays 27 81
-        , testShowFormat "durationTimeFormat" durationTimeFormat "P0D" $ CalendarDiffTime 0 0
-        , testShowFormat "durationTimeFormat" durationTimeFormat "P4Y" $ CalendarDiffTime 48 0
-        , testShowFormat "durationTimeFormat" durationTimeFormat "P7M" $ CalendarDiffTime 7 0
-        , testShowFormat "durationTimeFormat" durationTimeFormat "P5D" $ CalendarDiffTime 0 $ 5 * nominalDay
-        , testShowFormat "durationTimeFormat" durationTimeFormat "P2Y3M81D" $ CalendarDiffTime 27 $ 81 * nominalDay
-        , testShowFormat "durationTimeFormat" durationTimeFormat "PT2H" $ CalendarDiffTime 0 $ 7200
-        , testShowFormat "durationTimeFormat" durationTimeFormat "PT3M" $ CalendarDiffTime 0 $ 180
-        , testShowFormat "durationTimeFormat" durationTimeFormat "PT12S" $ CalendarDiffTime 0 $ 12
-        , testShowFormat "durationTimeFormat" durationTimeFormat "PT1M18.77634S" $ CalendarDiffTime 0 $ 78.77634
-        , testShowFormat "durationTimeFormat" durationTimeFormat "PT2H1M18.77634S" $ CalendarDiffTime 0 $ 7278.77634
-        , testShowFormat "durationTimeFormat" durationTimeFormat "P5DT2H1M18.77634S" $
+        [ testShowReadFormat "durationDaysFormat" durationDaysFormat "P0D" $ CalendarDiffDays 0 0
+        , testShowReadFormat "durationDaysFormat" durationDaysFormat "P4Y" $ CalendarDiffDays 48 0
+        , testShowReadFormat "durationDaysFormat" durationDaysFormat "P7M" $ CalendarDiffDays 7 0
+        , testShowReadFormat "durationDaysFormat" durationDaysFormat "P5D" $ CalendarDiffDays 0 5
+        , testShowReadFormat "durationDaysFormat" durationDaysFormat "P2Y3M81D" $ CalendarDiffDays 27 81
+        , testShowReadFormat "durationTimeFormat" durationTimeFormat "P0D" $ CalendarDiffTime 0 0
+        , testShowReadFormat "durationTimeFormat" durationTimeFormat "P4Y" $ CalendarDiffTime 48 0
+        , testShowReadFormat "durationTimeFormat" durationTimeFormat "P7M" $ CalendarDiffTime 7 0
+        , testShowReadFormat "durationTimeFormat" durationTimeFormat "P5D" $ CalendarDiffTime 0 $ 5 * nominalDay
+        , testShowReadFormat "durationTimeFormat" durationTimeFormat "P2Y3M81D" $ CalendarDiffTime 27 $ 81 * nominalDay
+        , testShowReadFormat "durationTimeFormat" durationTimeFormat "PT2H" $ CalendarDiffTime 0 $ 7200
+        , testShowReadFormat "durationTimeFormat" durationTimeFormat "PT3M" $ CalendarDiffTime 0 $ 180
+        , testShowReadFormat "durationTimeFormat" durationTimeFormat "PT12S" $ CalendarDiffTime 0 $ 12
+        , testShowReadFormat "durationTimeFormat" durationTimeFormat "PT1M18.77634S" $ CalendarDiffTime 0 $ 78.77634
+        , testShowReadFormat "durationTimeFormat" durationTimeFormat "PT2H1M18.77634S" $ CalendarDiffTime 0 $ 7278.77634
+        , testShowReadFormat "durationTimeFormat" durationTimeFormat "P5DT2H1M18.77634S" $
             CalendarDiffTime 0 $ 5 * nominalDay + 7278.77634
-        , testShowFormat "durationTimeFormat" durationTimeFormat "P7Y10M5DT2H1M18.77634S" $
+        , testShowReadFormat "durationTimeFormat" durationTimeFormat "P7Y10M5DT2H1M18.77634S" $
             CalendarDiffTime 94 $ 5 * nominalDay + 7278.77634
-        , testShowFormat "durationTimeFormat" durationTimeFormat "P7Y10MT2H1M18.77634S" $
+        , testShowReadFormat "durationTimeFormat" durationTimeFormat "P7Y10MT2H1M18.77634S" $
             CalendarDiffTime 94 $ 7278.77634
-        , testShowFormat "durationTimeFormat" durationTimeFormat "P8YT2H1M18.77634S" $ CalendarDiffTime 96 $ 7278.77634
-        , testShowFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0001-00-00" $
+        , testShowReadFormat "durationTimeFormat" durationTimeFormat "P8YT2H1M18.77634S" $ CalendarDiffTime 96 $ 7278.77634
+        , testShowReadFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0001-00-00" $
             CalendarDiffDays 12 0
-        , testShowFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0002-03-29" $
+        , testShowReadFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0002-03-29" $
             CalendarDiffDays 27 29
-        , testShowFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0561-08-29" $
+        , testShowReadFormat "alternativeDurationDaysFormat" (alternativeDurationDaysFormat ExtendedFormat) "P0561-08-29" $
             CalendarDiffDays (561 * 12 + 8) 29
-        , testShowFormat
+        , testShowReadFormat
             "alternativeDurationTimeFormat"
             (alternativeDurationTimeFormat ExtendedFormat)
             "P0000-00-01T00:00:00"
             $ CalendarDiffTime 0 86400
-        , testShowFormat
+        , testShowReadFormat
             "alternativeDurationTimeFormat"
             (alternativeDurationTimeFormat ExtendedFormat)
             "P0007-10-05T02:01:18.77634"
             $ CalendarDiffTime 94 $ 5 * nominalDay + 7278.77634
-        , testShowFormat
+        , testShowReadFormat
             "alternativeDurationTimeFormat"
             (alternativeDurationTimeFormat ExtendedFormat)
             "P4271-10-05T02:01:18.77634"
             $ CalendarDiffTime (12 * 4271 + 10) $ 5 * nominalDay + 7278.77634
-        , testShowFormat "centuryFormat" centuryFormat "02" 2
-        , testShowFormat "centuryFormat" centuryFormat "21" 21
-        , testShowFormat
+        , testShowReadFormat "centuryFormat" centuryFormat "02" 2
+        , testShowReadFormat "centuryFormat" centuryFormat "21" 21
+        , testShowReadFormat
             "intervalFormat etc."
             ( intervalFormat
                 (localTimeFormat (calendarFormat ExtendedFormat) (timeOfDayFormat ExtendedFormat))
@@ -188,7 +197,7 @@ testShowFormats =
             ( LocalTime (fromGregorian 2015 6 13) (TimeOfDay 21 13 56)
             , CalendarDiffTime 14 $ 7 * nominalDay + 5 * 3600 + 33 * 60 + 2.34
             )
-        , testShowFormat
+        , testShowReadFormat
             "recurringIntervalFormat etc."
             ( recurringIntervalFormat
                 (localTimeFormat (calendarFormat ExtendedFormat) (timeOfDayFormat ExtendedFormat))
@@ -199,75 +208,105 @@ testShowFormats =
             , LocalTime (fromGregorian 2015 6 13) (TimeOfDay 21 13 56)
             , CalendarDiffTime 14 $ 7 * nominalDay + 5 * 3600 + 33 * 60 + 2.34
             )
-        , testShowFormat
+        , testShowReadFormat
             "recurringIntervalFormat etc."
             (recurringIntervalFormat (calendarFormat ExtendedFormat) durationDaysFormat)
             "R74/2015-06-13/P1Y2M7D"
             (74, fromGregorian 2015 6 13, CalendarDiffDays 14 7)
-        , testShowFormat "timeOffsetFormat" iso8601Format "-06:30" (minutesToTimeZone (-390))
-        , testShowFormat "timeOffsetFormat" iso8601Format "+00:00" (minutesToTimeZone 0)
-        , testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+0000" (minutesToTimeZone 0)
-        , testShowFormat "timeOffsetFormat" iso8601Format "+00:10" (minutesToTimeZone 10)
-        , testShowFormat "timeOffsetFormat" iso8601Format "-00:10" (minutesToTimeZone (-10))
-        , testShowFormat "timeOffsetFormat" iso8601Format "+01:35" (minutesToTimeZone 95)
-        , testShowFormat "timeOffsetFormat" iso8601Format "-01:35" (minutesToTimeZone (-95))
-        , testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+0135" (minutesToTimeZone 95)
-        , testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "-0135" (minutesToTimeZone (-95))
-        , testShowFormat
+        , testShowReadFormat "timeOffsetFormat" iso8601Format "-06:30" (minutesToTimeZone (-390))
+        , testShowReadFormat "timeOffsetFormat" iso8601Format "-06:00" (minutesToTimeZone (-360))
+        , testReadFormat "timeOffsetFormat" iso8601Format "-06" (minutesToTimeZone (-360))
+        , testShowReadFormat "timeOffsetFormat" iso8601Format "+11:00" (minutesToTimeZone 660)
+        , testReadFormat "timeOffsetFormat" iso8601Format "+11" (minutesToTimeZone 660)
+        , testShowReadFormat "timeOffsetFormat" iso8601Format "+00:00" (minutesToTimeZone 0)
+        , testReadFormat "timeOffsetFormat" iso8601Format "+00" (minutesToTimeZone 0)
+        , testReadFormat "timeOffsetFormat" iso8601Format "-00:00" (minutesToTimeZone 0)
+        , testReadFormat "timeOffsetFormat" iso8601Format "-00" (minutesToTimeZone 0)
+        , testShowReadFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+0000" (minutesToTimeZone 0)
+        , testReadFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+00" (minutesToTimeZone 0)
+        , testReadFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "-0000" (minutesToTimeZone 0)
+        , testReadFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "-00" (minutesToTimeZone 0)
+        , testShowReadFormat "timeOffsetFormat" iso8601Format "+00:10" (minutesToTimeZone 10)
+        , testShowReadFormat "timeOffsetFormat" iso8601Format "-00:10" (minutesToTimeZone (-10))
+        , testShowReadFormat "timeOffsetFormat" iso8601Format "+01:35" (minutesToTimeZone 95)
+        , testShowReadFormat "timeOffsetFormat" iso8601Format "-01:35" (minutesToTimeZone (-95))
+        , testShowReadFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+0135" (minutesToTimeZone 95)
+        , testShowReadFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "-0135" (minutesToTimeZone (-95))
+        , testShowReadFormat
             "timeOffsetFormat"
             (timeOffsetFormat BasicFormat)
             "-1100"
             (minutesToTimeZone $ negate $ 11 * 60)
-        , testShowFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+1015" (minutesToTimeZone $ 615)
-        , testShowFormat
+        , testShowReadFormat "timeOffsetFormat" (timeOffsetFormat BasicFormat) "+1015" (minutesToTimeZone $ 615)
+        , testShowReadFormat
             "zonedTimeFormat"
             iso8601Format
             "2024-07-06T08:45:56.553-06:30"
             (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone (-390)))
-        , testShowFormat
+        , testShowReadFormat
+            "zonedTimeFormat"
+            iso8601Format
+            "2024-07-06T08:45:56.553-06:00"
+            (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone (-360)))
+        , testReadFormat
+            "zonedTimeFormat"
+            iso8601Format
+            "2024-07-06T08:45:56.553-06"
+            (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone (-360)))
+        , testShowReadFormat
             "zonedTimeFormat"
             iso8601Format
             "2024-07-06T08:45:56.553+06:30"
             (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone 390))
-        , testShowFormat
+        , testShowReadFormat
+            "zonedTimeFormat"
+            iso8601Format
+            "2024-07-06T08:45:56.553+06:00"
+            (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone 360))
+        , testReadFormat
+            "zonedTimeFormat"
+            iso8601Format
+            "2024-07-06T08:45:56.553+06"
+            (ZonedTime (LocalTime (fromGregorian 2024 07 06) (TimeOfDay 8 45 56.553)) (minutesToTimeZone 360))
+        , testShowReadFormat
             "utcTimeFormat"
             iso8601Format
             "2024-07-06T08:45:56.553Z"
             (UTCTime (fromGregorian 2024 07 06) (timeOfDayToTime $ TimeOfDay 8 45 56.553))
-        , testShowFormat
+        , testShowReadFormat
             "utcTimeFormat"
             iso8601Format
             "2028-12-31T23:59:60.9Z"
             (UTCTime (fromGregorian 2028 12 31) (timeOfDayToTime $ TimeOfDay 23 59 60.9))
-        , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1994-W52-7" (fromGregorian 1995 1 1)
-        , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1995-W01-1" (fromGregorian 1995 1 2)
-        , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1996-W52-7" (fromGregorian 1996 12 29)
-        , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1997-W01-2" (fromGregorian 1996 12 31)
-        , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1997-W01-3" (fromGregorian 1997 1 1)
-        , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1974-W32-6" (fromGregorian 1974 8 10)
-        , testShowFormat "weekDateFormat" (weekDateFormat BasicFormat) "1974W326" (fromGregorian 1974 8 10)
-        , testShowFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1995-W05-6" (fromGregorian 1995 2 4)
-        , testShowFormat "weekDateFormat" (weekDateFormat BasicFormat) "1995W056" (fromGregorian 1995 2 4)
-        , testShowFormat
+        , testShowReadFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1994-W52-7" (fromGregorian 1995 1 1)
+        , testShowReadFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1995-W01-1" (fromGregorian 1995 1 2)
+        , testShowReadFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1996-W52-7" (fromGregorian 1996 12 29)
+        , testShowReadFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1997-W01-2" (fromGregorian 1996 12 31)
+        , testShowReadFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1997-W01-3" (fromGregorian 1997 1 1)
+        , testShowReadFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1974-W32-6" (fromGregorian 1974 8 10)
+        , testShowReadFormat "weekDateFormat" (weekDateFormat BasicFormat) "1974W326" (fromGregorian 1974 8 10)
+        , testShowReadFormat "weekDateFormat" (weekDateFormat ExtendedFormat) "1995-W05-6" (fromGregorian 1995 2 4)
+        , testShowReadFormat "weekDateFormat" (weekDateFormat BasicFormat) "1995W056" (fromGregorian 1995 2 4)
+        , testShowReadFormat
             "weekDateFormat"
             (expandedWeekDateFormat 6 ExtendedFormat)
             "+001995-W05-6"
             (fromGregorian 1995 2 4)
-        , testShowFormat "weekDateFormat" (expandedWeekDateFormat 6 BasicFormat) "+001995W056" (fromGregorian 1995 2 4)
-        , testShowFormat "ordinalDateFormat" (ordinalDateFormat ExtendedFormat) "1846-235" (fromGregorian 1846 8 23)
-        , testShowFormat "ordinalDateFormat" (ordinalDateFormat BasicFormat) "1844236" (fromGregorian 1844 8 23)
-        , testShowFormat
+        , testShowReadFormat "weekDateFormat" (expandedWeekDateFormat 6 BasicFormat) "+001995W056" (fromGregorian 1995 2 4)
+        , testShowReadFormat "ordinalDateFormat" (ordinalDateFormat ExtendedFormat) "1846-235" (fromGregorian 1846 8 23)
+        , testShowReadFormat "ordinalDateFormat" (ordinalDateFormat BasicFormat) "1844236" (fromGregorian 1844 8 23)
+        , testShowReadFormat
             "ordinalDateFormat"
             (expandedOrdinalDateFormat 5 ExtendedFormat)
             "+01846-235"
             (fromGregorian 1846 8 23)
-        , testShowFormat "hourMinuteFormat" (hourMinuteFormat ExtendedFormat) "13:17.25" (TimeOfDay 13 17 15)
-        , testShowFormat "hourMinuteFormat" (hourMinuteFormat ExtendedFormat) "01:12.4" (TimeOfDay 1 12 24)
-        , testShowFormat "hourMinuteFormat" (hourMinuteFormat BasicFormat) "1317.25" (TimeOfDay 13 17 15)
-        , testShowFormat "hourMinuteFormat" (hourMinuteFormat BasicFormat) "0112.4" (TimeOfDay 1 12 24)
-        , testShowFormat "hourFormat" hourFormat "22" (TimeOfDay 22 0 0)
-        , testShowFormat "hourFormat" hourFormat "06" (TimeOfDay 6 0 0)
-        , testShowFormat "hourFormat" hourFormat "18.9475" (TimeOfDay 18 56 51)
+        , testShowReadFormat "hourMinuteFormat" (hourMinuteFormat ExtendedFormat) "13:17.25" (TimeOfDay 13 17 15)
+        , testShowReadFormat "hourMinuteFormat" (hourMinuteFormat ExtendedFormat) "01:12.4" (TimeOfDay 1 12 24)
+        , testShowReadFormat "hourMinuteFormat" (hourMinuteFormat BasicFormat) "1317.25" (TimeOfDay 13 17 15)
+        , testShowReadFormat "hourMinuteFormat" (hourMinuteFormat BasicFormat) "0112.4" (TimeOfDay 1 12 24)
+        , testShowReadFormat "hourFormat" hourFormat "22" (TimeOfDay 22 0 0)
+        , testShowReadFormat "hourFormat" hourFormat "06" (TimeOfDay 6 0 0)
+        , testShowReadFormat "hourFormat" hourFormat "18.9475" (TimeOfDay 18 56 51)
         ]
 
 testISO8601 :: TestTree

test/main/Test/Format/ParseTime.hs

@@ -40,15 +40,15 @@ data FormatCode pf t = MkFormatCode
     }
 
 instance Show (FormatCode pf t) where
-    show (MkFormatCode m w a s) =
-        let ms = m
-            ws = fromMaybe "" $ fmap show w
-            as =
-                if a
-                    then "E"
-                    else ""
-            ss = [s]
-         in '%' : (ms <> ws <> as <> ss)
+    show (MkFormatCode m w a s) = let
+        ms = m
+        ws = fromMaybe "" $ fmap show w
+        as =
+            if a
+                then "E"
+                else ""
+        ss = [s]
+        in '%' : (ms <> ws <> as <> ss)
 
 formatCode :: FormatTime t => FormatCode pf t -> t -> String
 formatCode fc = format $ show fc
@@ -65,22 +65,19 @@ minCodeWidth :: Char -> Int
 minCodeWidth _ = 0
 
 fcShrink :: FormatCode pf t -> [FormatCode pf t]
-fcShrink fc =
-    let fc1 =
-            case fcWidth fc of
-                Nothing -> []
-                Just w
-                    | w > (minCodeWidth $ fcSpecifier fc) -> [fc{fcWidth = Nothing}, fc{fcWidth = Just $ w - 1}]
-                Just _ -> [fc{fcWidth = Nothing}]
-        fc2 =
-            case fcAlt fc of
-                False -> []
-                True -> [fc{fcAlt = False}]
-        fc3 =
-            case fcModifier fc of
-                "" -> []
-                _ -> [fc{fcModifier = ""}]
-     in fc1 ++ fc2 ++ fc3
+fcShrink fc = let
+    fc1 = case fcWidth fc of
+        Nothing -> []
+        Just w
+            | w > (minCodeWidth $ fcSpecifier fc) -> [fc{fcWidth = Nothing}, fc{fcWidth = Just $ w - 1}]
+        Just _ -> [fc{fcWidth = Nothing}]
+    fc2 = case fcAlt fc of
+        False -> []
+        True -> [fc{fcAlt = False}]
+    fc3 = case fcModifier fc of
+        "" -> []
+        _ -> [fc{fcModifier = ""}]
+    in fc1 ++ fc2 ++ fc3
 
 instance HasFormatCodes t => Arbitrary (FormatCode FormatOnly t) where
     arbitrary = do
@@ -156,11 +153,11 @@ extests =
         )
 
 readTest :: (Eq a, Show a, Read a) => [(a, String)] -> String -> TestTree
-readTest expected target =
-    let found = reads target
-        result = assertEqual "" expected found
-        name = show target
-     in Test.Tasty.HUnit.testCase name result
+readTest expected target = let
+    found = reads target
+    result = assertEqual "" expected found
+    name = show target
+    in Test.Tasty.HUnit.testCase name result
 
 readTestsParensSpaces ::
     forall a.
@@ -192,9 +189,9 @@ readTests =
     testGroup
         "read times"
         [ readTestsParensSpaces testDay "1912-07-08"
-        , --readTestsParensSpaces testDay "1912-7-8",
+        , -- readTestsParensSpaces testDay "1912-7-8",
           readTestsParensSpaces testTimeOfDay "08:04:02"
-          --,readTestsParensSpaces testTimeOfDay "8:4:2"
+          -- ,readTestsParensSpaces testTimeOfDay "8:4:2"
         ]
   where
     testDay = fromGregorian 1912 7 8
@@ -230,11 +227,11 @@ simpleFormatTests =
         ]
   where
     readsTest :: (Show a, Eq a, ParseTime a) => [(a, String)] -> String -> String -> TestTree
-    readsTest expected formatStr target =
-        let found = readSTime False defaultTimeLocale formatStr target
-            result = assertEqual "" expected found
-            name = (show formatStr) ++ " of " ++ (show target)
-         in Test.Tasty.HUnit.testCase name result
+    readsTest expected formatStr target = let
+        found = readSTime False defaultTimeLocale formatStr target
+        result = assertEqual "" expected found
+        name = (show formatStr) ++ " of " ++ (show target)
+        in Test.Tasty.HUnit.testCase name result
 
 spacingTests :: (Show t, Eq t, ParseTime t) => t -> String -> String -> TestTree
 spacingTests expected formatStr target =
@@ -268,24 +265,20 @@ badParseTests :: TestTree
 badParseTests = testGroup "bad" [parseTest False (Nothing :: Maybe Day) "%Y" ""]
 
 parseYMD :: Day -> TestTree
-parseYMD day =
-    case toGregorian day of
-        (y, m, d) -> parseTest False (Just day) "%Y%m%d" ((show y) ++ (show2 m) ++ (show2 d))
+parseYMD day = case toGregorian day of
+    (y, m, d) -> parseTest False (Just day) "%Y%m%d" ((show y) ++ (show2 m) ++ (show2 d))
 
 parseYearDayD :: Day -> TestTree
-parseYearDayD day =
-    case toGregorian day of
-        (y, m, d) -> parseTest False (Just day) "%Y %m %d" ((show y) ++ " " ++ (show2 m) ++ " " ++ (show2 d))
+parseYearDayD day = case toGregorian day of
+    (y, m, d) -> parseTest False (Just day) "%Y %m %d" ((show y) ++ " " ++ (show2 m) ++ " " ++ (show2 d))
 
 parseYearDayE :: Day -> TestTree
-parseYearDayE day =
-    case toGregorian day of
-        (y, m, d) -> parseTest False (Just day) "%Y %-m %e" ((show y) ++ " " ++ (show m) ++ " " ++ (show d))
+parseYearDayE day = case toGregorian day of
+    (y, m, d) -> parseTest False (Just day) "%Y %-m %e" ((show y) ++ " " ++ (show m) ++ " " ++ (show d))
 
 -- | 1969 - 2068
 expectedYear :: Integer -> Integer
-expectedYear i
-    | i >= 69 = 1900 + i
+expectedYear i | i >= 69 = 1900 + i
 expectedYear i = 2000 + i
 
 show2 :: (Show n, Integral n) => n -> String
@@ -305,18 +298,18 @@ parseCentury int c =
     parseTest False (Just (fromGregorian (c * 100) 1 1)) ("%-C" ++ int ++ "%y") ((show c) ++ int ++ "00")
 
 parseTest :: (Show t, Eq t, ParseTime t) => Bool -> Maybe t -> String -> String -> TestTree
-parseTest sp expected formatStr target =
-    let found = parse sp formatStr target
-        result = assertEqual "" expected found
-        name =
-            (show formatStr)
-                ++ " of "
-                ++ (show target)
-                ++ ( if sp
-                        then " allowing spaces"
-                        else ""
-                   )
-     in Test.Tasty.HUnit.testCase name result
+parseTest sp expected formatStr target = let
+    found = parse sp formatStr target
+    result = assertEqual "" expected found
+    name =
+        (show formatStr)
+            ++ " of "
+            ++ (show target)
+            ++ ( if sp
+                    then " allowing spaces"
+                    else ""
+               )
+    in Test.Tasty.HUnit.testCase name result
 
 {-
 readsTest :: forall t. (Show t, Eq t, ParseTime t) => Maybe t -> String -> String -> TestTree
@@ -328,10 +321,8 @@ enumAdd i a = toEnum (i + fromEnum a)
 
 getMilZoneLetter :: Int -> Char
 getMilZoneLetter 0 = 'Z'
-getMilZoneLetter h
-    | h < 0 = enumAdd (negate h) 'M'
-getMilZoneLetter h
-    | h < 10 = enumAdd (h - 1) 'A'
+getMilZoneLetter h | h < 0 = enumAdd (negate h) 'M'
+getMilZoneLetter h | h < 10 = enumAdd (h - 1) 'A'
 getMilZoneLetter h = enumAdd (h - 10) 'K'
 
 getMilZone :: Int -> TimeZone
@@ -373,9 +364,9 @@ compareParse expected fmt text = compareResult' (", parsing " ++ (show text)) (J
 
 --
 test_parse_format :: (FormatTime t, ParseTime t, Show t) => String -> t -> (String, String, Maybe t)
-test_parse_format f t =
-    let s = format f t
-     in (show t, s, parse False f s `asTypeOf` Just t)
+test_parse_format f t = let
+    s = format f t
+    in (show t, s, parse False f s `asTypeOf` Just t)
 
 --
 
@@ -391,6 +382,9 @@ prop_read_show_ZonedUTC t = compareResult (Just $ zonedTimeToUTC t) (readMaybe (
 prop_read_show_LocalUTC :: LocalTime -> Result
 prop_read_show_LocalUTC t = compareResult (Just $ localTimeToUTC utc t) (readMaybe (show t))
 
+prop_read_show_UTC_no_TZ :: UTCTime -> Result
+prop_read_show_UTC_no_TZ t = compareResult (Just t) $ readMaybe $ show $ utcToLocalTime utc t
+
 --
 
 -- * special show functions
@@ -411,16 +405,16 @@ prop_parse_showOrdinalDate d = compareParse d "%Y-%j" (showOrdinalDate d)
 
 --
 prop_fromMondayStartWeek :: Day -> Result
-prop_fromMondayStartWeek d =
-    let (w, wd) = mondayStartWeek d
-        (y, _, _) = toGregorian d
-     in compareResult d (fromMondayStartWeek y w wd)
+prop_fromMondayStartWeek d = let
+    (w, wd) = mondayStartWeek d
+    (y, _, _) = toGregorian d
+    in compareResult d (fromMondayStartWeek y w wd)
 
 prop_fromSundayStartWeek :: Day -> Result
-prop_fromSundayStartWeek d =
-    let (w, wd) = sundayStartWeek d
-        (y, _, _) = toGregorian d
-     in compareResult d (fromSundayStartWeek y w wd)
+prop_fromSundayStartWeek d = let
+    (w, wd) = sundayStartWeek d
+    (y, _, _) = toGregorian d
+    in compareResult d (fromSundayStartWeek y w wd)
 
 -- t == parse (format t)
 prop_parse_format :: (Eq t, FormatTime t, ParseTime t, Show t) => FormatString t -> t -> Result
@@ -450,13 +444,13 @@ prop_format_parse_format ::
     FormatCode ParseAndFormat t ->
     t ->
     Result
-prop_format_parse_format _ fc v =
-    let s1 = formatCode fc v
-        ms1 = in1970 (fmap (formatCode fc) (incompleteS :: Maybe t)) (fcSpecifier fc) s1
-        mv2 :: Maybe t
-        mv2 = parseCode fc s1
-        ms2 = fmap (formatCode fc) mv2
-     in compareResult ms1 ms2
+prop_format_parse_format _ fc v = let
+    s1 = formatCode fc v
+    ms1 = in1970 (fmap (formatCode fc) (incompleteS :: Maybe t)) (fcSpecifier fc) s1
+    mv2 :: Maybe t
+    mv2 = parseCode fc s1
+    ms2 = fmap (formatCode fc) mv2
+    in compareResult ms1 ms2
 
 instance HasFormatCodes Day where
     allFormatCodes _ = [(False, s) | s <- "DFxYyCBbhmdejfVUW"]
@@ -556,22 +550,22 @@ allTypes f =
 allLeapSecondTypes ::
     (forall t. (Eq t, Show t, Arbitrary t, FormatTime t, ParseTime t, HasFormatCodes t) => String -> t -> r) ->
     [r]
-allLeapSecondTypes f =
-    let day :: Day
-        day = fromGregorian 2000 01 01
-        lsTimeOfDay :: TimeOfDay
-        lsTimeOfDay = TimeOfDay 23 59 60.5
-        lsLocalTime :: LocalTime
-        lsLocalTime = LocalTime day lsTimeOfDay
-        lsZonedTime :: ZonedTime
-        lsZonedTime = ZonedTime lsLocalTime utc
-        lsUTCTime :: UTCTime
-        lsUTCTime = UTCTime day 86400.5
-     in [ f "TimeOfDay" lsTimeOfDay
-        , f "LocalTime" lsLocalTime
-        , f "ZonedTime" lsZonedTime
-        , f "UTCTime" lsUTCTime
-        ]
+allLeapSecondTypes f = let
+    day :: Day
+    day = fromGregorian 2000 01 01
+    lsTimeOfDay :: TimeOfDay
+    lsTimeOfDay = TimeOfDay 23 59 60.5
+    lsLocalTime :: LocalTime
+    lsLocalTime = LocalTime day lsTimeOfDay
+    lsZonedTime :: ZonedTime
+    lsZonedTime = ZonedTime lsLocalTime utc
+    lsUTCTime :: UTCTime
+    lsUTCTime = UTCTime day 86400.5
+    in [ f "TimeOfDay" lsTimeOfDay
+       , f "LocalTime" lsLocalTime
+       , f "ZonedTime" lsZonedTime
+       , f "UTCTime" lsUTCTime
+       ]
 
 parseEmptyTest ::
     forall t.
@@ -629,11 +623,12 @@ readShowTests =
         , nameTest "UTCTime" (prop_read_show :: UTCTime -> Result)
         , nameTest "UTCTime (zoned)" prop_read_show_ZonedUTC
         , nameTest "UTCTime (local)" prop_read_show_LocalUTC
+        , nameTest "UTCTime (no TZ)" prop_read_show_UTC_no_TZ
         , nameTest "UniversalTime" (prop_read_show :: UniversalTime -> Result)
         , nameTest "NominalDiffTime" (prop_read_show :: NominalDiffTime -> Result)
         , nameTest "DiffTime" (prop_read_show :: DiffTime -> Result)
-        --nameTest "CalendarDiffDays" (prop_read_show :: CalendarDiffDays -> Result),
-        --nameTest "CalendarDiffTime" (prop_read_show :: CalendarDiffTime -> Result)
+        -- nameTest "CalendarDiffDays" (prop_read_show :: CalendarDiffDays -> Result),
+        -- nameTest "CalendarDiffTime" (prop_read_show :: CalendarDiffTime -> Result)
         ]
 
 parseShowTests :: TestTree

test/main/Test/LocalTime/CalendarDiffTime.hs

@@ -2,16 +2,16 @@ module Test.LocalTime.CalendarDiffTime (
     testCalendarDiffTime,
 ) where
 
---import Data.Time.LocalTime
+-- import Data.Time.LocalTime
 import Test.Arbitrary ()
 import Test.Tasty
 
---import Test.Tasty.QuickCheck hiding (reason)
---testReadShow :: TestTree
---testReadShow = testProperty "read . show" $ \(t :: CalendarDiffTime) -> read (show t) == t
+-- import Test.Tasty.QuickCheck hiding (reason)
+-- testReadShow :: TestTree
+-- testReadShow = testProperty "read . show" $ \(t :: CalendarDiffTime) -> read (show t) == t
 testCalendarDiffTime :: TestTree
 testCalendarDiffTime =
     testGroup
         "CalendarDiffTime"
-        --testReadShow
+        -- testReadShow
         []

test/main/Test/LocalTime/Time.hs

@@ -10,16 +10,16 @@ import Test.Tasty
 import Test.Tasty.HUnit
 
 showCal :: Integer -> String
-showCal mjd =
-    let date = ModifiedJulianDay mjd
-        (y, m, d) = toGregorian date
-        date' = fromGregorian y m d
-     in concat
-            [ show mjd ++ "=" ++ showGregorian date ++ "=" ++ showOrdinalDate date ++ "=" ++ showWeekDate date ++ "\n"
-            , if date == date'
-                then ""
-                else "=" ++ (show $ toModifiedJulianDay date') ++ "!"
-            ]
+showCal mjd = let
+    date = ModifiedJulianDay mjd
+    (y, m, d) = toGregorian date
+    date' = fromGregorian y m d
+    in concat
+        [ show mjd ++ "=" ++ showGregorian date ++ "=" ++ showOrdinalDate date ++ "=" ++ showWeekDate date ++ "\n"
+        , if date == date'
+            then ""
+            else "=" ++ (show $ toModifiedJulianDay date') ++ "!"
+        ]
 
 testCal :: String
 testCal =
@@ -63,10 +63,10 @@ leapSec1998 :: UTCTime
 leapSec1998 = localTimeToUTC utc leapSec1998Cal
 
 testUTC :: String
-testUTC =
-    let lsMineCal = utcToLocalTime myzone leapSec1998
-        lsMine = localTimeToUTC myzone lsMineCal
-     in unlines [showCal 51178, show leapSec1998Cal, showUTCTime leapSec1998, show lsMineCal, showUTCTime lsMine]
+testUTC = let
+    lsMineCal = utcToLocalTime myzone leapSec1998
+    lsMine = localTimeToUTC myzone lsMineCal
+    in unlines [showCal 51178, show leapSec1998Cal, showUTCTime leapSec1998, show lsMineCal, showUTCTime lsMine]
 
 neglong :: Rational
 neglong = -120
@@ -86,15 +86,15 @@ testUT1 =
         ]
 
 testTimeOfDayToDayFraction :: String
-testTimeOfDayToDayFraction =
-    let f = dayFractionToTimeOfDay . timeOfDayToDayFraction
-     in unlines
-            [ show $ f $ TimeOfDay 12 34 56.789
-            , show $ f $ TimeOfDay 12 34 56.789123
-            , show $ f $ TimeOfDay 12 34 56.789123456
-            , show $ f $ TimeOfDay 12 34 56.789123456789
-            , show $ f $ TimeOfDay minBound 0 0
-            ]
+testTimeOfDayToDayFraction = let
+    f = dayFractionToTimeOfDay . timeOfDayToDayFraction
+    in unlines
+        [ show $ f $ TimeOfDay 12 34 56.789
+        , show $ f $ TimeOfDay 12 34 56.789123
+        , show $ f $ TimeOfDay 12 34 56.789123456
+        , show $ f $ TimeOfDay 12 34 56.789123456789
+        , show $ f $ TimeOfDay minBound 0 0
+        ]
 
 testTime :: TestTree
 testTime =

test/main/Test/LocalTime/TimeOfDay.hs

@@ -11,12 +11,12 @@ testTimeOfDay :: TestTree
 testTimeOfDay =
     testGroup
         "TimeOfDay"
-        [ testProperty "daysAndTimeOfDayToTime . timeToDaysAndTimeOfDay" $ \ndt ->
-            let (d, tod) = timeToDaysAndTimeOfDay ndt
-                ndt' = daysAndTimeOfDayToTime d tod
-             in ndt' == ndt
-        , testProperty "timeOfDayToTime . timeToTimeOfDay" $ \dt ->
-            let tod = timeToTimeOfDay dt
-                dt' = timeOfDayToTime tod
-             in dt' == dt
+        [ testProperty "daysAndTimeOfDayToTime . timeToDaysAndTimeOfDay" $ \ndt -> let
+            (d, tod) = timeToDaysAndTimeOfDay ndt
+            ndt' = daysAndTimeOfDayToTime d tod
+            in ndt' == ndt
+        , testProperty "timeOfDayToTime . timeToTimeOfDay" $ \dt -> let
+            tod = timeToTimeOfDay dt
+            dt' = timeOfDayToTime tod
+            in dt' == dt
         ]

test/unix/Test/Format/Format.hs

@@ -76,19 +76,20 @@ locale :: TimeLocale
 locale = defaultTimeLocale{dateTimeFmt = "%a %b %e %H:%M:%S %Y"}
 
 instance Random (F.Fixed res) where
-    randomR (MkFixed lo, MkFixed hi) oldgen =
-        let (v, newgen) = randomR (lo, hi) oldgen
-         in (MkFixed v, newgen)
-    random oldgen =
-        let (v, newgen) = random oldgen
-         in (MkFixed v, newgen)
+    randomR (MkFixed lo, MkFixed hi) oldgen = let
+        (v, newgen) = randomR (lo, hi) oldgen
+        in (MkFixed v, newgen)
+    random oldgen = let
+        (v, newgen) = random oldgen
+        in (MkFixed v, newgen)
 
 instance Arbitrary TimeZone where
     arbitrary = do
         mins <- choose (-2000, 2000)
         dst <- arbitrary
         hasName <- arbitrary
-        let name =
+        let
+            name =
                 if hasName
                     then "ZONE"
                     else ""
@@ -103,16 +104,17 @@ instance Arbitrary TimeOfDay where
 
 -- | The size of 'CTime' is platform-dependent.
 secondsFitInCTime :: Integer -> Bool
-secondsFitInCTime sec =
-    let CTime ct = fromInteger sec
-        sec' = toInteger ct
-     in sec == sec'
+secondsFitInCTime sec = let
+    CTime ct = fromInteger sec
+    sec' = toInteger ct
+    in sec == sec'
 
 instance Arbitrary UTCTime where
     arbitrary = do
         day <- choose (-25000, 75000)
         time <- arbitrary
-        let -- verify that the created time can fit in the local CTime
+        let
+            -- verify that the created time can fit in the local CTime
             localT = LocalTime (ModifiedJulianDay day) time
             utcT = localTimeToUTC utc localT
             secondsInteger = floor (utcTimeToPOSIXSeconds utcT)
@@ -145,12 +147,12 @@ unixWorkarounds _ s = s
 compareFormat :: (String -> String) -> String -> TimeZone -> UTCTime -> Result
 compareFormat _modUnix fmt zone _time
     | last fmt == 'Z' && timeZoneName zone == "" = rejected
-compareFormat modUnix fmt zone time =
-    let ctime = utcToZonedTime zone time
-        haskellText = formatTime locale fmt ctime
-        unixText = unixFormatTime fmt zone time
-        expectedText = unixWorkarounds fmt (modUnix unixText)
-     in assertEqualQC (show time ++ " with " ++ show zone) expectedText haskellText
+compareFormat modUnix fmt zone time = let
+    ctime = utcToZonedTime zone time
+    haskellText = formatTime locale fmt ctime
+    unixText = unixFormatTime fmt zone time
+    expectedText = unixWorkarounds fmt (modUnix unixText)
+    in assertEqualQC (show time ++ " with " ++ show zone) expectedText haskellText
 
 -- as found in http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html
 -- plus FgGklz
@@ -198,10 +200,10 @@ testCompareHashFormat =
 
 formatUnitTest :: String -> Pico -> String -> TestTree
 formatUnitTest fmt sec expected =
-    nameTest (show fmt) $
-        let tod = TimeOfDay 0 0 (1 + sec)
-            found = formatTime locale fmt tod
-         in assertEqual "" expected found
+    nameTest (show fmt) $ let
+        tod = TimeOfDay 0 0 (1 + sec)
+        found = formatTime locale fmt tod
+        in assertEqual "" expected found
 
 testQs :: [TestTree]
 testQs =

time.cabal

 cabal-version:  3.0
 name:           time
-version:        1.12.1
+version:        1.12.2
 stability:      stable
 license:        BSD-2-Clause
 license-file:   LICENSE
@@ -13,9 +13,9 @@ description:    Time, clocks and calendars
 category:       Time
 build-type:     Configure
 tested-with:
-    GHC == 8.8.4,
     GHC == 8.10.7,
-    GHC == 9.0.1
+    GHC == 9.0.2,
+    GHC == 9.2.2
 x-follows-version-policy:
 
 extra-source-files:
@@ -49,7 +49,7 @@ library
     ghc-options: -Wall -fwarn-tabs
     c-sources: lib/cbits/HsTime.c
     build-depends:
-        base >= 4.13 && < 5,
+        base >= 4.14 && < 5,
         deepseq >= 1.1
     if os(windows)
         build-depends: Win32
@@ -122,6 +122,16 @@ test-suite ShowDefaultTZAbbreviations
         time
     main-is: ShowDefaultTZAbbreviations.hs
 
+test-suite ShowTime
+    type: exitcode-stdio-1.0
+    hs-source-dirs: test
+    default-language: Haskell2010
+    ghc-options: -Wall -fwarn-tabs
+    build-depends:
+        base,
+        time
+    main-is: ShowTime.hs
+
 test-suite test-main
     type: exitcode-stdio-1.0
     hs-source-dirs: test/main