diff --git a/Data/Time/Format/Human.hs b/Data/Time/Format/Human.hs --- a/Data/Time/Format/Human.hs +++ b/Data/Time/Format/Human.hs @@ -33,14 +33,28 @@ , minutesAgo :: String -> String , oneHourAgo :: String , aboutHoursAgo :: String -> String - , at :: String -> String + -- | Used when time difference is more than 24 hours but less than 5 days. + -- First argument is the day of week of the older time, second is string + -- formatted with `dayOfWeekFmt`. + , at :: Int -> String -> String , daysAgo :: String -> String , weekAgo :: String -> String , weeksAgo :: String -> String , onYear :: String -> String , locale :: TimeLocale + -- | Time format used with `at` member. See @Data.Time.Format@ for + -- details on formatting sequences. + , dayOfWeekFmt :: String + -- | Time format used when time difference is less than a year but more + -- than a month. Time formatted using this string will be passed + -- to `onYear`. + , thisYearFmt :: String + -- | Time format used when time difference is at least one year. Time + -- formatted using this string will be passed to `onYear`. + , prevYearFmt :: String } +-- | Default human time locale uses English. defaultHumanTimeLocale :: HumanTimeLocale defaultHumanTimeLocale = HumanTimeLocale { justNow = "just now" @@ -49,12 +63,15 @@ , minutesAgo = (++ " minutes ago") , oneHourAgo = "one hour ago" , aboutHoursAgo = \x -> "about " ++ x ++ " hours ago" - , at = ("at " ++) + , 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" } -- | Based on @humanReadableTimeDiff@ found in @@ -100,11 +117,14 @@ 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 "%l:%M %p on %A" old - thisYear = trim $! format "%b %e" old - previousYears = trim $! format "%b %e, %Y" old + dow = trim $! format dayOfWeekFmt old + thisYear = trim $! format thisYearFmt old + previousYears = trim $! format prevYearFmt old helper d | d < 1 = justNow @@ -113,7 +133,7 @@ | minutes d < 60 = minutesAgo $ i2s (minutes d) | hours d < 2 = oneHourAgo | hours d < 24 = aboutHoursAgo $ i2s (hours d) - | days d < 5 = at dow + | 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) diff --git a/friendly-time.cabal b/friendly-time.cabal --- a/friendly-time.cabal +++ b/friendly-time.cabal @@ -1,5 +1,5 @@ name: friendly-time -version: 0.2.2 +version: 0.3 description: Print time information in friendly ways synopsis: Print time information in friendly ways homepage: http://github.com/pbrisbin/friendly-time @@ -9,7 +9,7 @@ maintainer: me@pbrisbin.com category: Web, Yesod build-type: Simple -cabal-version: >=1.6 +cabal-version: >=1.8 library exposed-modules: Data.Time.Format.Human @@ -19,6 +19,17 @@ , old-locale ghc-options: -Wall + +test-suite tests + type: exitcode-stdio-1.0 + hs-source-dirs: tests, . + main-is: tests/Main.hs + build-depends: HUnit + , test-framework + , test-framework-hunit + , base + , time + , old-locale source-repository head type: git diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,74 @@ +module Main where + +import Test.Framework +import Test.Framework.Providers.HUnit + +import Test.HUnit + +import Data.Maybe (fromJust) +import Data.Time.Clock +import Data.Time.Format +import Data.Time.Format.Human +import System.Locale + +p :: String -> UTCTime +p = fromJust . parseTime defaultTimeLocale "%F %T" + +helper :: String -> String -> String +helper future past = humanReadableTime' (p future) (p past) + +testJustNow = "just now" @=? helper "2013-08-04 22:30:00" + "2013-08-04 22:30:00" + +testSecondsAgo = "13 seconds ago" @=? helper "2013-08-04 22:30:13" + "2013-08-04 22:30:00" + +testMinuteAgo = "one minute ago" @=? helper "2013-08-04 22:31:20" + "2013-08-04 22:30:00" + +testMinutesAgo = "10 minutes ago" @=? helper "2013-08-04 22:40:00" + "2013-08-04 22:30:00" + +testHourAgo = "one hour ago" @=? helper "2013-08-04 23:40:00" + "2013-08-04 22:30:00" + +testHoursAgo = "about 4 hours ago" @=? helper "2013-08-05 02:40:00" + "2013-08-04 22:30:00" + +testDow = "at 10:30 PM on Sunday" @=? helper "2013-08-08 10:10:10" + "2013-08-04 22:30:00" + +testDaysAgo = "6 days ago" @=? helper "2013-08-10 22:40:00" + "2013-08-04 22:30:00" + +testWeekAgo = "1 week ago" @=? helper "2013-08-16 22:40:00" + "2013-08-04 22:30:00" + +testWeeksAgo = "4 weeks ago" @=? helper "2013-09-04 22:40:00" + "2013-08-04 22:30:00" + +testThisYear = "on Aug 4" @=? helper "2013-11-04 22:40:00" + "2013-08-04 22:30:00" + +testPrevYear = "on Aug 4, 2013" @=? helper "2014-11-04 22:40:00" + "2013-08-04 22:30:00" + +tests = [ + testGroup "English friendly time" + [ testCase "render now" testJustNow + , testCase "seconds ago" testSecondsAgo + , testCase "minute ago" testMinuteAgo + , testCase "minutes ago" testMinutesAgo + , testCase "hour ago" testHourAgo + , testCase "hours ago" testHoursAgo + , testCase "day of week" testDow + , testCase "days ago" testDaysAgo + , testCase "week ago" testWeekAgo + , testCase "weeks ago" testWeeksAgo + , testCase "this year" testThisYear + , testCase "previous year" testPrevYear + ] + ] + +main :: IO () +main = defaultMain tests