diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,6 +1,10 @@ # Changelog for pretty-relative-time -## Unreleased changes +## [0.3.0.0] - 2021-11-20 + +### Changed + +* Support for `genvalidity` >=1.0.0.0 ## [0.2.0.0] - 2020-02-12 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright 2018 Tom Sydney Kerckhove +Copyright 2018-2021 Tom Sydney Kerckhove Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,3 +0,0 @@ -import Distribution.Simple - -main = defaultMain diff --git a/pretty-relative-time.cabal b/pretty-relative-time.cabal --- a/pretty-relative-time.cabal +++ b/pretty-relative-time.cabal @@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0. +-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack --- --- hash: 3c3eba99b4fd54cfb105bc62e7caea77caf57513705abac5550c0b645bd43e96 name: pretty-relative-time -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Pretty relative time description: Please see the README on Github at category: Time @@ -15,7 +13,7 @@ bug-reports: https://github.com/NorfairKing/pretty-relative-time/issues author: Tom Sydney Kerckhove maintainer: syd.kerckhove@gmail.com -copyright: Copyright: (c) 2018 Tom Sydney Kerckhove +copyright: Copyright: (c) 2018-2021 Tom Sydney Kerckhove license: MIT license-file: LICENSE build-type: Simple @@ -57,6 +55,7 @@ build-depends: QuickCheck , base >=4.7 && <5 + , genvalidity >=1.0 , genvalidity-hspec , genvalidity-time , hspec diff --git a/src/Text/Time/Pretty.hs b/src/Text/Time/Pretty.hs --- a/src/Text/Time/Pretty.hs +++ b/src/Text/Time/Pretty.hs @@ -1,46 +1,48 @@ module Text.Time.Pretty - ( prettyTimeAutoFromNow - , prettyTimeAuto - , prettyDayAutoFromNow - , prettyDayAuto + ( prettyTimeAutoFromNow, + prettyTimeAuto, + prettyDayAutoFromNow, + prettyDayAuto, -- Helper functions - , timeAgo - , timeAgoToDiffTime - , daysAgo - , daysAgoToDays + timeAgo, + timeAgoToDiffTime, + daysAgo, + daysAgoToDays, + -- * Helper Types - , TimeAgo(..) - , DaysAgo(..) + TimeAgo (..), + DaysAgo (..), + -- * Rendering - , renderDaysAgoAuto - , renderTimeAgoAuto + renderDaysAgoAuto, + renderTimeAgoAuto, + -- * Constants - , picoSecondsPerSecond - , secondsPerMinute - , minutesPerHour - , hoursPerDay - , daysPerWeek - ) where + picoSecondsPerSecond, + secondsPerMinute, + minutesPerHour, + hoursPerDay, + daysPerWeek, + ) +where import Data.Time - import Text.Time.Pretty.Constants import Text.Time.Pretty.Render import Text.Time.Pretty.TimeAgo prettyTimeAutoFromNow :: UTCTime -> IO String prettyTimeAutoFromNow before = do - now <- getCurrentTime - pure $ prettyTimeAuto now before + now <- getCurrentTime + pure $ prettyTimeAuto now before prettyTimeAuto :: UTCTime -> UTCTime -> String prettyTimeAuto now before = renderTimeAgoAuto $ timeAgo $ diffUTCTime now before prettyDayAutoFromNow :: Day -> IO String prettyDayAutoFromNow before = do - today <- (localDay . zonedTimeToLocalTime) <$> getZonedTime + today <- localDay . zonedTimeToLocalTime <$> getZonedTime pure $ prettyDayAuto today before prettyDayAuto :: Day -> Day -> String prettyDayAuto today before = renderDaysAgoAuto $ daysAgo $ diffDays today before - diff --git a/src/Text/Time/Pretty/Constants.hs b/src/Text/Time/Pretty/Constants.hs --- a/src/Text/Time/Pretty/Constants.hs +++ b/src/Text/Time/Pretty/Constants.hs @@ -1,12 +1,13 @@ module Text.Time.Pretty.Constants - ( picoSecondsPerSecond - , secondsPerMinute - , minutesPerHour - , hoursPerDay - , daysPerWeek - , approximateDaysPerMonth - , approximateDaysPerYear - ) where + ( picoSecondsPerSecond, + secondsPerMinute, + minutesPerHour, + hoursPerDay, + daysPerWeek, + approximateDaysPerMonth, + approximateDaysPerYear, + ) +where picoSecondsPerSecond :: Integral a => a picoSecondsPerSecond = 10 ^ (12 :: Integer) diff --git a/src/Text/Time/Pretty/Render.hs b/src/Text/Time/Pretty/Render.hs --- a/src/Text/Time/Pretty/Render.hs +++ b/src/Text/Time/Pretty/Render.hs @@ -2,9 +2,10 @@ {-# LANGUAGE RecordWildCards #-} module Text.Time.Pretty.Render - ( renderDaysAgoAuto - , renderTimeAgoAuto - ) where + ( renderDaysAgoAuto, + renderTimeAgoAuto, + ) +where import Text.Time.Pretty.TimeAgo @@ -12,41 +13,45 @@ renderDaysAgoAuto DaysAgo {..} = case daysAgoSign of GT -> - if | daysAgoYears > 0 -> unwords [plural daysAgoYears "year" "years", "ago"] - | daysAgoMonths > 0 -> unwords [plural daysAgoMonths "month" "months", "ago"] - | daysAgoWeeks > 0 -> unwords [plural daysAgoWeeks "week" "weeks", "ago"] - | daysAgoDays == 1 -> "yesterday" - | daysAgoDays > 0 -> unwords [plural daysAgoDays "day" "days", "ago"] - | otherwise -> "today" + if + | daysAgoYears > 0 -> unwords [plural daysAgoYears "year" "years", "ago"] + | daysAgoMonths > 0 -> unwords [plural daysAgoMonths "month" "months", "ago"] + | daysAgoWeeks > 0 -> unwords [plural daysAgoWeeks "week" "weeks", "ago"] + | daysAgoDays == 1 -> "yesterday" + | daysAgoDays > 0 -> unwords [plural daysAgoDays "day" "days", "ago"] + | otherwise -> "today" EQ -> "today" LT -> - if | daysAgoYears > 0 -> unwords ["in", plural daysAgoYears "year" "years"] - | daysAgoMonths > 0 -> unwords ["in", plural daysAgoMonths "month" "months"] - | daysAgoWeeks > 0 -> unwords ["in", plural daysAgoWeeks "week" "weeks"] - | daysAgoDays == 1 -> "tomorrow" - | daysAgoDays > 0 -> unwords ["in", plural daysAgoDays "day" "days"] - | otherwise -> "today" + if + | daysAgoYears > 0 -> unwords ["in", plural daysAgoYears "year" "years"] + | daysAgoMonths > 0 -> unwords ["in", plural daysAgoMonths "month" "months"] + | daysAgoWeeks > 0 -> unwords ["in", plural daysAgoWeeks "week" "weeks"] + | daysAgoDays == 1 -> "tomorrow" + | daysAgoDays > 0 -> unwords ["in", plural daysAgoDays "day" "days"] + | otherwise -> "today" renderTimeAgoAuto :: TimeAgo -> String renderTimeAgoAuto TimeAgo {..} = case timeAgoSign of GT -> - if | daysAgoToDays timeAgoDaysAgo == 1 -> "1 day ago" - | daysAgoToDays timeAgoDaysAgo > 0 -> - renderDaysAgoAuto (timeAgoDaysAgo {daysAgoSign = timeAgoSign}) - | timeAgoHours > 0 -> unwords [plural timeAgoHours "hour" "hours", "ago"] - | timeAgoMinutes > 0 -> unwords [plural timeAgoMinutes "minute" "minutes", "ago"] - | timeAgoSeconds > 0 -> unwords [plural timeAgoSeconds "second" "seconds", "ago"] - | otherwise -> "just now" + if + | daysAgoToDays timeAgoDaysAgo == 1 -> "1 day ago" + | daysAgoToDays timeAgoDaysAgo > 0 -> + renderDaysAgoAuto (timeAgoDaysAgo {daysAgoSign = timeAgoSign}) + | timeAgoHours > 0 -> unwords [plural timeAgoHours "hour" "hours", "ago"] + | timeAgoMinutes > 0 -> unwords [plural timeAgoMinutes "minute" "minutes", "ago"] + | timeAgoSeconds > 0 -> unwords [plural timeAgoSeconds "second" "seconds", "ago"] + | otherwise -> "just now" EQ -> "just now" LT -> - if | daysAgoToDays timeAgoDaysAgo == 1 -> "in 1 day" - | daysAgoToDays timeAgoDaysAgo > 0 -> - renderDaysAgoAuto (timeAgoDaysAgo {daysAgoSign = timeAgoSign}) - | timeAgoHours > 0 -> unwords ["in", plural timeAgoHours "hour" "hours"] - | timeAgoMinutes > 0 -> unwords ["in", plural timeAgoMinutes "minute" "minutes"] - | timeAgoSeconds > 0 -> unwords ["in", plural timeAgoSeconds "second" "seconds"] - | otherwise -> "just now" + if + | daysAgoToDays timeAgoDaysAgo == 1 -> "in 1 day" + | daysAgoToDays timeAgoDaysAgo > 0 -> + renderDaysAgoAuto (timeAgoDaysAgo {daysAgoSign = timeAgoSign}) + | timeAgoHours > 0 -> unwords ["in", plural timeAgoHours "hour" "hours"] + | timeAgoMinutes > 0 -> unwords ["in", plural timeAgoMinutes "minute" "minutes"] + | timeAgoSeconds > 0 -> unwords ["in", plural timeAgoSeconds "second" "seconds"] + | otherwise -> "just now" plural :: (Show a, Integral a) => a -> String -> String -> String plural 1 sing _ = "1 " ++ sing diff --git a/src/Text/Time/Pretty/TimeAgo.hs b/src/Text/Time/Pretty/TimeAgo.hs --- a/src/Text/Time/Pretty/TimeAgo.hs +++ b/src/Text/Time/Pretty/TimeAgo.hs @@ -2,63 +2,64 @@ {-# LANGUAGE RecordWildCards #-} module Text.Time.Pretty.TimeAgo - ( daysAgo - , daysAgoToDays - , DaysAgo(..) - , timeAgo - , timeAgoToDiffTime - , TimeAgo(..) - ) where + ( daysAgo, + daysAgoToDays, + DaysAgo (..), + timeAgo, + timeAgoToDiffTime, + TimeAgo (..), + ) +where import Data.Time import Data.Validity import GHC.Generics (Generic) - import Text.Time.Pretty.Constants -data DaysAgo = - DaysAgo - { daysAgoSign :: Ordering - , daysAgoYears :: Integer - , daysAgoMonths :: Integer - , daysAgoWeeks :: Integer - , daysAgoDays :: Integer - } +data DaysAgo = DaysAgo + { daysAgoSign :: Ordering, + daysAgoYears :: Integer, + daysAgoMonths :: Integer, + daysAgoWeeks :: Integer, + daysAgoDays :: Integer + } deriving (Show, Eq, Generic) instance Validity DaysAgo where validate da@DaysAgo {..} = mconcat - [ genericValidate da - , check - (case daysAgoSign of - EQ -> - and - [ daysAgoDays == 0 - , daysAgoWeeks == 0 - , daysAgoMonths == 0 - , daysAgoYears == 0 - ] - _ -> - any - (> 0) - [daysAgoDays, daysAgoWeeks, daysAgoMonths, daysAgoYears]) - "the sign makes sense" - , check (daysAgoYears >= 0) "years are positive" - , check - (daysAgoDays + daysPerWeek * daysAgoWeeks + - approximateDaysPerMonth * daysAgoMonths < - approximateDaysPerYear) - "days, weeks and months do not sum to a year" - , check (daysAgoMonths < 12) "months < 12" - , check (daysAgoMonths >= 0) "months are positive" - , check + [ genericValidate da, + check + ( case daysAgoSign of + EQ -> + and + [ daysAgoDays == 0, + daysAgoWeeks == 0, + daysAgoMonths == 0, + daysAgoYears == 0 + ] + _ -> + any + (> 0) + [daysAgoDays, daysAgoWeeks, daysAgoMonths, daysAgoYears] + ) + "the sign makes sense", + check (daysAgoYears >= 0) "years are positive", + check + ( daysAgoDays + daysPerWeek * daysAgoWeeks + + approximateDaysPerMonth * daysAgoMonths + < approximateDaysPerYear + ) + "days, weeks and months do not sum to a year", + check (daysAgoMonths < 12) "months < 12", + check (daysAgoMonths >= 0) "months are positive", + check (daysAgoDays + daysPerWeek * daysAgoWeeks < approximateDaysPerMonth) - "days and weeks do not sum to a month" - , check (daysAgoWeeks < 5) "weeks < 5" - , check (daysAgoWeeks >= 0) "weeks are positive" - , check (daysAgoDays < 7) "days < 7" - , check (daysAgoDays >= 0) "days are positive" + "days and weeks do not sum to a month", + check (daysAgoWeeks < 5) "weeks < 5", + check (daysAgoWeeks >= 0) "weeks are positive", + check (daysAgoDays < 7) "days < 7", + check (daysAgoDays >= 0) "days are positive" ] daysAgo :: Integer -> DaysAgo @@ -77,58 +78,59 @@ daysAgoToDays :: DaysAgo -> Integer daysAgoToDays DaysAgo {..} = - (case daysAgoSign of - EQ -> const 0 - GT -> id - LT -> negate) $ - daysAgoDays + daysPerWeek * daysAgoWeeks + - approximateDaysPerMonth * daysAgoMonths + - approximateDaysPerYear * daysAgoYears + ( case daysAgoSign of + EQ -> const 0 + GT -> id + LT -> negate + ) + $ daysAgoDays + daysPerWeek * daysAgoWeeks + + approximateDaysPerMonth * daysAgoMonths + + approximateDaysPerYear * daysAgoYears -data TimeAgo = - TimeAgo - { timeAgoSign :: Ordering - , timeAgoDaysAgo :: DaysAgo - , timeAgoHours :: Integer - , timeAgoMinutes :: Integer - , timeAgoSeconds :: Integer - , timeAgoPicoSeconds :: Integer - } +data TimeAgo = TimeAgo + { timeAgoSign :: Ordering, + timeAgoDaysAgo :: DaysAgo, + timeAgoHours :: Integer, + timeAgoMinutes :: Integer, + timeAgoSeconds :: Integer, + timeAgoPicoSeconds :: Integer + } deriving (Show, Eq, Generic) instance Validity TimeAgo where validate ta@TimeAgo {..} = mconcat - [ genericValidate ta - , check - (case timeAgoSign of - EQ -> - and - [ daysAgoToDays timeAgoDaysAgo == 0 - , timeAgoHours == 0 - , timeAgoMinutes == 0 - , timeAgoSeconds == 0 - , timeAgoPicoSeconds == 0 - ] - _ -> - any - (> 0) - [ daysAgoToDays timeAgoDaysAgo - , timeAgoHours - , timeAgoMinutes - , timeAgoSeconds - , timeAgoPicoSeconds - ]) - "the sign makes sense" - , check (daysAgoSign timeAgoDaysAgo /= LT) "The days ago are not negative" - , check (timeAgoHours < hoursPerDay) "hours < 24" - , check (timeAgoHours >= 0) "hours are positive" - , check (timeAgoMinutes < minutesPerHour) "minutes < 60" - , check (timeAgoMinutes >= 0) "minutes are positive" - , check (timeAgoSeconds < secondsPerMinute) "seconds < 60" - , check (timeAgoSeconds >= 0) "seconds are positive" - , check (timeAgoPicoSeconds < picoSecondsPerSecond) "picoseconds < 1E12" - , check (timeAgoPicoSeconds >= 0) "picoseconds are positive" + [ genericValidate ta, + check + ( case timeAgoSign of + EQ -> + and + [ daysAgoToDays timeAgoDaysAgo == 0, + timeAgoHours == 0, + timeAgoMinutes == 0, + timeAgoSeconds == 0, + timeAgoPicoSeconds == 0 + ] + _ -> + any + (> 0) + [ daysAgoToDays timeAgoDaysAgo, + timeAgoHours, + timeAgoMinutes, + timeAgoSeconds, + timeAgoPicoSeconds + ] + ) + "the sign makes sense", + check (daysAgoSign timeAgoDaysAgo /= LT) "The days ago are not negative", + check (timeAgoHours < hoursPerDay) "hours < 24", + check (timeAgoHours >= 0) "hours are positive", + check (timeAgoMinutes < minutesPerHour) "minutes < 60", + check (timeAgoMinutes >= 0) "minutes are positive", + check (timeAgoSeconds < secondsPerMinute) "seconds < 60", + check (timeAgoSeconds >= 0) "seconds are positive", + check (timeAgoPicoSeconds < picoSecondsPerSecond) "picoseconds < 1E12", + check (timeAgoPicoSeconds >= 0) "picoseconds are positive" ] timeAgo :: NominalDiffTime -> TimeAgo @@ -147,25 +149,29 @@ totalMinutesAgo = floor $ absDt / fromIntegral (secondsPerMinute :: Integer) totalHoursAgo = floor $ - absDt / fromIntegral (minutesPerHour * secondsPerMinute :: Integer) + absDt / fromIntegral (minutesPerHour * secondsPerMinute :: Integer) totalDaysAgo = floor $ - absDt / - fromIntegral (hoursPerDay * minutesPerHour * secondsPerMinute :: Integer) + absDt + / fromIntegral (hoursPerDay * minutesPerHour * secondsPerMinute :: Integer) absDt = abs dt timeAgoToDiffTime :: TimeAgo -> NominalDiffTime timeAgoToDiffTime TimeAgo {..} = (/ fromIntegral (picoSecondsPerSecond :: Integer)) $ - realToFrac $ - (case timeAgoSign of - EQ -> const 0 - GT -> id - LT -> negate) - (timeAgoPicoSeconds + - picoSecondsPerSecond * - (timeAgoSeconds + - secondsPerMinute * - (timeAgoMinutes + - minutesPerHour * - (timeAgoHours + hoursPerDay * (daysAgoToDays timeAgoDaysAgo))))) + realToFrac $ + ( case timeAgoSign of + EQ -> const 0 + GT -> id + LT -> negate + ) + ( timeAgoPicoSeconds + + picoSecondsPerSecond + * ( timeAgoSeconds + + secondsPerMinute + * ( timeAgoMinutes + + minutesPerHour + * (timeAgoHours + hoursPerDay * daysAgoToDays timeAgoDaysAgo) + ) + ) + ) diff --git a/test/Text/Time/PrettySpec.hs b/test/Text/Time/PrettySpec.hs --- a/test/Text/Time/PrettySpec.hs +++ b/test/Text/Time/PrettySpec.hs @@ -2,28 +2,24 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Text.Time.PrettySpec - ( spec - ) where + ( spec, + ) +where import Data.GenValidity.Time () import Test.Hspec import Test.QuickCheck import Test.Validity - import Text.Time.Pretty -instance GenUnchecked DaysAgo - instance GenValid DaysAgo where genValid = do sign <- genValid case sign of EQ -> pure $ DaysAgo EQ 0 0 0 0 _ -> - (DaysAgo sign <$> choose (0, 364) <*> choose (0, 29) <*> choose (0, 4) <*> choose (0, 7)) `suchThat` - isValid - -instance GenUnchecked TimeAgo + (DaysAgo sign <$> choose (0, 364) <*> choose (0, 29) <*> choose (0, 4) <*> choose (0, 7)) + `suchThat` isValid instance GenValid TimeAgo where genValid = do @@ -31,29 +27,30 @@ case sign of EQ -> pure $ TimeAgo EQ (DaysAgo EQ 0 0 0 0) 0 0 0 0 _ -> - (TimeAgo sign <$> genValid <*> choose (0, hoursPerDay) <*> choose (0, minutesPerHour) <*> - choose (0, secondsPerMinute) <*> - choose (0, picoSecondsPerSecond)) `suchThat` - isValid + ( TimeAgo sign <$> genValid <*> choose (0, hoursPerDay) <*> choose (0, minutesPerHour) + <*> choose (0, secondsPerMinute) + <*> choose (0, picoSecondsPerSecond) + ) + `suchThat` isValid spec :: Spec spec = do eqSpec @DaysAgo genValidSpec @DaysAgo describe "daysAgo" $ do - it "produces valid TimeAgos" $ producesValidsOnValids daysAgo - it "is the inverse of daysAgoToDays" $ inverseFunctionsOnValid daysAgo daysAgoToDays + it "produces valid TimeAgos" $ producesValid daysAgo + it "is the inverse of daysAgoToDays" $ inverseFunctions daysAgo daysAgoToDays describe "daysAgoToDays" $ do - it "produces valid results" $ producesValidsOnValids daysAgoToDays + it "produces valid results" $ producesValid daysAgoToDays it "is the inverse of daysAgo for just days" $ inverseFunctionsOnGen daysAgoToDays daysAgo (((\d -> DaysAgo GT 0 d 0 0) <$> genValid) `suchThat` isValid) (const []) - it "is the inverse of daysAgo" $ inverseFunctionsOnValid daysAgoToDays daysAgo + it "is the inverse of daysAgo" $ inverseFunctions daysAgoToDays daysAgo describe "renderDaysAgoAuto" $ do - it "produces valid Strings" $ producesValidsOnValids renderDaysAgoAuto + it "produces valid Strings" $ producesValid renderDaysAgoAuto let i da s = it (unwords ["Renders", show da, "as", show s]) $ renderDaysAgoAuto da `shouldBe` s describe "renders these simple examples well" $ do i (DaysAgo GT 5 0 0 0) "5 years ago" @@ -79,19 +76,19 @@ eqSpec @TimeAgo genValidSpec @TimeAgo describe "timeAgo" $ do - it "produces valid TimeAgo's" $ producesValidsOnValids timeAgo - it "is the inverse of timeAgoToDiffTime" $ inverseFunctionsOnValid timeAgo timeAgoToDiffTime + it "produces valid TimeAgo's" $ producesValid timeAgo + it "is the inverse of timeAgoToDiffTime" $ inverseFunctions timeAgo timeAgoToDiffTime describe "timeAgoToDiffTime" $ do - it "produces valid DiffTime's" $ producesValidsOnValids timeAgoToDiffTime + it "produces valid DiffTime's" $ producesValid timeAgoToDiffTime it "is the inverse of timeAgo for just picoseconds" $ inverseFunctionsOnGen timeAgoToDiffTime timeAgo ((TimeAgo GT (DaysAgo EQ 0 0 0 0) 0 0 0 <$> genValid) `suchThat` isValid) (const []) - it "is the inverse of timeAgo" $ inverseFunctionsOnValid timeAgoToDiffTime timeAgo + it "is the inverse of timeAgo" $ inverseFunctions timeAgoToDiffTime timeAgo describe "renderTimeAgoAuto" $ do - it "produces valid Strings's" $ producesValidsOnValids renderTimeAgoAuto + it "produces valid Strings's" $ producesValid renderTimeAgoAuto let i ta s = it (unwords ["Renders", show ta, "as", show s]) $ renderTimeAgoAuto ta `shouldBe` s describe "renders these simple examples well" $ do i (TimeAgo GT (DaysAgo GT 2 0 0 0) 0 0 0 0) "2 years ago"