{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RecordWildCards #-} module Text.Time.Pretty.TimeAgo ( 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 { DaysAgo -> Ordering daysAgoSign :: Ordering, DaysAgo -> Integer daysAgoYears :: Integer, DaysAgo -> Integer daysAgoMonths :: Integer, DaysAgo -> Integer daysAgoWeeks :: Integer, DaysAgo -> Integer daysAgoDays :: Integer } deriving (Int -> DaysAgo -> ShowS [DaysAgo] -> ShowS DaysAgo -> String (Int -> DaysAgo -> ShowS) -> (DaysAgo -> String) -> ([DaysAgo] -> ShowS) -> Show DaysAgo forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [DaysAgo] -> ShowS $cshowList :: [DaysAgo] -> ShowS show :: DaysAgo -> String $cshow :: DaysAgo -> String showsPrec :: Int -> DaysAgo -> ShowS $cshowsPrec :: Int -> DaysAgo -> ShowS Show, DaysAgo -> DaysAgo -> Bool (DaysAgo -> DaysAgo -> Bool) -> (DaysAgo -> DaysAgo -> Bool) -> Eq DaysAgo forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: DaysAgo -> DaysAgo -> Bool $c/= :: DaysAgo -> DaysAgo -> Bool == :: DaysAgo -> DaysAgo -> Bool $c== :: DaysAgo -> DaysAgo -> Bool Eq, (forall x. DaysAgo -> Rep DaysAgo x) -> (forall x. Rep DaysAgo x -> DaysAgo) -> Generic DaysAgo forall x. Rep DaysAgo x -> DaysAgo forall x. DaysAgo -> Rep DaysAgo x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep DaysAgo x -> DaysAgo $cfrom :: forall x. DaysAgo -> Rep DaysAgo x Generic) instance Validity DaysAgo where validate :: DaysAgo -> Validation validate da :: DaysAgo da@DaysAgo {Integer Ordering daysAgoDays :: Integer daysAgoWeeks :: Integer daysAgoMonths :: Integer daysAgoYears :: Integer daysAgoSign :: Ordering daysAgoDays :: DaysAgo -> Integer daysAgoWeeks :: DaysAgo -> Integer daysAgoMonths :: DaysAgo -> Integer daysAgoYears :: DaysAgo -> Integer daysAgoSign :: DaysAgo -> Ordering ..} = [Validation] -> Validation forall a. Monoid a => [a] -> a mconcat [ DaysAgo -> Validation forall a. (Generic a, GValidity (Rep a)) => a -> Validation genericValidate DaysAgo da, Bool -> String -> Validation check ( case Ordering daysAgoSign of Ordering EQ -> [Bool] -> Bool forall (t :: * -> *). Foldable t => t Bool -> Bool and [ Integer daysAgoDays Integer -> Integer -> Bool forall a. Eq a => a -> a -> Bool == Integer 0, Integer daysAgoWeeks Integer -> Integer -> Bool forall a. Eq a => a -> a -> Bool == Integer 0, Integer daysAgoMonths Integer -> Integer -> Bool forall a. Eq a => a -> a -> Bool == Integer 0, Integer daysAgoYears Integer -> Integer -> Bool forall a. Eq a => a -> a -> Bool == Integer 0 ] Ordering _ -> (Integer -> Bool) -> [Integer] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool > Integer 0) [Integer daysAgoDays, Integer daysAgoWeeks, Integer daysAgoMonths, Integer daysAgoYears] ) String "the sign makes sense", Bool -> String -> Validation check (Integer daysAgoYears Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool >= Integer 0) String "years are positive", Bool -> String -> Validation check ( Integer daysAgoDays Integer -> Integer -> Integer forall a. Num a => a -> a -> a + Integer forall a. Integral a => a daysPerWeek Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer daysAgoWeeks Integer -> Integer -> Integer forall a. Num a => a -> a -> a + Integer forall a. Integral a => a approximateDaysPerMonth Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer daysAgoMonths Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool < Integer forall a. Integral a => a approximateDaysPerYear ) String "days, weeks and months do not sum to a year", Bool -> String -> Validation check (Integer daysAgoMonths Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool < Integer 12) String "months < 12", Bool -> String -> Validation check (Integer daysAgoMonths Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool >= Integer 0) String "months are positive", Bool -> String -> Validation check (Integer daysAgoDays Integer -> Integer -> Integer forall a. Num a => a -> a -> a + Integer forall a. Integral a => a daysPerWeek Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer daysAgoWeeks Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool < Integer forall a. Integral a => a approximateDaysPerMonth) String "days and weeks do not sum to a month", Bool -> String -> Validation check (Integer daysAgoWeeks Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool < Integer 5) String "weeks < 5", Bool -> String -> Validation check (Integer daysAgoWeeks Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool >= Integer 0) String "weeks are positive", Bool -> String -> Validation check (Integer daysAgoDays Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool < Integer 7) String "days < 7", Bool -> String -> Validation check (Integer daysAgoDays Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool >= Integer 0) String "days are positive" ] daysAgo :: Integer -> DaysAgo daysAgo :: Integer -> DaysAgo daysAgo Integer i = DaysAgo :: Ordering -> Integer -> Integer -> Integer -> Integer -> DaysAgo DaysAgo {Integer Ordering daysAgoDays :: Integer daysAgoWeeks :: Integer daysAgoMonths :: Integer daysAgoYears :: Integer daysAgoSign :: Ordering daysAgoDays :: Integer daysAgoWeeks :: Integer daysAgoMonths :: Integer daysAgoYears :: Integer daysAgoSign :: Ordering ..} where totalDays :: Integer totalDays = Integer -> Integer forall a. Num a => a -> a abs Integer i daysAgoSign :: Ordering daysAgoSign = Integer -> Integer -> Ordering forall a. Ord a => a -> a -> Ordering compare Integer i Integer 0 daysAgoYears :: Integer daysAgoYears = Integer totalDays Integer -> Integer -> Integer forall a. Integral a => a -> a -> a `div` Integer forall a. Integral a => a approximateDaysPerYear daysLeftAfterYears :: Integer daysLeftAfterYears = Integer totalDays Integer -> Integer -> Integer forall a. Num a => a -> a -> a - Integer daysAgoYears Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer forall a. Integral a => a approximateDaysPerYear daysAgoMonths :: Integer daysAgoMonths = Integer daysLeftAfterYears Integer -> Integer -> Integer forall a. Integral a => a -> a -> a `div` Integer forall a. Integral a => a approximateDaysPerMonth daysLeftAfterMonths :: Integer daysLeftAfterMonths = Integer daysLeftAfterYears Integer -> Integer -> Integer forall a. Num a => a -> a -> a - Integer daysAgoMonths Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer forall a. Integral a => a approximateDaysPerMonth daysAgoWeeks :: Integer daysAgoWeeks = Integer daysLeftAfterMonths Integer -> Integer -> Integer forall a. Integral a => a -> a -> a `div` Integer forall a. Integral a => a daysPerWeek daysLeftAfterWeeks :: Integer daysLeftAfterWeeks = Integer daysLeftAfterMonths Integer -> Integer -> Integer forall a. Num a => a -> a -> a - Integer daysAgoWeeks Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer forall a. Integral a => a daysPerWeek daysAgoDays :: Integer daysAgoDays = Integer daysLeftAfterWeeks daysAgoToDays :: DaysAgo -> Integer daysAgoToDays :: DaysAgo -> Integer daysAgoToDays DaysAgo {Integer Ordering daysAgoDays :: Integer daysAgoWeeks :: Integer daysAgoMonths :: Integer daysAgoYears :: Integer daysAgoSign :: Ordering daysAgoDays :: DaysAgo -> Integer daysAgoWeeks :: DaysAgo -> Integer daysAgoMonths :: DaysAgo -> Integer daysAgoYears :: DaysAgo -> Integer daysAgoSign :: DaysAgo -> Ordering ..} = ( case Ordering daysAgoSign of Ordering EQ -> Integer -> Integer -> Integer forall a b. a -> b -> a const Integer 0 Ordering GT -> Integer -> Integer forall a. a -> a id Ordering LT -> Integer -> Integer forall a. Num a => a -> a negate ) (Integer -> Integer) -> Integer -> Integer forall a b. (a -> b) -> a -> b $ Integer daysAgoDays Integer -> Integer -> Integer forall a. Num a => a -> a -> a + Integer forall a. Integral a => a daysPerWeek Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer daysAgoWeeks Integer -> Integer -> Integer forall a. Num a => a -> a -> a + Integer forall a. Integral a => a approximateDaysPerMonth Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer daysAgoMonths Integer -> Integer -> Integer forall a. Num a => a -> a -> a + Integer forall a. Integral a => a approximateDaysPerYear Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer daysAgoYears data TimeAgo = TimeAgo { TimeAgo -> Ordering timeAgoSign :: Ordering, TimeAgo -> DaysAgo timeAgoDaysAgo :: DaysAgo, TimeAgo -> Integer timeAgoHours :: Integer, TimeAgo -> Integer timeAgoMinutes :: Integer, TimeAgo -> Integer timeAgoSeconds :: Integer, TimeAgo -> Integer timeAgoPicoSeconds :: Integer } deriving (Int -> TimeAgo -> ShowS [TimeAgo] -> ShowS TimeAgo -> String (Int -> TimeAgo -> ShowS) -> (TimeAgo -> String) -> ([TimeAgo] -> ShowS) -> Show TimeAgo forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [TimeAgo] -> ShowS $cshowList :: [TimeAgo] -> ShowS show :: TimeAgo -> String $cshow :: TimeAgo -> String showsPrec :: Int -> TimeAgo -> ShowS $cshowsPrec :: Int -> TimeAgo -> ShowS Show, TimeAgo -> TimeAgo -> Bool (TimeAgo -> TimeAgo -> Bool) -> (TimeAgo -> TimeAgo -> Bool) -> Eq TimeAgo forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: TimeAgo -> TimeAgo -> Bool $c/= :: TimeAgo -> TimeAgo -> Bool == :: TimeAgo -> TimeAgo -> Bool $c== :: TimeAgo -> TimeAgo -> Bool Eq, (forall x. TimeAgo -> Rep TimeAgo x) -> (forall x. Rep TimeAgo x -> TimeAgo) -> Generic TimeAgo forall x. Rep TimeAgo x -> TimeAgo forall x. TimeAgo -> Rep TimeAgo x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep TimeAgo x -> TimeAgo $cfrom :: forall x. TimeAgo -> Rep TimeAgo x Generic) instance Validity TimeAgo where validate :: TimeAgo -> Validation validate ta :: TimeAgo ta@TimeAgo {Integer Ordering DaysAgo timeAgoPicoSeconds :: Integer timeAgoSeconds :: Integer timeAgoMinutes :: Integer timeAgoHours :: Integer timeAgoDaysAgo :: DaysAgo timeAgoSign :: Ordering timeAgoPicoSeconds :: TimeAgo -> Integer timeAgoSeconds :: TimeAgo -> Integer timeAgoMinutes :: TimeAgo -> Integer timeAgoHours :: TimeAgo -> Integer timeAgoDaysAgo :: TimeAgo -> DaysAgo timeAgoSign :: TimeAgo -> Ordering ..} = [Validation] -> Validation forall a. Monoid a => [a] -> a mconcat [ TimeAgo -> Validation forall a. (Generic a, GValidity (Rep a)) => a -> Validation genericValidate TimeAgo ta, Bool -> String -> Validation check ( case Ordering timeAgoSign of Ordering EQ -> [Bool] -> Bool forall (t :: * -> *). Foldable t => t Bool -> Bool and [ DaysAgo -> Integer daysAgoToDays DaysAgo timeAgoDaysAgo Integer -> Integer -> Bool forall a. Eq a => a -> a -> Bool == Integer 0, Integer timeAgoHours Integer -> Integer -> Bool forall a. Eq a => a -> a -> Bool == Integer 0, Integer timeAgoMinutes Integer -> Integer -> Bool forall a. Eq a => a -> a -> Bool == Integer 0, Integer timeAgoSeconds Integer -> Integer -> Bool forall a. Eq a => a -> a -> Bool == Integer 0, Integer timeAgoPicoSeconds Integer -> Integer -> Bool forall a. Eq a => a -> a -> Bool == Integer 0 ] Ordering _ -> (Integer -> Bool) -> [Integer] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool > Integer 0) [ DaysAgo -> Integer daysAgoToDays DaysAgo timeAgoDaysAgo, Integer timeAgoHours, Integer timeAgoMinutes, Integer timeAgoSeconds, Integer timeAgoPicoSeconds ] ) String "the sign makes sense", Bool -> String -> Validation check (DaysAgo -> Ordering daysAgoSign DaysAgo timeAgoDaysAgo Ordering -> Ordering -> Bool forall a. Eq a => a -> a -> Bool /= Ordering LT) String "The days ago are not negative", Bool -> String -> Validation check (Integer timeAgoHours Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool < Integer forall a. Integral a => a hoursPerDay) String "hours < 24", Bool -> String -> Validation check (Integer timeAgoHours Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool >= Integer 0) String "hours are positive", Bool -> String -> Validation check (Integer timeAgoMinutes Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool < Integer forall a. Integral a => a minutesPerHour) String "minutes < 60", Bool -> String -> Validation check (Integer timeAgoMinutes Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool >= Integer 0) String "minutes are positive", Bool -> String -> Validation check (Integer timeAgoSeconds Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool < Integer forall a. Integral a => a secondsPerMinute) String "seconds < 60", Bool -> String -> Validation check (Integer timeAgoSeconds Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool >= Integer 0) String "seconds are positive", Bool -> String -> Validation check (Integer timeAgoPicoSeconds Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool < Integer forall a. Integral a => a picoSecondsPerSecond) String "picoseconds < 1E12", Bool -> String -> Validation check (Integer timeAgoPicoSeconds Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool >= Integer 0) String "picoseconds are positive" ] timeAgo :: NominalDiffTime -> TimeAgo timeAgo :: NominalDiffTime -> TimeAgo timeAgo NominalDiffTime dt = TimeAgo :: Ordering -> DaysAgo -> Integer -> Integer -> Integer -> Integer -> TimeAgo TimeAgo {Integer Ordering DaysAgo timeAgoDaysAgo :: DaysAgo timeAgoHours :: Integer timeAgoMinutes :: Integer timeAgoSeconds :: Integer timeAgoPicoSeconds :: Integer timeAgoSign :: Ordering timeAgoPicoSeconds :: Integer timeAgoSeconds :: Integer timeAgoMinutes :: Integer timeAgoHours :: Integer timeAgoDaysAgo :: DaysAgo timeAgoSign :: Ordering ..} where timeAgoSign :: Ordering timeAgoSign = NominalDiffTime -> NominalDiffTime -> Ordering forall a. Ord a => a -> a -> Ordering compare NominalDiffTime dt NominalDiffTime 0 timeAgoPicoSeconds :: Integer timeAgoPicoSeconds = Integer totalPicoSecondsAgo Integer -> Integer -> Integer forall a. Num a => a -> a -> a - Integer forall a. Integral a => a picoSecondsPerSecond Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer totalSecondsAgo timeAgoSeconds :: Integer timeAgoSeconds = Integer totalSecondsAgo Integer -> Integer -> Integer forall a. Num a => a -> a -> a - Integer forall a. Integral a => a secondsPerMinute Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer totalMinutesAgo timeAgoMinutes :: Integer timeAgoMinutes = Integer totalMinutesAgo Integer -> Integer -> Integer forall a. Num a => a -> a -> a - Integer forall a. Integral a => a minutesPerHour Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer totalHoursAgo timeAgoHours :: Integer timeAgoHours = Integer totalHoursAgo Integer -> Integer -> Integer forall a. Num a => a -> a -> a - Integer forall a. Integral a => a hoursPerDay Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer totalDaysAgo timeAgoDaysAgo :: DaysAgo timeAgoDaysAgo = Integer -> DaysAgo daysAgo Integer totalDaysAgo totalPicoSecondsAgo :: Integer totalPicoSecondsAgo = NominalDiffTime -> Integer forall a b. (RealFrac a, Integral b) => a -> b floor (NominalDiffTime -> Integer) -> NominalDiffTime -> Integer forall a b. (a -> b) -> a -> b $ NominalDiffTime absDt NominalDiffTime -> NominalDiffTime -> NominalDiffTime forall a. Num a => a -> a -> a * Integer -> NominalDiffTime forall a b. (Integral a, Num b) => a -> b fromIntegral (Integer forall a. Integral a => a picoSecondsPerSecond :: Integer) totalSecondsAgo :: Integer totalSecondsAgo = NominalDiffTime -> Integer forall a b. (RealFrac a, Integral b) => a -> b floor NominalDiffTime absDt :: Integer totalMinutesAgo :: Integer totalMinutesAgo = NominalDiffTime -> Integer forall a b. (RealFrac a, Integral b) => a -> b floor (NominalDiffTime -> Integer) -> NominalDiffTime -> Integer forall a b. (a -> b) -> a -> b $ NominalDiffTime absDt NominalDiffTime -> NominalDiffTime -> NominalDiffTime forall a. Fractional a => a -> a -> a / Integer -> NominalDiffTime forall a b. (Integral a, Num b) => a -> b fromIntegral (Integer forall a. Integral a => a secondsPerMinute :: Integer) totalHoursAgo :: Integer totalHoursAgo = NominalDiffTime -> Integer forall a b. (RealFrac a, Integral b) => a -> b floor (NominalDiffTime -> Integer) -> NominalDiffTime -> Integer forall a b. (a -> b) -> a -> b $ NominalDiffTime absDt NominalDiffTime -> NominalDiffTime -> NominalDiffTime forall a. Fractional a => a -> a -> a / Integer -> NominalDiffTime forall a b. (Integral a, Num b) => a -> b fromIntegral (Integer forall a. Integral a => a minutesPerHour Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer forall a. Integral a => a secondsPerMinute :: Integer) totalDaysAgo :: Integer totalDaysAgo = NominalDiffTime -> Integer forall a b. (RealFrac a, Integral b) => a -> b floor (NominalDiffTime -> Integer) -> NominalDiffTime -> Integer forall a b. (a -> b) -> a -> b $ NominalDiffTime absDt NominalDiffTime -> NominalDiffTime -> NominalDiffTime forall a. Fractional a => a -> a -> a / Integer -> NominalDiffTime forall a b. (Integral a, Num b) => a -> b fromIntegral (Integer forall a. Integral a => a hoursPerDay Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer forall a. Integral a => a minutesPerHour Integer -> Integer -> Integer forall a. Num a => a -> a -> a * Integer forall a. Integral a => a secondsPerMinute :: Integer) absDt :: NominalDiffTime absDt = NominalDiffTime -> NominalDiffTime forall a. Num a => a -> a abs NominalDiffTime dt timeAgoToDiffTime :: TimeAgo -> NominalDiffTime timeAgoToDiffTime :: TimeAgo -> NominalDiffTime timeAgoToDiffTime TimeAgo {Integer Ordering DaysAgo timeAgoPicoSeconds :: Integer timeAgoSeconds :: Integer timeAgoMinutes :: Integer timeAgoHours :: Integer timeAgoDaysAgo :: DaysAgo timeAgoSign :: Ordering timeAgoPicoSeconds :: TimeAgo -> Integer timeAgoSeconds :: TimeAgo -> Integer timeAgoMinutes :: TimeAgo -> Integer timeAgoHours :: TimeAgo -> Integer timeAgoDaysAgo :: TimeAgo -> DaysAgo timeAgoSign :: TimeAgo -> Ordering ..} = (NominalDiffTime -> NominalDiffTime -> NominalDiffTime forall a. Fractional a => a -> a -> a / Integer -> NominalDiffTime forall a b. (Integral a, Num b) => a -> b fromIntegral (Integer forall a. Integral a => a picoSecondsPerSecond :: Integer)) (NominalDiffTime -> NominalDiffTime) -> NominalDiffTime -> NominalDiffTime forall a b. (a -> b) -> a -> b $ Integer -> NominalDiffTime forall a b. (Real a, Fractional b) => a -> b realToFrac (Integer -> NominalDiffTime) -> Integer -> NominalDiffTime forall a b. (a -> b) -> a -> b $ ( case Ordering timeAgoSign of Ordering EQ -> Integer -> Integer -> Integer forall a b. a -> b -> a const Integer 0 Ordering GT -> Integer -> Integer forall a. a -> a id Ordering LT -> Integer -> Integer forall a. Num a => a -> a negate ) ( Integer timeAgoPicoSeconds Integer -> Integer -> Integer forall a. Num a => a -> a -> a + Integer forall a. Integral a => a picoSecondsPerSecond Integer -> Integer -> Integer forall a. Num a => a -> a -> a * ( Integer timeAgoSeconds Integer -> Integer -> Integer forall a. Num a => a -> a -> a + Integer forall a. Integral a => a secondsPerMinute Integer -> Integer -> Integer forall a. Num a => a -> a -> a * ( Integer timeAgoMinutes Integer -> Integer -> Integer forall a. Num a => a -> a -> a + Integer forall a. Integral a => a minutesPerHour Integer -> Integer -> Integer forall a. Num a => a -> a -> a * (Integer timeAgoHours Integer -> Integer -> Integer forall a. Num a => a -> a -> a + Integer forall a. Integral a => a hoursPerDay Integer -> Integer -> Integer forall a. Num a => a -> a -> a * DaysAgo -> Integer daysAgoToDays DaysAgo timeAgoDaysAgo) ) ) )