lib/Data/Time/LocalTime/Internal/TimeZone.hs

@@ -26,12 +26,12 @@ import Foreign.C
 
 -- | A TimeZone is a whole number of minutes offset from UTC, together with a name and a \"just for summer\" flag.
 data TimeZone = TimeZone
-    { -- | The number of minutes offset from UTC. Positive means local time will be later in the day than UTC.
-      timeZoneMinutes :: Int
-    , -- | Is this time zone just persisting for the summer?
-      timeZoneSummerOnly :: Bool
-    , -- | The name of the zone, typically a three- or four-letter acronym.
-      timeZoneName :: String
+    { timeZoneMinutes :: Int
+    -- ^ The number of minutes offset from UTC. Positive means local time will be later in the day than UTC.
+    , timeZoneSummerOnly :: Bool
+    -- ^ Is this time zone just persisting for the summer?
+    , timeZoneName :: String
+    -- ^ The name of the zone, typically a three- or four-letter acronym.
     }
     deriving (Eq, Ord, Data, Typeable)
 
@@ -48,12 +48,11 @@ hoursToTimeZone i = minutesToTimeZone (60 * i)
 
 showT :: Bool -> PadOption -> Int -> String
 showT False opt t = showPaddedNum opt ((div t 60) * 100 + (mod t 60))
-showT True opt t =
-    let opt' =
-            case opt of
-                NoPad -> NoPad
-                Pad i c -> Pad (max 0 $ i - 3) c
-     in showPaddedNum opt' (div t 60) ++ ":" ++ show2 (mod t 60)
+showT True opt t = let
+    opt' = case opt of
+        NoPad -> NoPad
+        Pad i c -> Pad (max 0 $ i - 3) c
+    in showPaddedNum opt' (div t 60) ++ ":" ++ show2 (mod t 60)
 
 timeZoneOffsetString'' :: Bool -> PadOption -> TimeZone -> String
 timeZoneOffsetString'' colon opt (TimeZone t _ _)
@@ -104,25 +103,52 @@ getTimeZoneCTime ctime =
 
 -- there's no instance Bounded CTime, so this is the easiest way to check for overflow
 toCTime :: Int64 -> IO CTime
-toCTime t =
-    let tt = fromIntegral t
-        t' = fromIntegral tt
-     in if t' == t
-            then return $ CTime tt
-            else fail "Data.Time.LocalTime.Internal.TimeZone.toCTime: Overflow"
-
--- | Get the local time-zone for a given time (varying as per summertime adjustments).
+toCTime t = let
+    tt = fromIntegral t
+    t' = fromIntegral tt
+    in if t' == t
+        then return $ CTime tt
+        else fail "Data.Time.LocalTime.Internal.TimeZone.toCTime: Overflow"
+
+-- | Get the configured time-zone for a given time (varying as per summertime adjustments).
 getTimeZoneSystem :: SystemTime -> IO TimeZone
 getTimeZoneSystem t = do
     ctime <- toCTime $ systemSeconds t
     getTimeZoneCTime ctime
 
--- | Get the local time-zone for a given time (varying as per summertime adjustments).
+-- | Get the configured time-zone for a given time (varying as per summertime adjustments).
+--
+-- On Unix systems the output of this function depends on:
+--
+-- 1. The value of @TZ@ environment variable (if set)
+--
+-- 2. The system time zone (usually configured by @\/etc\/localtime@ symlink)
+--
+-- For details see tzset(3) and localtime(3).
+--
+-- Example:
+--
+-- @
+-- > let t = `UTCTime` (`Data.Time.Calendar.fromGregorian` 2021 7 1) 0
+-- > `getTimeZone` t
+-- CEST
+-- > `System.Environment.setEnv` \"TZ\" \"America/New_York\" >> `getTimeZone` t
+-- EDT
+-- > `System.Environment.setEnv` \"TZ\" \"Europe/Berlin\" >> `getTimeZone` t
+-- CEST
+-- @
+--
+-- On Windows systems the output of this function depends on:
+--
+-- 1. The value of @TZ@ environment variable (if set).
+-- See [here](https://docs.microsoft.com/en-us/cpp/c-runtime-library/reference/tzset) for how Windows interprets this variable.
+--
+-- 2. The system time zone, configured in Settings
 getTimeZone :: UTCTime -> IO TimeZone
 getTimeZone t = do
     ctime <- toCTime $ floor $ utcTimeToPOSIXSeconds t
     getTimeZoneCTime ctime
 
--- | Get the current time-zone.
+-- | Get the configured time-zone for the current time.
 getCurrentTimeZone :: IO TimeZone
 getCurrentTimeZone = getSystemTime >>= getTimeZoneSystem

lib/Data/Time/LocalTime/Internal/ZonedTime.hs

@@ -37,6 +37,7 @@ utcToZonedTime zone time = ZonedTime (utcToLocalTime zone time) zone
 zonedTimeToUTC :: ZonedTime -> UTCTime
 zonedTimeToUTC (ZonedTime t zone) = localTimeToUTC zone t
 
+-- | For the time zone, this only shows the name, or offset if the name is empty.
 instance Show ZonedTime where
     show (ZonedTime t zone) = show t ++ " " ++ show zone
 
@@ -50,7 +51,6 @@ getZonedTime = do
     zone <- getTimeZone t
     return (utcToZonedTime zone t)
 
--- |
 utcToLocalZonedTime :: UTCTime -> IO ZonedTime
 utcToLocalZonedTime t = do
     zone <- getTimeZone t

lib/cbits/HsTime.c

@@ -5,7 +5,7 @@ long int get_current_timezone_seconds (time_t t,int* pdst,char const* * pname)
 {
 #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)
     // When compiling with MinGW (which does not provide a full POSIX
-    // layer as opposed to CygWin) it's better to use the CRT's
+    // layer as opposed to Cygwin) it's better to use the CRT's
     // underscore-prefixed `_tzset()` variant to avoid linker issues
     // as Microsoft considers the POSIX named `tzset()` function
     // deprecated (see http://msdn.microsoft.com/en-us/library/ms235384.aspx)

stack.yaml

-resolver: lts-18.13
+resolver: lts-19.6
 packages:
 - '.'
 allow-newer: true
@@ -10,11 +10,13 @@ build:
         additional-args: [--hide-successes]
 
 extra-deps:
-- process-1.6.10.0
+- process-1.6.13.2
 - unix-2.7.2.2
-- directory-1.3.6.1
-- hpc-0.6.0.3
-- fourmolu-0.3.0.0
+- directory-1.3.7.0
+- Cabal-3.6.2.0
+- ghc-lib-parser-9.2.1.20211101
+- git: https://github.com/AshleyYakeley/fourmolu.git
+  commit: 3b62452795ac8029f7f645f834e74737a355bd14
 
 ghc-options:
     "$locals": -Werror -Wincomplete-uni-patterns -Wincomplete-record-updates -Wredundant-constraints -Wcompat -Wnoncanonical-monad-instances

stack.yaml.lock

@@ -5,43 +5,54 @@
 
 packages:
 - completed:
-    hackage: process-1.6.10.0@sha256:c0d2d8adaca7cea7ceaa60e67b61c775dc03727b83bdb1c97aa8cbeac9f5dd84,2469
+    hackage: process-1.6.13.2@sha256:a6530a5698796e29d85817f74ca3ae20d2172fb9fa52b492c2e6816e1306bfe8,2963
     pantry-tree:
-      size: 1211
-      sha256: 6e90778b5105753d7de0f7a0c502dadf8f04825f17a36186aa801e56ef7ca206
+      size: 1543
+      sha256: 045d10d710f046aa69ab3dd3f425b9479820809d6c3ca1596e0b995bcf49ac7a
   original:
-    hackage: process-1.6.10.0
+    hackage: process-1.6.13.2
 - completed:
-    hackage: unix-2.7.2.2@sha256:55d8af3f25d2a92c86951a2d8fc47aebe80015a895c4f0e57320cfdae78dd7c1,3496
+    hackage: unix-2.7.2.2@sha256:15f5365c5995634e45de1772b9504761504a310184e676bc2ef60a14536dbef9,3496
     pantry-tree:
       size: 3536
-      sha256: e816eca2bf42fda4da49c744b146a301ae0435380cc163ad2fbc889cf0a4e27f
+      sha256: 36434ced74d679622d61b69e8d92e1bd632d9ef3e284c63094653b2e473b0553
   original:
     hackage: unix-2.7.2.2
 - completed:
-    hackage: directory-1.3.6.1@sha256:3dc9c69c8e09ec95a7a45c6d06abe0f0d2f604439c37e5f88e5a6c335b088d71,2810
+    hackage: directory-1.3.7.0@sha256:4d59f9714700e69d139084b47204fc91f13f31546aac39d666279996192b0d11,2940
     pantry-tree:
       size: 3433
-      sha256: 9247d0e7cfbf9946b922d23bd56a6b765cdb91f71d72f8ae6ed22c94dbd9f1db
+      sha256: 88b74942886e886b22ac1f3f0f65168563df4848766f372aaf014f712d3abb9a
   original:
-    hackage: directory-1.3.6.1
+    hackage: directory-1.3.7.0
 - completed:
-    hackage: hpc-0.6.0.3@sha256:de3f7982345d315f1d7713df38b4f2cf09bd274f7d64dffec0cf2a0d9c8aab19,1185
+    hackage: Cabal-3.6.2.0@sha256:e2266e14758c1f799220fad7f0d4b0b4ec567d81b7ba3faea17ff76d4c31de95,12437
     pantry-tree:
-      size: 432
-      sha256: 4686c367eb25eb4d32d66bd4c080d6caa2b5e78c73beea3993db690137e1d6cb
+      size: 19757
+      sha256: 6650e54cbbcda6d05c4d8b8094fa61e5ffbda15a798a354d2dad5b35dc3b2859
   original:
-    hackage: hpc-0.6.0.3
+    hackage: Cabal-3.6.2.0
 - completed:
-    hackage: fourmolu-0.3.0.0@sha256:4ce7683b97d5cdcac6cfec0a64298b67fd2777bfba2c484148a24d2c6bdb6ad8,6496
+    hackage: ghc-lib-parser-9.2.1.20211101@sha256:c7f5649391acb4ceec6770acce3b77dea8aad3fd442b2a32a1d0dbaede080c0b,12705
     pantry-tree:
-      size: 108479
-      sha256: d929dbd007e5b093f4ce8787c3ad625f0b083351773f34375b0b4e55dd666be0
+      size: 27578
+      sha256: 445b7dd1908b8187dfdab87673a68f1ca42e2bcfd7dd68f04a3ad91a2215e3e2
   original:
-    hackage: fourmolu-0.3.0.0
+    hackage: ghc-lib-parser-9.2.1.20211101
+- completed:
+    name: fourmolu
+    version: 0.5.0.1
+    git: https://github.com/AshleyYakeley/fourmolu.git
+    pantry-tree:
+      size: 128923
+      sha256: 20ce0b8c5a8a591497162afdd85cd88faa87b4c98eb93c91eb0c6f9672c87a42
+    commit: 3b62452795ac8029f7f645f834e74737a355bd14
+  original:
+    git: https://github.com/AshleyYakeley/fourmolu.git
+    commit: 3b62452795ac8029f7f645f834e74737a355bd14
 snapshots:
 - completed:
-    size: 586268
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/13.yaml
-    sha256: d9e658a22cfe8d87a64fdf219885f942fef5fe2bcb156a9800174911c5da2443
-  original: lts-18.13
+    size: 618876
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/6.yaml
+    sha256: fb634b19f31da06684bb07ce02a20c75a3162138f279b388905b03ebd57bb50f
+  original: lts-19.6

test/ShowTime.hs

+module Main (main) where
+
+import Data.Time
+
+main :: IO ()
+main = do
+    now <- getZonedTime
+    putStrLn $ show now

test/UseCases.lhs

@@ -49,7 +49,7 @@ first day of the year it occurred in?
 
 * Given a date X, how do I find the last day of the month that X occurs in.
 For example, If X is July 4th, 2005, then I want the result to be July 31st,
-2005. If X is Februrary 5, then I want the result to be Februrary 28 for
+2005. If X is February 5, then I want the result to be February 28 for
 non-leap-years and February 29 for leap years.
 
 > lastDayOfMonth day = fromGregorian y m (gregorianMonthLength y m) where

test/main/Test/Arbitrary.hs

@@ -39,24 +39,24 @@ supportedDayRange = (fromGregorian (-9899) 1 1, fromGregorian 9999 12 31)
 
 instance Arbitrary Day where
     arbitrary = choose supportedDayRange
-    shrink day =
-        let (y, m, d) = toGregorian day
-            dayShrink =
-                if d > 1
-                    then [fromGregorian y m (d - 1)]
-                    else []
-            monthShrink =
-                if m > 1
-                    then [fromGregorian y (m - 1) d]
-                    else []
-            yearShrink =
-                if y > 2000
-                    then [fromGregorian (y - 1) m d]
-                    else
-                        if y < 2000
-                            then [fromGregorian (y + 1) m d]
-                            else []
-         in dayShrink ++ monthShrink ++ yearShrink
+    shrink day = let
+        (y, m, d) = toGregorian day
+        dayShrink =
+            if d > 1
+                then [fromGregorian y m (d - 1)]
+                else []
+        monthShrink =
+            if m > 1
+                then [fromGregorian y (m - 1) d]
+                else []
+        yearShrink =
+            if y > 2000
+                then [fromGregorian (y - 1) m d]
+                else
+                    if y < 2000
+                        then [fromGregorian (y + 1) m d]
+                        else []
+        in dayShrink ++ monthShrink ++ yearShrink
 
 instance CoArbitrary Day where
     coarbitrary (ModifiedJulianDay d) = coarbitrary d
@@ -97,29 +97,28 @@ instance Arbitrary CalendarDiffTime where
 
 reduceDigits :: Int -> Pico -> Maybe Pico
 reduceDigits (-1) _ = Nothing
-reduceDigits n x =
-    let d :: Pico
-        d = 10 ^^ (negate n)
-        r = mod' x d
-     in case r of
-            0 -> reduceDigits (n - 1) x
-            _ -> Just $ x - r
+reduceDigits n x = let
+    d :: Pico
+    d = 10 ^^ (negate n)
+    r = mod' x d
+    in case r of
+        0 -> reduceDigits (n - 1) x
+        _ -> Just $ x - r
 
 instance Arbitrary TimeOfDay where
     arbitrary = liftM timeToTimeOfDay arbitrary
-    shrink (TimeOfDay h m s) =
-        let shrinkInt 0 = []
-            shrinkInt 1 = [0]
-            shrinkInt _ = [0, 1]
-            shrinkPico 0 = []
-            shrinkPico 1 = [0]
-            shrinkPico p =
-                case reduceDigits 12 p of
-                    Just p' -> [0, 1, p']
-                    Nothing -> [0, 1]
-         in [TimeOfDay h' m s | h' <- shrinkInt h]
-            ++ [TimeOfDay h m' s | m' <- shrinkInt m]
-                ++ [TimeOfDay h m s' | s' <- shrinkPico s]
+    shrink (TimeOfDay h m s) = let
+        shrinkInt 0 = []
+        shrinkInt 1 = [0]
+        shrinkInt _ = [0, 1]
+        shrinkPico 0 = []
+        shrinkPico 1 = [0]
+        shrinkPico p = case reduceDigits 12 p of
+            Just p' -> [0, 1, p']
+            Nothing -> [0, 1]
+        in [TimeOfDay h' m s | h' <- shrinkInt h]
+        ++ [TimeOfDay h m' s | m' <- shrinkInt m]
+            ++ [TimeOfDay h m s' | s' <- shrinkPico s]
 
 instance CoArbitrary TimeOfDay where
     coarbitrary t = coarbitrary (timeOfDayToTime t)

test/main/Test/Calendar/ClipDates.hs

@@ -23,9 +23,9 @@ tupleUp2 :: [a] -> [b] -> [(a, b)]
 tupleUp2 l1 l2 = concatMap (\e -> map (e,) l2) l1
 
 tupleUp3 :: [a] -> [b] -> [c] -> [(a, b, c)]
-tupleUp3 l1 l2 l3 =
-    let ts = tupleUp2 l2 l3
-     in concatMap (\e -> map (\(f, g) -> (e, f, g)) ts) l1
+tupleUp3 l1 l2 l3 = let
+    ts = tupleUp2 l2 l3
+    in concatMap (\e -> map (\(f, g) -> (e, f, g)) ts) l1
 
 testPairs :: String -> [String] -> [String] -> TestTree
 testPairs name expected found = testGroup name $ fmap (\(e, f) -> testCase e $ assertEqual "" e f) $ zip expected found

test/main/Test/Calendar/ConvertBack.hs

@@ -10,19 +10,19 @@ import Test.Tasty
 import Test.Tasty.HUnit
 
 checkDay :: (Show t) => (Day -> t) -> (t -> Day) -> (t -> Maybe Day) -> Day -> String
-checkDay encodeDay decodeDay decodeDayValid day =
-    let st = encodeDay day
-        day' = decodeDay st
-        mday' = decodeDayValid st
-        a =
-            if day /= day'
-                then unwords [show day, "-> ", show st, "-> ", show day', "(diff", show (diffDays day' day) ++ ")"]
-                else ""
-        b =
-            if Just day /= mday'
-                then unwords [show day, "->", show st, "->", show mday']
-                else ""
-     in a ++ b
+checkDay encodeDay decodeDay decodeDayValid day = let
+    st = encodeDay day
+    day' = decodeDay st
+    mday' = decodeDayValid st
+    a =
+        if day /= day'
+            then unwords [show day, "-> ", show st, "-> ", show day', "(diff", show (diffDays day' day) ++ ")"]
+            else ""
+    b =
+        if Just day /= mday'
+            then unwords [show day, "->", show st, "->", show mday']
+            else ""
+    in a ++ b
 
 checkers :: [Day -> String]
 checkers =

test/main/Test/Calendar/DayPeriod.hs

@@ -5,6 +5,7 @@ module Test.Calendar.DayPeriod (
 import Data.Time.Calendar
 import Data.Time.Calendar.Month
 import Data.Time.Calendar.Quarter
+import Test.Arbitrary ()
 import Test.Tasty
 import Test.Tasty.HUnit
 import Test.Tasty.QuickCheck
@@ -69,6 +70,7 @@ testDayPeriod =
         , testGroup "Month" testMonth
         , testGroup "Quarter" testQuarter
         , testGroup "Year" testYear
+        , testGroup "Week" testWeek
         ]
 
 testDay :: [TestTree]
@@ -156,3 +158,18 @@ testYear =
     , testProperty "periodLength" $ \(MkWYear y) ->
         periodLength y >= 365
     ]
+
+testWeek :: [TestTree]
+testWeek =
+    [ testProperty "weekFirstDay/weekLastDay range" $ \dw (MkWDay d) -> let
+        f = weekFirstDay dw d
+        l = weekLastDay dw d
+        in f <= d && d <= l
+    , testProperty "weekFirstDay/weekLastDay range" $ \dw (MkWDay d) -> let
+        f = weekFirstDay dw d
+        l = weekLastDay dw d
+        in addDays 6 f == l
+    , testProperty "weekFirstDay dayOfWeek" $ \dw (MkWDay d) -> let
+        f = weekFirstDay dw d
+        in dayOfWeek f == dw
+    ]

test/main/Test/Calendar/Duration.hs

@@ -24,12 +24,12 @@ testAddDiff =
         ]
 
 testClip :: (Integer, Int, Int) -> (Integer, Int, Int) -> (Integer, Integer) -> TestTree
-testClip (y1, m1, d1) (y2, m2, d2) (em, ed) =
-    let day1 = fromGregorian y1 m1 d1
-        day2 = fromGregorian y2 m2 d2
-        expected = CalendarDiffDays em ed
-        found = diffGregorianDurationClip day1 day2
-     in testCase (show day1 ++ " - " ++ show day2) $ assertEqual "" expected found
+testClip (y1, m1, d1) (y2, m2, d2) (em, ed) = let
+    day1 = fromGregorian y1 m1 d1
+    day2 = fromGregorian y2 m2 d2
+    expected = CalendarDiffDays em ed
+    found = diffGregorianDurationClip day1 day2
+    in testCase (show day1 ++ " - " ++ show day2) $ assertEqual "" expected found
 
 testDiffs :: TestTree
 testDiffs =

test/main/Test/Calendar/Easter.hs

@@ -18,20 +18,20 @@ showWithWDay = formatTime defaultTimeLocale "%F %A"
 
 testEaster :: TestTree
 testEaster =
-    testCase "testEaster" $
-        let ds = unlines $ map (\day -> unwords [showWithWDay day, "->", showWithWDay (sundayAfter day)]) days
-            f y =
-                unwords
-                    [ show y ++ ", Gregorian: moon,"
-                    , show (gregorianPaschalMoon y) ++ ": Easter,"
-                    , showWithWDay (gregorianEaster y)
-                    ]
-                    ++ "\n"
-            g y =
-                unwords
-                    [ show y ++ ", Orthodox : moon,"
-                    , show (orthodoxPaschalMoon y) ++ ": Easter,"
-                    , showWithWDay (orthodoxEaster y)
-                    ]
-                    ++ "\n"
-         in assertEqual "" testEasterRef $ ds ++ concatMap (\y -> f y ++ g y) [2000 .. 2020]
+    testCase "testEaster" $ let
+        ds = unlines $ map (\day -> unwords [showWithWDay day, "->", showWithWDay (sundayAfter day)]) days
+        f y =
+            unwords
+                [ show y ++ ", Gregorian: moon,"
+                , show (gregorianPaschalMoon y) ++ ": Easter,"
+                , showWithWDay (gregorianEaster y)
+                ]
+                ++ "\n"
+        g y =
+            unwords
+                [ show y ++ ", Orthodox : moon,"
+                , show (orthodoxPaschalMoon y) ++ ": Easter,"
+                , showWithWDay (orthodoxEaster y)
+                ]
+                ++ "\n"
+        in assertEqual "" testEasterRef $ ds ++ concatMap (\y -> f y ++ g y) [2000 .. 2020]

test/main/Test/Calendar/MonthDay.hs

@@ -24,9 +24,10 @@ testMonthDay =
     yearDays isLeap =
         map
             ( \yd ->
-                let (m, d) = dayOfYearToMonthAndDay isLeap yd
+                let
+                    (m, d) = dayOfYearToMonthAndDay isLeap yd
                     yd' = monthAndDayToDayOfYear isLeap m d
                     mdtext = show m ++ "-" ++ show d
-                 in showCompare yd mdtext yd'
+                    in showCompare yd mdtext yd'
             )
             [-2 .. 369]

test/main/Test/Calendar/Valid.hs

@@ -11,36 +11,36 @@ import Test.Tasty
 import Test.Tasty.QuickCheck hiding (reason)
 
 validResult :: (Eq c, Show c, Eq t, Show t) => (s -> c) -> Bool -> (t -> c) -> (c -> t) -> (c -> Maybe t) -> s -> Result
-validResult sc valid toComponents fromComponents fromComponentsValid s =
-    let c = sc s
-        mt = fromComponentsValid c
-        t' = fromComponents c
-        c' = toComponents t'
-     in if valid
-            then case mt of
-                Nothing -> rejected
-                Just t ->
-                    if t' /= t
-                        then failed{reason = "'fromValid' gives " ++ show t ++ ", but 'from' gives " ++ show t'}
-                        else
-                            if c' /= c
-                                then
-                                    failed
-                                        { reason =
-                                            "found valid, but converts "
-                                                ++ show c
-                                                ++ " -> "
-                                                ++ show t'
-                                                ++ " -> "
-                                                ++ show c'
-                                        }
-                                else succeeded
-            else case mt of
-                Nothing ->
-                    if c' /= c
-                        then succeeded
-                        else failed{reason = show c ++ " found invalid, but converts with " ++ show t'}
-                Just _ -> rejected
+validResult sc valid toComponents fromComponents fromComponentsValid s = let
+    c = sc s
+    mt = fromComponentsValid c
+    t' = fromComponents c
+    c' = toComponents t'
+    in if valid
+        then case mt of
+            Nothing -> rejected
+            Just t ->
+                if t' /= t
+                    then failed{reason = "'fromValid' gives " ++ show t ++ ", but 'from' gives " ++ show t'}
+                    else
+                        if c' /= c
+                            then
+                                failed
+                                    { reason =
+                                        "found valid, but converts "
+                                            ++ show c
+                                            ++ " -> "
+                                            ++ show t'
+                                            ++ " -> "
+                                            ++ show c'
+                                    }
+                            else succeeded
+        else case mt of
+            Nothing ->
+                if c' /= c
+                    then succeeded
+                    else failed{reason = show c ++ " found invalid, but converts with " ++ show t'}
+            Just _ -> rejected
 
 validTest ::
     (Arbitrary s, Show s, Eq c, Show c, Eq t, Show t) =>
@@ -58,16 +58,16 @@ validTest name sc toComponents fromComponents fromComponentsValid =
         ]
 
 toSundayStartWeek :: Day -> (Integer, Int, Int)
-toSundayStartWeek day =
-    let (y, _) = toOrdinalDate day
-        (w, d) = sundayStartWeek day
-     in (y, w, d)
+toSundayStartWeek day = let
+    (y, _) = toOrdinalDate day
+    (w, d) = sundayStartWeek day
+    in (y, w, d)
 
 toMondayStartWeek :: Day -> (Integer, Int, Int)
-toMondayStartWeek day =
-    let (y, _) = toOrdinalDate day
-        (w, d) = mondayStartWeek day
-     in (y, w, d)
+toMondayStartWeek day = let
+    (y, _) = toOrdinalDate day
+    (w, d) = mondayStartWeek day
+    in (y, w, d)
 
 newtype WYear
     = MkWYear Year

test/main/Test/Calendar/Week.hs

@@ -99,27 +99,27 @@ prop_firstDayOfWeekOnAfter_Day :: DayOfWeek -> Day -> Bool
 prop_firstDayOfWeekOnAfter_Day dw d = dayOfWeek (firstDayOfWeekOnAfter dw d) == dw
 
 prop_toFromWeekCalendar :: FirstWeekType -> DayOfWeek -> Day -> Bool
-prop_toFromWeekCalendar wt ws d =
-    let (y, wy, dw) = toWeekCalendar wt ws d
-     in fromWeekCalendar wt ws y wy dw == d
+prop_toFromWeekCalendar wt ws d = let
+    (y, wy, dw) = toWeekCalendar wt ws d
+    in fromWeekCalendar wt ws y wy dw == d
 
 prop_weekChanges :: FirstWeekType -> DayOfWeek -> Day -> Bool
-prop_weekChanges wt ws d =
-    let (_, wy0, _) = toWeekCalendar wt ws d
-        (_, wy1, dw) = toWeekCalendar wt ws $ succ d
-     in if dw == ws then wy0 /= wy1 else wy0 == wy1
+prop_weekChanges wt ws d = let
+    (_, wy0, _) = toWeekCalendar wt ws d
+    (_, wy1, dw) = toWeekCalendar wt ws $ succ d
+    in if dw == ws then wy0 /= wy1 else wy0 == wy1
 
 prop_weekYearWholeStart :: DayOfWeek -> Year -> Bool
-prop_weekYearWholeStart ws y =
-    let d = fromWeekCalendar FirstWholeWeek ws y 1 ws
-        (y', dy) = toOrdinalDate d
-     in y == y' && dy >= 1 && dy <= 7
+prop_weekYearWholeStart ws y = let
+    d = fromWeekCalendar FirstWholeWeek ws y 1 ws
+    (y', dy) = toOrdinalDate d
+    in y == y' && dy >= 1 && dy <= 7
 
 prop_weekYearMostStart :: DayOfWeek -> Year -> Bool
-prop_weekYearMostStart ws y =
-    let d = fromWeekCalendar FirstMostWeek ws y 2 ws
-        (y', dy) = toOrdinalDate d
-     in y == y' && dy >= 5 && dy <= 11
+prop_weekYearMostStart ws y = let
+    d = fromWeekCalendar FirstMostWeek ws y 2 ws
+    (y', dy) = toOrdinalDate d
+    in y == y' && dy >= 5 && dy <= 11
 
 testDiff :: TestTree
 testDiff =
@@ -135,5 +135,105 @@ testDiff =
         , nameTest "weekYearMostStart" prop_weekYearMostStart
         ]
 
+testWeekDays :: TestTree
+testWeekDays =
+    nameTest
+        "Week Days"
+        [ testGroup "weekAllDays" weekAllDaysTests
+        , testGroup "weekFirstDay" weekFirstDayTests
+        , testGroup "weekLastDay" weekLastDayTests
+        ]
+
+weekAllDaysTests :: [TestTree]
+weekAllDaysTests =
+    [ testGroup
+        "Property Tests"
+        [ nameTest "Week have 7 days" weekHaveSevenDays
+        , nameTest "Day is part of the week" dayIsPartOfWeek
+        ]
+    , testGroup
+        "Unit Tests"
+        [ nameTest "FirstDay is less than Day-DayOfWeek" $
+            assertEqual
+                ""
+                [YearMonthDay 2023 12 31 .. YearMonthDay 2024 1 6]
+                (weekAllDays Sunday (YearMonthDay 2024 1 1))
+        , nameTest "FirstDay is equal to Day-DayOfWeek" $
+            assertEqual
+                ""
+                [YearMonthDay 2024 2 26 .. YearMonthDay 2024 3 3]
+                (weekAllDays Monday (YearMonthDay 2024 2 26))
+        , nameTest "FirstDay is greater than Day-DayOfWeek" $
+            assertEqual
+                ""
+                [YearMonthDay 2022 2 15 .. YearMonthDay 2022 2 21]
+                (weekAllDays Tuesday (YearMonthDay 2022 2 21))
+        ]
+    ]
+  where
+    weekHaveSevenDays :: DayOfWeek -> Day -> Bool
+    weekHaveSevenDays fd d = length (weekAllDays fd d) == 7
+
+    dayIsPartOfWeek :: DayOfWeek -> Day -> Bool
+    dayIsPartOfWeek fd d = d `elem` weekAllDays fd d
+
+weekFirstDayTests :: [TestTree]
+weekFirstDayTests =
+    [ testGroup
+        "Property Tests"
+        [ nameTest "FirsyDay matches the Day-DayOfWeek" firstDayMatchesDay
+        ]
+    , testGroup
+        "Unit Tests"
+        [ nameTest "FirstDay is less than Day-DayOfWeek" $
+            assertEqual
+                ""
+                (YearMonthDay 2022 2 20)
+                (weekFirstDay Sunday (YearMonthDay 2022 2 21))
+        , nameTest "FirstDay is equal to Day-DayOfWeek" $
+            assertEqual
+                ""
+                (YearMonthDay 2022 2 21)
+                (weekFirstDay Monday (YearMonthDay 2022 2 21))
+        , nameTest "FirstDay is greater than Day-DayOfWeek" $
+            assertEqual
+                ""
+                (YearMonthDay 2022 2 15)
+                (weekFirstDay Tuesday (YearMonthDay 2022 2 21))
+        ]
+    ]
+  where
+    firstDayMatchesDay :: DayOfWeek -> Day -> Bool
+    firstDayMatchesDay fd d = dayOfWeek (weekFirstDay fd d) == fd
+
+weekLastDayTests :: [TestTree]
+weekLastDayTests =
+    [ nameTest "FirstDay is less than Day-DayOfWeek" $
+        assertEqual
+            ""
+            (YearMonthDay 2022 2 26)
+            (weekLastDay Sunday (YearMonthDay 2022 2 21))
+    , nameTest "FirstDay is equal to Day-DayOfWeek" $
+        assertEqual
+            ""
+            (YearMonthDay 2022 2 27)
+            (weekLastDay Monday (YearMonthDay 2022 2 21))
+    , nameTest "FirstDay is greater than Day-DayOfWeek" $
+        assertEqual
+            ""
+            (YearMonthDay 2022 2 21)
+            (weekLastDay Tuesday (YearMonthDay 2022 2 21))
+    ]
+
 testWeek :: TestTree
-testWeek = nameTest "Week" [testDay, testSucc, testPred, testSequences, testReadShow, testDiff]
+testWeek =
+    nameTest
+        "Week"
+        [ testDay
+        , testSucc
+        , testPred
+        , testSequences
+        , testReadShow
+        , testDiff
+        , testWeekDays
+        ]

test/main/Test/Clock/Conversion.hs

@@ -9,17 +9,17 @@ import Test.Tasty.HUnit
 
 testClockConversion :: TestTree
 testClockConversion =
-    testGroup "clock conversion" $
-        let testPair :: (SystemTime, UTCTime) -> TestTree
-            testPair (st, ut) =
-                testGroup (show ut) $
-                    [ testCase "systemToUTCTime" $ assertEqual (show ut) ut $ systemToUTCTime st
-                    , testCase "utcToSystemTime" $ assertEqual (show ut) st $ utcToSystemTime ut
-                    ]
-         in [ testPair (MkSystemTime 0 0, UTCTime systemEpochDay 0)
-            , testPair (MkSystemTime 86399 0, UTCTime systemEpochDay 86399)
-            , testPair (MkSystemTime 86399 999999999, UTCTime systemEpochDay 86399.999999999)
-            , testPair (MkSystemTime 86399 1000000000, UTCTime systemEpochDay 86400)
-            , testPair (MkSystemTime 86399 1999999999, UTCTime systemEpochDay 86400.999999999)
-            , testPair (MkSystemTime 86400 0, UTCTime (succ systemEpochDay) 0)
-            ]
+    testGroup "clock conversion" $ let
+        testPair :: (SystemTime, UTCTime) -> TestTree
+        testPair (st, ut) =
+            testGroup (show ut) $
+                [ testCase "systemToUTCTime" $ assertEqual (show ut) ut $ systemToUTCTime st
+                , testCase "utcToSystemTime" $ assertEqual (show ut) st $ utcToSystemTime ut
+                ]
+        in [ testPair (MkSystemTime 0 0, UTCTime systemEpochDay 0)
+           , testPair (MkSystemTime 86399 0, UTCTime systemEpochDay 86399)
+           , testPair (MkSystemTime 86399 999999999, UTCTime systemEpochDay 86399.999999999)
+           , testPair (MkSystemTime 86399 1000000000, UTCTime systemEpochDay 86400)
+           , testPair (MkSystemTime 86399 1999999999, UTCTime systemEpochDay 86400.999999999)
+           , testPair (MkSystemTime 86400 0, UTCTime (succ systemEpochDay) 0)
+           ]

test/main/Test/Clock/Resolution.hs

@@ -51,7 +51,8 @@ testResolution name timeDiff (reportedRes, getTime) =
                 do
                     threadDelay 1000 -- 1ms
                     getTime
-        let times = fmap (\t -> timeDiff t t0) $ times0 ++ times1 ++ times2 ++ times3 ++ times4
+        let
+            times = fmap (\t -> timeDiff t t0) $ times0 ++ times1 ++ times2 ++ times3 ++ times4
             foundGrid = gcdAll times
         assertBool ("reported resolution: " <> show reportedRes <> ", found: " <> show foundGrid) $ foundGrid <= reportedRes
 

test/main/Test/Clock/TAI.hs

@@ -19,28 +19,28 @@ sampleLeapSecondMap _ = Nothing
 
 testTAI :: TestTree
 testTAI =
-    testGroup "leap second transition" $
-        let dayA = fromGregorian 1972 6 30
-            dayB = fromGregorian 1972 7 1
-            utcTime1 = UTCTime dayA 86399
-            utcTime2 = UTCTime dayA 86400
-            utcTime3 = UTCTime dayB 0
-            mAbsTime1 = utcToTAITime sampleLeapSecondMap utcTime1
-            mAbsTime2 = utcToTAITime sampleLeapSecondMap utcTime2
-            mAbsTime3 = utcToTAITime sampleLeapSecondMap utcTime3
-         in [ testCase "mapping" $ do
+    testGroup "leap second transition" $ let
+        dayA = fromGregorian 1972 6 30
+        dayB = fromGregorian 1972 7 1
+        utcTime1 = UTCTime dayA 86399
+        utcTime2 = UTCTime dayA 86400
+        utcTime3 = UTCTime dayB 0
+        mAbsTime1 = utcToTAITime sampleLeapSecondMap utcTime1
+        mAbsTime2 = utcToTAITime sampleLeapSecondMap utcTime2
+        mAbsTime3 = utcToTAITime sampleLeapSecondMap utcTime3
+        in [ testCase "mapping" $ do
                 assertEqual "dayA" (Just 10) $ sampleLeapSecondMap dayA
                 assertEqual "dayB" (Just 11) $ sampleLeapSecondMap dayB
-            , testCase "day length" $ do
+           , testCase "day length" $ do
                 assertEqual "dayA" (Just 86401) $ utcDayLength sampleLeapSecondMap dayA
                 assertEqual "dayB" (Just 86400) $ utcDayLength sampleLeapSecondMap dayB
-            , testCase "differences" $ do
+           , testCase "differences" $ do
                 absTime1 <- assertJust mAbsTime1
                 absTime2 <- assertJust mAbsTime2
                 absTime3 <- assertJust mAbsTime3
                 assertEqual "absTime2 - absTime1" 1 $ diffAbsoluteTime absTime2 absTime1
                 assertEqual "absTime3 - absTime2" 1 $ diffAbsoluteTime absTime3 absTime2
-            , testGroup
+           , testGroup
                 "round-trip"
                 [ testCase "1" $ do
                     absTime <- assertJust mAbsTime1
@@ -55,4 +55,4 @@ testTAI =
                     utcTime <- assertJust $ taiToUTCTime sampleLeapSecondMap absTime
                     assertEqual "round-trip" utcTime3 utcTime
                 ]
-            ]
+           ]

test/main/Test/Format/Format.hs

@@ -39,7 +39,8 @@ somestrings = ["", " ", "-", "\n"]
 compareExpected :: (Eq t, Show t, ParseTime t) => String -> String -> String -> Proxy t -> TestTree
 compareExpected testname fmt str proxy =
     testCase testname $ do
-        let found :: ParseTime t => Proxy t -> Maybe t
+        let
+            found :: ParseTime t => Proxy t -> Maybe t
             found _ = parseTimeM False defaultTimeLocale fmt str
         assertEqual "" Nothing $ found proxy
 
@@ -62,10 +63,10 @@ testDayOfWeek :: TestTree
 testDayOfWeek =
     testGroup "DayOfWeek" $
         tgroup "uwaA" $ \fmt ->
-            tgroup days $ \day ->
-                let dayFormat = formatTime defaultTimeLocale ['%', fmt] day
-                    dowFormat = formatTime defaultTimeLocale ['%', fmt] $ dayOfWeek day
-                 in assertEqual "" dayFormat dowFormat
+            tgroup days $ \day -> let
+                dayFormat = formatTime defaultTimeLocale ['%', fmt] day
+                dowFormat = formatTime defaultTimeLocale ['%', fmt] $ dayOfWeek day
+                in assertEqual "" dayFormat dowFormat
 
 testZone :: String -> String -> Int -> TestTree
 testZone fmt expected minutes =