diff --git a/lib/Data/Time/Calendar/Gregorian.hs b/lib/Data/Time/Calendar/Gregorian.hs
index 5afec6a7ef4844b3b3493e8b0dcf7e46b7878799..2a29e8e529f257c33f4f1eb240ee8ff3bcc49f61 100644
--- a/lib/Data/Time/Calendar/Gregorian.hs
+++ b/lib/Data/Time/Calendar/Gregorian.hs
@@ -20,25 +20,25 @@ import Data.Time.Calendar.OrdinalDate
 import Data.Time.Calendar.Days
 import Data.Time.Calendar.Private
 
--- | convert to proleptic Gregorian calendar. First element of result is year, second month number (1-12), third day (1-31).
+-- | Convert to proleptic Gregorian calendar. First element of result is year, second month number (1-12), third day (1-31).
 toGregorian :: Day -> (Integer,Int,Int)
 toGregorian date = (year,month,day) where
     (year,yd) = toOrdinalDate date
     (month,day) = dayOfYearToMonthAndDay (isLeapYear year) yd
 
--- | convert from proleptic Gregorian calendar. First argument is year, second month number (1-12), third day (1-31).
+-- | Convert from proleptic Gregorian calendar. First argument is year, second month number (1-12), third day (1-31).
 -- Invalid values will be clipped to the correct range, month first, then day.
 fromGregorian :: Integer -> Int -> Int -> Day
 fromGregorian year month day = fromOrdinalDate year (monthAndDayToDayOfYear (isLeapYear year) month day)
 
--- | convert from proleptic Gregorian calendar. First argument is year, second month number (1-12), third day (1-31).
+-- | Convert from proleptic Gregorian calendar. First argument is year, second month number (1-12), third day (1-31).
 -- Invalid values will return Nothing
 fromGregorianValid :: Integer -> Int -> Int -> Maybe Day
 fromGregorianValid year month day = do
     doy <- monthAndDayToDayOfYearValid (isLeapYear year) month day
     fromOrdinalDateValid year doy
 
--- | show in ISO 8601 format (yyyy-mm-dd)
+-- | Show in ISO 8601 format (yyyy-mm-dd)
 showGregorian :: Day -> String
 showGregorian date = (show4 y) ++ "-" ++ (show2 m) ++ "-" ++ (show2 d) where
     (y,m,d) = toGregorian date
diff --git a/lib/Data/Time/Calendar/Julian.hs b/lib/Data/Time/Calendar/Julian.hs
index 89cf1736a6688db5c9c177b16cd0c494704fa347..e308da08fe64982a243c35769f5ae3fa891ee979 100644
--- a/lib/Data/Time/Calendar/Julian.hs
+++ b/lib/Data/Time/Calendar/Julian.hs
@@ -15,25 +15,25 @@ import Data.Time.Calendar.JulianYearDay
 import Data.Time.Calendar.Days
 import Data.Time.Calendar.Private
 
--- | convert to proleptic Julian calendar. First element of result is year, second month number (1-12), third day (1-31).
+-- | Convert to proleptic Julian calendar. First element of result is year, second month number (1-12), third day (1-31).
 toJulian :: Day -> (Integer,Int,Int)
 toJulian date = (year,month,day) where
     (year,yd) = toJulianYearAndDay date
     (month,day) = dayOfYearToMonthAndDay (isJulianLeapYear year) yd
 
--- | convert from proleptic Julian calendar. First argument is year, second month number (1-12), third day (1-31).
+-- | Convert from proleptic Julian calendar. First argument is year, second month number (1-12), third day (1-31).
 -- Invalid values will be clipped to the correct range, month first, then day.
 fromJulian :: Integer -> Int -> Int -> Day
 fromJulian year month day = fromJulianYearAndDay year (monthAndDayToDayOfYear (isJulianLeapYear year) month day)
 
--- | convert from proleptic Julian calendar. First argument is year, second month number (1-12), third day (1-31).
+-- | Convert from proleptic Julian calendar. First argument is year, second month number (1-12), third day (1-31).
 -- Invalid values will return Nothing.
 fromJulianValid :: Integer -> Int -> Int -> Maybe Day
 fromJulianValid year month day = do
     doy <- monthAndDayToDayOfYearValid (isJulianLeapYear year) month day
     fromJulianYearAndDayValid year doy
 
--- | show in ISO 8601 format (yyyy-mm-dd)
+-- | Show in ISO 8601 format (yyyy-mm-dd)
 showJulian :: Day -> String
 showJulian date = (show4 y) ++ "-" ++ (show2 m) ++ "-" ++ (show2 d) where
     (y,m,d) = toJulian date
diff --git a/lib/Data/Time/Calendar/JulianYearDay.hs b/lib/Data/Time/Calendar/JulianYearDay.hs
index 6a19b6f9f8dac9dc7a9ad32fa710e43129fd8781..47c165fb3b50b4106312187ddaafa02fa287c4b5 100644
--- a/lib/Data/Time/Calendar/JulianYearDay.hs
+++ b/lib/Data/Time/Calendar/JulianYearDay.hs
@@ -8,7 +8,7 @@ module Data.Time.Calendar.JulianYearDay
 import Data.Time.Calendar.Days
 import Data.Time.Calendar.Private
 
--- | convert to proleptic Julian year and day format. First element of result is year (proleptic Julian calendar),
+-- | Convert to proleptic Julian year and day format. First element of result is year (proleptic Julian calendar),
 -- second is the day of the year, with 1 for Jan 1, and 365 (or 366 in leap years) for Dec 31.
 toJulianYearAndDay :: Day -> (Integer,Int)
 toJulianYearAndDay (ModifiedJulianDay mjd) = (year,yd) where
@@ -19,14 +19,14 @@ toJulianYearAndDay (ModifiedJulianDay mjd) = (year,yd) where
     yd = fromInteger (d - (y * 365) + 1)
     year = quad * 4 + y + 1
 
--- | convert from proleptic Julian year and day format.
+-- | Convert from proleptic Julian year and day format.
 -- Invalid day numbers will be clipped to the correct range (1 to 365 or 366).
 fromJulianYearAndDay :: Integer -> Int -> Day
 fromJulianYearAndDay year day = ModifiedJulianDay mjd where
     y = year - 1
     mjd = (fromIntegral (clip 1 (if isJulianLeapYear year then 366 else 365) day)) + (365 * y) + (div y 4) - 678578
 
--- | convert from proleptic Julian year and day format.
+-- | Convert from proleptic Julian year and day format.
 -- Invalid day numbers will return Nothing
 fromJulianYearAndDayValid :: Integer -> Int -> Maybe Day
 fromJulianYearAndDayValid year day = do
@@ -36,7 +36,7 @@ fromJulianYearAndDayValid year day = do
         mjd = (fromIntegral day') + (365 * y) + (div y 4) - 678578
     return (ModifiedJulianDay mjd)
 
--- | show in proleptic Julian year and day format (yyyy-ddd)
+-- | Show in proleptic Julian year and day format (yyyy-ddd)
 showJulianYearAndDay :: Day -> String
 showJulianYearAndDay date = (show4 y) ++ "-" ++ (show3 d) where
     (y,d) = toJulianYearAndDay date
diff --git a/lib/Data/Time/Calendar/MonthDay.hs b/lib/Data/Time/Calendar/MonthDay.hs
index f08ffa63de2404a115f68f840d7a4850543fe0bb..99b08018079a847f27f9d2b4dd0776d7c52ff578 100644
--- a/lib/Data/Time/Calendar/MonthDay.hs
+++ b/lib/Data/Time/Calendar/MonthDay.hs
@@ -5,8 +5,8 @@ module Data.Time.Calendar.MonthDay
 
 import Data.Time.Calendar.Private
 
--- | convert month and day in the Gregorian or Julian calendars to day of year.
--- First arg is leap year flag
+-- | Convert month and day in the Gregorian or Julian calendars to day of year.
+-- First arg is leap year flag.
 monthAndDayToDayOfYear :: Bool -> Int -> Int -> Int
 monthAndDayToDayOfYear isLeap month day = (div (367 * month'' - 362) 12) + k + day' where
     month' = clip 1 12 month
@@ -14,8 +14,8 @@ monthAndDayToDayOfYear isLeap month day = (div (367 * month'' - 362) 12) + k + d
     month'' = fromIntegral month'
     k = if month' <= 2 then 0 else if isLeap then -1 else -2
 
--- | convert month and day in the Gregorian or Julian calendars to day of year.
--- First arg is leap year flag
+-- | Convert month and day in the Gregorian or Julian calendars to day of year.
+-- First arg is leap year flag.
 monthAndDayToDayOfYearValid :: Bool -> Int -> Int -> Maybe Int
 monthAndDayToDayOfYearValid isLeap month day = do
     month' <- clipValid 1 12 month
@@ -26,8 +26,8 @@ monthAndDayToDayOfYearValid isLeap month day = do
         k = if month' <= 2 then 0 else if isLeap then -1 else -2
     return ((div (367 * month'' - 362) 12) + k + day'')
 
--- | convert day of year in the Gregorian or Julian calendars to month and day.
--- First arg is leap year flag
+-- | Convert day of year in the Gregorian or Julian calendars to month and day.
+-- First arg is leap year flag.
 dayOfYearToMonthAndDay :: Bool -> Int -> (Int,Int)
 dayOfYearToMonthAndDay isLeap yd = findMonthDay (monthLengths isLeap) (clip 1 (if isLeap then 366 else 365) yd)
 
@@ -35,8 +35,8 @@ findMonthDay :: [Int] -> Int -> (Int,Int)
 findMonthDay (n:ns) yd | yd > n = (\(m,d) -> (m + 1,d)) (findMonthDay ns (yd - n))
 findMonthDay _ yd = (1,yd)
 
--- | the length of a given month in the Gregorian or Julian calendars.
--- First arg is leap year flag
+-- | The length of a given month in the Gregorian or Julian calendars.
+-- First arg is leap year flag.
 monthLength :: Bool -> Int -> Int
 monthLength isLeap month' = monthLength' isLeap (clip 1 12 month')
 
diff --git a/lib/Data/Time/Calendar/OrdinalDate.hs b/lib/Data/Time/Calendar/OrdinalDate.hs
index faadfc8e0e2cd30518675051846670eaf0725266..59a8edf99bf3949df9e4181993e6f8622e02a627 100644
--- a/lib/Data/Time/Calendar/OrdinalDate.hs
+++ b/lib/Data/Time/Calendar/OrdinalDate.hs
@@ -4,7 +4,7 @@ module Data.Time.Calendar.OrdinalDate where
 import Data.Time.Calendar.Days
 import Data.Time.Calendar.Private
 
--- | convert to ISO 8601 Ordinal Date format. First element of result is year (proleptic Gregoran calendar),
+-- | Convert to ISO 8601 Ordinal Date format. First element of result is year (proleptic Gregoran calendar),
 -- second is the day of the year, with 1 for Jan 1, and 365 (or 366 in leap years) for Dec 31.
 toOrdinalDate :: Day -> (Integer,Int)
 toOrdinalDate (ModifiedJulianDay mjd) = (year,yd) where
@@ -19,15 +19,15 @@ toOrdinalDate (ModifiedJulianDay mjd) = (year,yd) where
     yd = fromInteger (d - (y * 365) + 1)
     year = quadcent * 400 + cent * 100 + quad * 4 + y + 1
 
--- | convert from ISO 8601 Ordinal Date format.
+-- | Convert from ISO 8601 Ordinal Date format.
 -- Invalid day numbers will be clipped to the correct range (1 to 365 or 366).
 fromOrdinalDate :: Integer -> Int -> Day
 fromOrdinalDate year day = ModifiedJulianDay mjd where
     y = year - 1
     mjd = (fromIntegral (clip 1 (if isLeapYear year then 366 else 365) day)) + (365 * y) + (div y 4) - (div y 100) + (div y 400) - 678576
 
--- | convert from ISO 8601 Ordinal Date format.
--- Invalid day numbers return Nothing
+-- | Convert from ISO 8601 Ordinal Date format.
+-- Invalid day numbers return 'Nothing'
 fromOrdinalDateValid :: Integer -> Int -> Maybe Day
 fromOrdinalDateValid year day = do
     day' <- clipValid 1 (if isLeapYear year then 366 else 365) day
@@ -36,7 +36,7 @@ fromOrdinalDateValid year day = do
         mjd = (fromIntegral day') + (365 * y) + (div y 4) - (div y 100) + (div y 400) - 678576
     return (ModifiedJulianDay mjd)
 
--- | show in ISO 8601 Ordinal Date format (yyyy-ddd)
+-- | Show in ISO 8601 Ordinal Date format (yyyy-ddd)
 showOrdinalDate :: Day -> String
 showOrdinalDate date = (show4 y) ++ "-" ++ (show3 d) where
     (y,d) = toOrdinalDate date
@@ -46,8 +46,8 @@ isLeapYear :: Integer -> Bool
 isLeapYear year = (mod year 4 == 0) && ((mod year 400 == 0) || not (mod year 100 == 0))
 
 -- | Get the number of the Monday-starting week in the year and the day of the week.
--- The first Monday is the first day of week 1, any earlier days in the year are week 0 (as \"%W\" in 'Data.Time.Format.formatTime').
--- Monday is 1, Sunday is 7 (as \"%u\" in 'Data.Time.Format.formatTime').
+-- The first Monday is the first day of week 1, any earlier days in the year are week 0 (as @%W@ in 'Data.Time.Format.formatTime').
+-- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime').
 mondayStartWeek :: Day -> (Int,Int)
 mondayStartWeek date = (fromInteger ((div d 7) - (div k 7)),fromInteger (mod d 7) + 1) where
     yd = snd (toOrdinalDate date)
@@ -55,8 +55,8 @@ mondayStartWeek date = (fromInteger ((div d 7) - (div k 7)),fromInteger (mod d 7
     k = d - (toInteger yd)
 
 -- | Get the number of the Sunday-starting week in the year and the day of the week.
--- The first Sunday is the first day of week 1, any earlier days in the year are week 0 (as \"%U\" in 'Data.Time.Format.formatTime').
--- Sunday is 0, Saturday is 6 (as \"%w\" in 'Data.Time.Format.formatTime').
+-- The first Sunday is the first day of week 1, any earlier days in the year are week 0 (as @%U@ in 'Data.Time.Format.formatTime').
+-- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime').
 sundayStartWeek :: Day -> (Int,Int)
 sundayStartWeek date =(fromInteger ((div d 7) - (div k 7)),fromInteger (mod d 7)) where
     yd = snd (toOrdinalDate date)
@@ -66,11 +66,11 @@ sundayStartWeek date =(fromInteger ((div d 7) - (div k 7)),fromInteger (mod d 7)
 -- | The inverse of 'mondayStartWeek'. Get a 'Day' given the year,
 -- the number of the Monday-starting week, and the day of the week.
 -- The first Monday is the first day of week 1, any earlier days in the year
--- are week 0 (as \"%W\" in 'Data.Time.Format.formatTime').
+-- are week 0 (as @%W@ in 'Data.Time.Format.formatTime').
 fromMondayStartWeek :: Integer -- ^ Year.
-                    -> Int     -- ^ Monday-starting week number (as \"%W\" in 'Data.Time.Format.formatTime').
+                    -> Int     -- ^ Monday-starting week number (as @%W@ in 'Data.Time.Format.formatTime').
                     -> Int     -- ^ Day of week.
-                               -- Monday is 1, Sunday is 7 (as \"%u\" in 'Data.Time.Format.formatTime').
+                               -- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime').
                     -> Day
 fromMondayStartWeek year w d = let
     -- first day of the year
@@ -91,9 +91,9 @@ fromMondayStartWeek year w d = let
     in addDays zbYearDay firstDay
 
 fromMondayStartWeekValid :: Integer -- ^ Year.
-                    -> Int     -- ^ Monday-starting week number (as \"%W\" in 'Data.Time.Format.formatTime').
+                    -> Int     -- ^ Monday-starting week number (as @%W@ in 'Data.Time.Format.formatTime').
                     -> Int     -- ^ Day of week.
-                               -- Monday is 1, Sunday is 7 (as \"%u\" in 'Data.Time.Format.formatTime').
+                               -- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime').
                     -> Maybe Day
 fromMondayStartWeekValid year w d = do
     d' <- clipValid 1 7 d
@@ -119,11 +119,11 @@ fromMondayStartWeekValid year w d = do
 -- | The inverse of 'sundayStartWeek'. Get a 'Day' given the year and
 -- the number of the day of a Sunday-starting week.
 -- The first Sunday is the first day of week 1, any earlier days in the
--- year are week 0 (as \"%U\" in 'Data.Time.Format.formatTime').
+-- year are week 0 (as @%U@ in 'Data.Time.Format.formatTime').
 fromSundayStartWeek :: Integer -- ^ Year.
-                    -> Int     -- ^ Sunday-starting week number (as \"%U\" in 'Data.Time.Format.formatTime').
+                    -> Int     -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime').
                     -> Int     -- ^ Day of week
-                               -- Sunday is 0, Saturday is 6 (as \"%w\" in 'Data.Time.Format.formatTime').
+                               -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime').
                     -> Day
 fromSundayStartWeek year w d = let
     -- first day of the year
@@ -144,9 +144,9 @@ fromSundayStartWeek year w d = let
     in addDays zbYearDay firstDay
 
 fromSundayStartWeekValid :: Integer -- ^ Year.
-                    -> Int     -- ^ Sunday-starting week number (as \"%U\" in 'Data.Time.Format.formatTime').
+                    -> Int     -- ^ Sunday-starting week number (as @%U@ in 'Data.Time.Format.formatTime').
                     -> Int     -- ^ Day of week.
-                               -- Sunday is 0, Saturday is 6 (as \"%w\" in 'Data.Time.Format.formatTime').
+                               -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime').
                     -> Maybe Day
 fromSundayStartWeekValid year w d =  do
     d' <- clipValid 0 6 d
diff --git a/lib/Data/Time/Calendar/WeekDate.hs b/lib/Data/Time/Calendar/WeekDate.hs
index d093241d4073ec68c769dca1581e4f03167c583e..09154c71eaac2555cc2490e161e3fd0a3751456d 100644
--- a/lib/Data/Time/Calendar/WeekDate.hs
+++ b/lib/Data/Time/Calendar/WeekDate.hs
@@ -5,7 +5,7 @@ import Data.Time.Calendar.OrdinalDate
 import Data.Time.Calendar.Days
 import Data.Time.Calendar.Private
 
--- | convert to ISO 8601 Week Date format. First element of result is year, second week number (1-53), third day of week (1 for Monday to 7 for Sunday).
+-- | Convert to ISO 8601 Week Date format. First element of result is year, second week number (1-53), third day of week (1 for Monday to 7 for Sunday).
 -- Note that \"Week\" years are not quite the same as Gregorian years, as the first day of the year is always a Monday.
 -- The first week of a year is the first week to contain at least four days in the corresponding Gregorian year.
 toWeekDate :: Day -> (Integer,Int,Int)
@@ -23,7 +23,7 @@ toWeekDate date@(ModifiedJulianDay mjd) = (y1,fromInteger (w1 + 1),fromInteger d
                       else (y0, 52)
                 w0  -> (y0, w0)
 
--- | convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday).
+-- | Convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday).
 -- Invalid week and day values will be clipped to the correct range.
 fromWeekDate :: Integer -> Int -> Int -> Day
 fromWeekDate y w d = ModifiedJulianDay (k - (mod k 7) + (toInteger (((clip 1 (if longYear then 53 else 52) w) * 7) + (clip 1 7 d))) - 10) where
@@ -32,7 +32,7 @@ fromWeekDate y w d = ModifiedJulianDay (k - (mod k 7) + (toInteger (((clip 1 (if
             (_,53,_) -> True
             _ -> False
 
--- | convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday).
+-- | Convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday).
 -- Invalid week and day values will return Nothing.
 fromWeekDateValid :: Integer -> Int -> Int -> Maybe Day
 fromWeekDateValid y w d = do
@@ -46,7 +46,7 @@ fromWeekDateValid y w d = do
         k = toModifiedJulianDay (fromOrdinalDate y 6)
     return (ModifiedJulianDay (k - (mod k 7) + (toInteger ((w' * 7) + d')) - 10))
 
--- | show in ISO 8601 Week Date format as yyyy-Www-d (e.g. \"2006-W46-3\").
+-- | Show in ISO 8601 Week Date format as yyyy-Www-d (e.g. \"2006-W46-3\").
 showWeekDate :: Day -> String
 showWeekDate date = (show4 y) ++ "-W" ++ (show2 w) ++ "-" ++ (show d) where
     (y,w,d) = toWeekDate date
diff --git a/lib/Data/Time/Clock/Internal/SystemTime.hs b/lib/Data/Time/Clock/Internal/SystemTime.hs
index 480d374a11cd6069bbb65e60977bf341c2fb571e..6027cdfc8f50ee085ae97cb91e4c646f91d09a71 100644
--- a/lib/Data/Time/Clock/Internal/SystemTime.hs
+++ b/lib/Data/Time/Clock/Internal/SystemTime.hs
@@ -40,7 +40,8 @@ data SystemTime = MkSystemTime
 instance NFData SystemTime where
     rnf a = a `seq` ()
 
--- | Get POSIX time, epoch start of 1970 UTC, leap-seconds ignored
+-- | Get the system time, epoch start of 1970 UTC, leap-seconds ignored.
+-- 'getSystemTime' is typically much faster than 'getCurrentTime'.
 getSystemTime :: IO SystemTime
 
 -- | The resolution of 'getSystemTime', 'getCurrentTime', 'getPOSIXTime'
diff --git a/lib/Data/Time/Clock/Internal/UTCTime.hs b/lib/Data/Time/Clock/Internal/UTCTime.hs
index da5547a24be442443ed8cf56a154cdca0406008f..d445eca09733257ca45a7358407adee21d2b0f45 100644
--- a/lib/Data/Time/Clock/Internal/UTCTime.hs
+++ b/lib/Data/Time/Clock/Internal/UTCTime.hs
@@ -8,7 +8,7 @@ module Data.Time.Clock.Internal.UTCTime
     -- No table of these corrections is provided, as any program compiled with it would become
     -- out of date in six months.
     --
-    -- If you don't care about leap seconds, use UTCTime and NominalDiffTime for your clock calculations,
+    -- If you don't care about leap seconds, use 'UTCTime' and 'NominalDiffTime' for your clock calculations,
     -- and you'll be fine.
     UTCTime(..),
 ) where
diff --git a/lib/Data/Time/Clock/System.hs b/lib/Data/Time/Clock/System.hs
index 6b41e2d9f2422d43beccdbba9559d3db78f41f2c..f9aca190f72a95cab4f361e9655c03acaec05654 100644
--- a/lib/Data/Time/Clock/System.hs
+++ b/lib/Data/Time/Clock/System.hs
@@ -1,3 +1,4 @@
+-- | Fast access to the system clock.
 module Data.Time.Clock.System
 (
     systemEpochDay,
diff --git a/lib/Data/Time/Format.hs b/lib/Data/Time/Format.hs
index d57e4dde5c53f5126992fff954e2df7ce0483e67..4869e6761de45655fdc43942724655a786f6805f 100644
--- a/lib/Data/Time/Format.hs
+++ b/lib/Data/Time/Format.hs
@@ -69,15 +69,10 @@ formatChar c = case formatCharacter c of
 
 -- | Substitute various time-related information for each %-code in the string, as per 'formatCharacter'.
 --
--- For all types (note these three are done here, not by 'formatCharacter'):
+-- The general form is @%\<modifier\>\<width\>\<specifier\>@, where @\<modifier\>@ and @\<width\>@ are optional.
 --
--- [@%%@] @%@
---
--- [@%t@] tab
---
--- [@%n@] newline
---
--- glibc-style modifiers can be used before the letter (here marked as @z@):
+-- == @\<modifier\>@
+-- glibc-style modifiers can be used before the specifier (here marked as @z@):
 --
 -- [@%-z@] no padding
 --
@@ -89,22 +84,36 @@ formatChar c = case formatCharacter c of
 --
 -- [@%#z@] convert to lower case (consistently, unlike glibc)
 --
--- Width digits can also be used after any modifiers and before the letter (here marked as @z@), for example:
+-- == @\<width\>@
+-- Width digits can also be used after any modifiers and before the specifier (here marked as @z@), for example:
 --
 -- [@%4z@] pad to 4 characters (with default padding character)
 --
 -- [@%_12z@] pad with spaces to 12 characters
 --
+-- == @\<specifier\>@
+--
+-- For all types (note these three are done by 'formatTime', not by 'formatCharacter'):
+--
+-- [@%%@] @%@
+--
+-- [@%t@] tab
+--
+-- [@%n@] newline
+--
+-- === 'TimeZone'
 -- For 'TimeZone' (and 'ZonedTime' and 'UTCTime'):
 --
 -- [@%z@] timezone offset in the format @-HHMM@.
 --
 -- [@%Z@] timezone name
 --
+-- === 'LocalTime'
 -- For 'LocalTime' (and 'ZonedTime' and 'UTCTime' and 'UniversalTime'):
 --
 -- [@%c@] as 'dateTimeFmt' @locale@ (e.g. @%a %b %e %H:%M:%S %Z %Y@)
 --
+-- === 'TimeOfDay'
 -- For 'TimeOfDay' (and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'):
 --
 -- [@%R@] same as @%H:%M@
@@ -136,6 +145,7 @@ formatChar c = case formatCharacter c of
 -- [@%Q@] decimal point and fraction of second, up to 12 second decimals, without trailing zeros.
 -- For a whole number of seconds, @%Q@ produces the empty string.
 --
+-- === 'UTCTime' and 'ZonedTime'
 -- For 'UTCTime' and 'ZonedTime':
 --
 -- [@%s@] number of whole seconds since the Unix epoch. For times before
@@ -143,6 +153,7 @@ formatChar c = case formatCharacter c of
 -- the decimals are positive, not negative. For example, 0.9 seconds
 -- before the Unix epoch is formatted as @-1.1@ with @%s%Q@.
 --
+-- === 'Day'
 -- For 'Day' (and 'LocalTime' and 'ZonedTime' and 'UTCTime' and 'UniversalTime'):
 --
 -- [@%D@] same as @%m\/%d\/%y@
diff --git a/lib/Data/Time/Format/Parse.hs b/lib/Data/Time/Format/Parse.hs
index 29f112efef0a85b19f78eaaf6a46ed6bd64f9d4d..d12291ba34580d5c0c39f0da72143cf2aabf18a9 100644
--- a/lib/Data/Time/Format/Parse.hs
+++ b/lib/Data/Time/Format/Parse.hs
@@ -77,7 +77,7 @@ class ParseTime t where
 #if LANGUAGE_Rank2Types
 -- | Parses a time value given a format string.
 -- Supports the same %-codes as 'formatTime', including @%-@, @%_@ and @%0@ modifiers, however padding widths are not supported.
--- Case is not significant.
+-- Case is not significant in the input string.
 -- Some variations in the input are accepted:
 --
 -- [@%z@] accepts any of @-HHMM@ or @-HH:MM@.
diff --git a/lib/Data/Time/LocalTime/Internal/LocalTime.hs b/lib/Data/Time/LocalTime/Internal/LocalTime.hs
index 8fe562c929da1c1a78a66160042c93e108255fc0..7e9efb6d9193dc8c20f58d5580780f87a9d13d8c 100644
--- a/lib/Data/Time/LocalTime/Internal/LocalTime.hs
+++ b/lib/Data/Time/LocalTime/Internal/LocalTime.hs
@@ -49,24 +49,24 @@ instance NFData LocalTime where
 instance Show LocalTime where
     show (LocalTime d t) = (showGregorian d) ++ " " ++ (show t)
 
--- | show a UTC time in a given time zone as a LocalTime
+-- | Get the local time of a UTC time in a time zone.
 utcToLocalTime :: TimeZone -> UTCTime -> LocalTime
 utcToLocalTime tz (UTCTime day dt) = LocalTime (addDays i day) tod where
     (i,tod) = utcToLocalTimeOfDay tz (timeToTimeOfDay dt)
 
--- | find out what UTC time a given LocalTime in a given time zone is
+-- | Get the UTC time of a local time in a time zone.
 localTimeToUTC :: TimeZone -> LocalTime -> UTCTime
 localTimeToUTC tz (LocalTime day tod) = UTCTime (addDays i day) (timeOfDayToTime todUTC) where
     (i,todUTC) = localToUTCTimeOfDay tz tod
 
--- | 1st arg is observation meridian in degrees, positive is East
+-- | Get the local time of a UT1 time on a particular meridian (in degrees, positive is East).
 ut1ToLocalTime :: Rational -> UniversalTime -> LocalTime
 ut1ToLocalTime long (ModJulianDate date) = LocalTime (ModifiedJulianDay localMJD) (dayFractionToTimeOfDay localToDOffset) where
     localTime = date + long / 360 :: Rational
     localMJD = floor localTime
     localToDOffset = localTime - (fromIntegral localMJD)
 
--- | 1st arg is observation meridian in degrees, positive is East
+-- | Get the UT1 time of a local time on a particular meridian (in degrees, positive is East).
 localTimeToUT1 :: Rational -> LocalTime -> UniversalTime
 localTimeToUT1 long (LocalTime (ModifiedJulianDay localMJD) tod) = ModJulianDate ((fromIntegral localMJD) + (timeOfDayToDayFraction tod) - (long / 360))
 
diff --git a/lib/Data/Time/LocalTime/Internal/TimeOfDay.hs b/lib/Data/Time/LocalTime/Internal/TimeOfDay.hs
index ea44951b314ab07fe6296febb853bbda1ced9a82..4af1f897007a0fccd6ff19aac63e66db47d06311 100644
--- a/lib/Data/Time/LocalTime/Internal/TimeOfDay.hs
+++ b/lib/Data/Time/LocalTime/Internal/TimeOfDay.hs
@@ -27,7 +27,7 @@ data TimeOfDay = TimeOfDay {
     todHour    :: Int,
     -- | range 0 - 59
     todMin     :: Int,
-    -- | Note that 0 <= todSec < 61, accomodating leap seconds.
+    -- | Note that 0 <= 'todSec' < 61, accomodating leap seconds.
     -- Any local minute may have a leap second, since leap seconds happen in all zones simultaneously
     todSec     :: Pico
 } deriving (Eq,Ord
@@ -61,20 +61,20 @@ makeTimeOfDayValid h m s = do
     _ <- clipValid 0 60.999999999999 s
     return (TimeOfDay h m s)
 
--- | Convert a ToD in UTC to a ToD in some timezone, together with a day adjustment.
+-- | Convert a time of day in UTC to a time of day in some timezone, together with a day adjustment.
 utcToLocalTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay)
 utcToLocalTimeOfDay zone (TimeOfDay h m s) = (fromIntegral (div h' 24),TimeOfDay (mod h' 24) (mod m' 60) s) where
     m' = m + timeZoneMinutes zone
     h' = h + (div m' 60)
 
--- | Convert a ToD in some timezone to a ToD in UTC, together with a day adjustment.
+-- | Convert a time of day in some timezone to a time of day in UTC, together with a day adjustment.
 localToUTCTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay)
 localToUTCTimeOfDay zone = utcToLocalTimeOfDay (minutesToTimeZone (negate (timeZoneMinutes zone)))
 
 posixDayLength :: DiffTime
 posixDayLength = fromInteger 86400
 
--- | Get a TimeOfDay given a time since midnight.
+-- | Get the time of day given a time since midnight.
 -- Time more than 24h will be converted to leap-seconds.
 timeToTimeOfDay :: DiffTime -> TimeOfDay
 timeToTimeOfDay dt | dt >= posixDayLength = TimeOfDay 23 59 (60 + (realToFrac (dt - posixDayLength)))
@@ -85,14 +85,14 @@ timeToTimeOfDay dt = TimeOfDay (fromInteger h) (fromInteger m) s where
     m = mod' m' 60
     h = div' m' 60
 
--- | Find out how much time since midnight a given TimeOfDay is.
+-- | Get the time since midnight for a given time of day.
 timeOfDayToTime :: TimeOfDay -> DiffTime
 timeOfDayToTime (TimeOfDay h m s) = ((fromIntegral h) * 60 + (fromIntegral m)) * 60 + (realToFrac s)
 
--- | Get a TimeOfDay given the fraction of a day since midnight.
+-- | Get the time of day given the fraction of a day since midnight.
 dayFractionToTimeOfDay :: Rational -> TimeOfDay
 dayFractionToTimeOfDay df = timeToTimeOfDay (realToFrac (df * 86400))
 
--- | Get the fraction of a day since midnight given a TimeOfDay.
+-- | Get the fraction of a day since midnight given a time of day.
 timeOfDayToDayFraction :: TimeOfDay -> Rational
 timeOfDayToDayFraction tod = realToFrac (timeOfDayToTime tod) / realToFrac posixDayLength
diff --git a/lib/Data/Time/LocalTime/Internal/TimeZone.hs b/lib/Data/Time/LocalTime/Internal/TimeZone.hs
index 8bc345b8353b4494c7617e6df5a5c0dab7b3a636..40d6092fd4fce75e9d0488fed82cc4cda81869a9 100644
--- a/lib/Data/Time/LocalTime/Internal/TimeZone.hs
+++ b/lib/Data/Time/LocalTime/Internal/TimeZone.hs
@@ -49,23 +49,23 @@ data TimeZone = TimeZone {
 instance NFData TimeZone where
     rnf (TimeZone m so n) = rnf m `seq` rnf so `seq` rnf n `seq` ()
 
--- | Create a nameless non-summer timezone for this number of minutes
+-- | Create a nameless non-summer timezone for this number of minutes.
 minutesToTimeZone :: Int -> TimeZone
 minutesToTimeZone m = TimeZone m False ""
 
--- | Create a nameless non-summer timezone for this number of hours
+-- | Create a nameless non-summer timezone for this number of hours.
 hoursToTimeZone :: Int -> TimeZone
 hoursToTimeZone i = minutesToTimeZone (60 * i)
 
 showT :: PadOption -> Int -> String
 showT opt t = showPaddedNum opt ((div t 60) * 100 + (mod t 60))
 
--- | Text representing the offset of this timezone, such as \"-0800\" or \"+0400\" (like %z in formatTime), with arbitrary padding
+-- | Text representing the offset of this timezone, such as \"-0800\" or \"+0400\" (like @%z@ in formatTime), with arbitrary padding.
 timeZoneOffsetString' :: PadOption -> TimeZone -> String
 timeZoneOffsetString' opt (TimeZone t _ _) | t < 0 = '-':(showT opt (negate t))
 timeZoneOffsetString' opt (TimeZone t _ _) = '+':(showT opt t)
 
--- | Text representing the offset of this timezone, such as \"-0800\" or \"+0400\" (like %z in formatTime)
+-- | Text representing the offset of this timezone, such as \"-0800\" or \"+0400\" (like @%z@ in formatTime).
 timeZoneOffsetString :: TimeZone -> String
 timeZoneOffsetString = timeZoneOffsetString' (Pad 4 '0')
 
@@ -73,7 +73,7 @@ instance Show TimeZone where
     show zone@(TimeZone _ _ "") = timeZoneOffsetString zone
     show (TimeZone _ _ name) = name
 
--- | The UTC time zone
+-- | The UTC time zone.
 utc :: TimeZone
 utc = TimeZone 0 False "UTC"
 
@@ -92,14 +92,14 @@ getTimeZoneCTime ctime = with 0 (\pdst -> with nullPtr (\pcname -> do
             return (TimeZone (div (fromIntegral secs) 60) (dst == 1) name)
     ))
 
--- | Get the local time-zone for a given time (varying as per summertime adjustments)
+-- | Get the local time-zone for a given time (varying as per summertime adjustments).
 getTimeZoneSystem :: SystemTime -> IO TimeZone
 getTimeZoneSystem = getTimeZoneCTime . CTime . systemSeconds
 
--- | Get the local time-zone for a given time (varying as per summertime adjustments)
+-- | Get the local time-zone for a given time (varying as per summertime adjustments).
 getTimeZone :: UTCTime -> IO TimeZone
 getTimeZone = getTimeZoneCTime . fromInteger . floor . utcTimeToPOSIXSeconds
 
--- | Get the current time-zone
+-- | Get the current time-zone.
 getCurrentTimeZone :: IO TimeZone
 getCurrentTimeZone = getSystemTime >>= getTimeZoneSystem
diff --git a/lib/Data/Time/LocalTime/Internal/ZonedTime.hs b/lib/Data/Time/LocalTime/Internal/ZonedTime.hs
index 1630b07ab6ac276af592d0a0f8c085a4b71ff33c..0ad2ac90735513767ab86dd6fca7b734dbbc6cc5 100644
--- a/lib/Data/Time/LocalTime/Internal/ZonedTime.hs
+++ b/lib/Data/Time/LocalTime/Internal/ZonedTime.hs
@@ -19,7 +19,7 @@ import Data.Time.LocalTime.Internal.TimeZone
 import Data.Time.LocalTime.Internal.LocalTime
 
 
--- | A local time together with a TimeZone.
+-- | A local time together with a time zone.
 data ZonedTime = ZonedTime {
     zonedTimeToLocalTime :: LocalTime,
     zonedTimeZone :: TimeZone