module Text.Time.Pretty
  ( prettyTimeAutoFromNow,
    prettyTimeAuto,
    prettyDayAutoFromNow,
    prettyDayAuto,
    -- Helper functions
    timeAgo,
    timeAgoToDiffTime,
    daysAgo,
    daysAgoToDays,

    -- * Helper Types
    TimeAgo (..),
    DaysAgo (..),

    -- * Rendering
    renderDaysAgoAuto,
    renderTimeAgoAuto,

    -- * Constants
    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 :: UTCTime -> IO String
prettyTimeAutoFromNow UTCTime
before = do
  UTCTime
now <- IO UTCTime
getCurrentTime
  String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> String
prettyTimeAuto UTCTime
now UTCTime
before

prettyTimeAuto :: UTCTime -> UTCTime -> String
prettyTimeAuto :: UTCTime -> UTCTime -> String
prettyTimeAuto UTCTime
now UTCTime
before = TimeAgo -> String
renderTimeAgoAuto (TimeAgo -> String) -> TimeAgo -> String
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> TimeAgo
timeAgo (NominalDiffTime -> TimeAgo) -> NominalDiffTime -> TimeAgo
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
now UTCTime
before

prettyDayAutoFromNow :: Day -> IO String
prettyDayAutoFromNow :: Day -> IO String
prettyDayAutoFromNow Day
before = do
  Day
today <- LocalTime -> Day
localDay (LocalTime -> Day) -> (ZonedTime -> LocalTime) -> ZonedTime -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> LocalTime
zonedTimeToLocalTime (ZonedTime -> Day) -> IO ZonedTime -> IO Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ZonedTime
getZonedTime
  String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Day -> Day -> String
prettyDayAuto Day
today Day
before

prettyDayAuto :: Day -> Day -> String
prettyDayAuto :: Day -> Day -> String
prettyDayAuto Day
today Day
before = DaysAgo -> String
renderDaysAgoAuto (DaysAgo -> String) -> DaysAgo -> String
forall a b. (a -> b) -> a -> b
$ Integer -> DaysAgo
daysAgo (Integer -> DaysAgo) -> Integer -> DaysAgo
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Integer
diffDays Day
today Day
before