module Data.Time.Format.Human
( humanReadableTime
, humanReadableTime'
, humanReadableTimeI18N
, humanReadableTimeI18N'
, HumanTimeLocale(..)
, defaultHumanTimeLocale
) where
import Data.Time
import Data.Char (isSpace)
import System.Locale
data HumanTimeLocale = HumanTimeLocale
{ justNow :: String
, secondsAgo :: String -> String
, oneMinuteAgo :: String
, minutesAgo :: String -> String
, oneHourAgo :: String
, aboutHoursAgo :: String -> String
, at :: Int -> String -> String
, daysAgo :: String -> String
, weekAgo :: String -> String
, weeksAgo :: String -> String
, onYear :: String -> String
, locale :: TimeLocale
, dayOfWeekFmt :: String
, thisYearFmt :: String
, prevYearFmt :: String
}
defaultHumanTimeLocale :: HumanTimeLocale
defaultHumanTimeLocale = HumanTimeLocale
{ justNow = "just now"
, secondsAgo = (++ " seconds ago")
, oneMinuteAgo = "one minute ago"
, minutesAgo = (++ " minutes ago")
, oneHourAgo = "one hour ago"
, aboutHoursAgo = \x -> "about " ++ x ++ " hours ago"
, at = \_ -> ("at " ++)
, daysAgo = (++ " days ago")
, weekAgo = (++ " week ago")
, weeksAgo = (++ " weeks ago")
, onYear = ("on " ++)
, locale = defaultTimeLocale
, dayOfWeekFmt = "%l:%M %p on %A"
, thisYearFmt = "%b %e"
, prevYearFmt = "%b %e, %Y"
}
humanReadableTime :: UTCTime -> IO String
humanReadableTime = humanReadableTimeI18N defaultHumanTimeLocale
humanReadableTime' :: UTCTime
-> UTCTime -> String
humanReadableTime' = humanReadableTimeI18N' defaultHumanTimeLocale
humanReadableTimeI18N :: HumanTimeLocale -> UTCTime -> IO String
humanReadableTimeI18N tl t = do
now <- getCurrentTime
return $ humanReadableTimeI18N' tl now t
humanReadableTimeI18N' :: HumanTimeLocale
-> UTCTime
-> UTCTime -> String
humanReadableTimeI18N' (HumanTimeLocale {..}) cur t = helper $ diffUTCTime cur t
where
minutes :: NominalDiffTime -> Double
minutes n = realToFrac $ n / 60
hours :: NominalDiffTime -> Double
hours n = minutes n / 60
days :: NominalDiffTime -> Double
days n = hours n / 24
weeks :: NominalDiffTime -> Double
weeks n = days n / 7
years :: NominalDiffTime -> Double
years n = days n / 365
i2s :: RealFrac a => a -> String
i2s n = show m where m = truncate n :: Int
trim = f . f where f = reverse . dropWhile isSpace
oldDayOfWeek :: Int
oldDayOfWeek = read $ formatTime defaultTimeLocale "%u" t
old = utcToLocalTime utc t
format = formatTime locale
dow = trim $! format dayOfWeekFmt old
thisYear = trim $! format thisYearFmt old
previousYears = trim $! format prevYearFmt old
helper d
| d < 1 = justNow
| d < 60 = secondsAgo $ i2s d
| minutes d < 2 = oneMinuteAgo
| minutes d < 60 = minutesAgo $ i2s (minutes d)
| hours d < 2 = oneHourAgo
| hours d < 24 = aboutHoursAgo $ i2s (hours d)
| days d < 5 = at oldDayOfWeek dow
| days d < 10 = daysAgo $ i2s (days d)
| weeks d < 2 = weekAgo $ i2s (weeks d)
| weeks d < 5 = weeksAgo $ i2s (weeks d)
| years d < 1 = onYear thisYear
| otherwise = onYear previousYears