content: {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  -- | Formatters for time.
  
  module Formatting.Time
    ( tz
    , tzName
    , datetime
    , hm
    , hms
    , hmsL
    , hmsPL
    , dayHalf
    , dayHalfU
    , hour24
    , hour12
    , hour24S
    , hour12S
    , minute
    , second
    , pico
    , decimals
    , epoch
    , dateSlash
    , dateDash
    , dateSlashL
    , year
    , yy
    , century
    , monthName
    , monthNameShort
    , month
    , dayOfMonth
    , dayOfMonthOrd
    , dayOfMonthS
    , day
    , weekYear
    , weekYY
    , weekCentury
    , week
    , dayOfWeek
    , dayNameShort
    , dayName
    , weekFromZero
    , dayOfWeekFromZero
    , weekOfYearMon
    , diff
    , years
    , days
    , hours
    , minutes
    , seconds
    , diffComponents
    , customDiffComponents
    , fmt
    , customTimeFmt
    ) where
  
  import           Data.List (find)
  import           Data.Tuple
  import           Formatting.Formatters  hiding (build, base)
  import           Formatting.Internal
  
  import           Data.Text              (Text)
  import qualified Data.Text              as T
  import           Formatting.Buildable
  import           Data.Time (FormatTime, formatTime, defaultTimeLocale)
  import           System.Locale ()
  import           Control.Monad.Trans.State.Strict
  
  -- * For 'TimeZone' (and 'ZonedTime' and 'UTCTime'):
  
  -- | Timezone offset on the format @-HHMM@.
  tz :: FormatTime a => Format r (a -> r)
  tz = later (build . fmt "%z")
  
  -- | Timezone name.
  tzName :: FormatTime a => Format r (a -> r)
  tzName = later (build . fmt "%Z")
  
  -- | As 'dateTimeFmt' @locale@ (e.g. @%a %b %e %H:%M:%S %Z %Y@).
  datetime :: FormatTime a => Format r (a -> r)
  datetime = later (build . fmt "%c")
  
  -- * For 'TimeOfDay' (and 'LocalTime' and 'ZonedTime' and 'UTCTime'):
  
  -- | Same as @%H:%M@.
  hm :: FormatTime a => Format r (a -> r)
  hm = later (build . fmt "%R")
  
  -- | Same as @%H:%M:%S@.
  hms :: FormatTime a => Format r (a -> r)
  hms = later (build . fmt "%T")
  
  -- | As 'timeFmt' @locale@ (e.g. @%H:%M:%S@).
  hmsL :: FormatTime a => Format r (a -> r)
  hmsL = later (build . fmt "%X")
  
  -- | As 'time12Fmt' @locale@ (e.g. @%I:%M:%S %p@).
  hmsPL :: FormatTime a => Format r (a -> r)
  hmsPL = later (build . fmt "%r")
  
  -- | Day half from ('amPm' @locale@), converted to lowercase, @am@,
  -- @pm@.
  dayHalf :: FormatTime a => Format r (a -> r)
  dayHalf = later (build . fmt "%P")
  
  -- | Day half from ('amPm' @locale@), @AM@, @PM@.
  dayHalfU :: FormatTime a => Format r (a -> r)
  dayHalfU = later (build . fmt "%p")
  
  -- | Hour, 24-hour, leading 0 as needed, @00@ - @23@.
  hour24 :: FormatTime a => Format r (a -> r)
  hour24 = later (build . fmt "%H")
  
  -- | Hour, 12-hour, leading 0 as needed, @01@ - @12@.
  hour12 :: FormatTime a => Format r (a -> r)
  hour12 = later (build . fmt "%I")
  
  -- | Hour, 24-hour, leading space as needed, @ 0@ - @23@.
  hour24S :: FormatTime a => Format r (a -> r)
  hour24S = later (build . fmt "%k")
  
  -- | Hour, 12-hour, leading space as needed, @ 1@ - @12@.
  hour12S :: FormatTime a => Format r (a -> r)
  hour12S = later (build . fmt "%l")
  
  -- | Minute, @00@ - @59@.
  minute :: FormatTime a => Format r (a -> r)
  minute = later (build . fmt "%M")
  
  -- | Second, without decimal part, @00@ - @60@.
  second :: FormatTime a => Format r (a -> r)
  second = later (build . fmt "%S")
  
  -- | Picosecond, including trailing zeros, @000000000000@ -
  -- @999999999999@.
  pico :: FormatTime a => Format r (a -> r)
  pico = later (build . fmt "%q")
  
  -- | Decimal point and up to 12 second decimals, without trailing
  -- zeros. For a whole number of seconds, this produces the empty
  -- string.
  decimals :: FormatTime a => Format r (a -> r)
  decimals = later (build . fmt "%Q")
  
  -- * For 'UTCTime' and 'ZonedTime'
  --
  -- Number of whole seconds since the Unix epoch. For times before
  -- the Unix epoch, this is a negative number. Note that in @%s.%q@ and @%s%Q@
  -- the decimals are positive, not negative. For example, 0.9 seconds
  -- before the Unix epoch is formatted as @-1.1@ with @%s%Q@.
  epoch :: FormatTime a => Format r (a -> r)
  epoch = later (build . fmt "%s")
  
  -- * For 'Day' (and 'LocalTime' and 'ZonedTime' and 'UTCTime'):
  
  -- | Same as @%m\/%d\/%y@.
  dateSlash :: FormatTime a => Format r (a -> r)
  dateSlash = later (build . fmt "%D")
  
  -- | Same as @%Y-%m-%d@.
  dateDash :: FormatTime a => Format r (a -> r)
  dateDash = later (build . fmt "%F")
  
  -- | As 'dateFmt' @locale@ (e.g. @%m\/%d\/%y@).
  dateSlashL :: FormatTime a => Format r (a -> r)
  dateSlashL = later (build . fmt "%x")
  
  -- | Year.
  year :: FormatTime a => Format r (a -> r)
  year = later (build . fmt "%Y")
  
  -- | Last two digits of year, @00@ - @99@.
  yy :: FormatTime a => Format r (a -> r)
  yy = later (build . fmt "%y")
  
  -- | Century (being the first two digits of the year), @00@ - @99@.
  century :: FormatTime a => Format r (a -> r)
  century = later (build . fmt "%C")
  
  -- | Month name, long form ('fst' from 'months' @locale@), @January@ -
  -- @December@.
  monthName :: FormatTime a => Format r (a -> r)
  monthName = later (build . fmt "%B")
  
  -- | @ %H] month name, short form ('snd' from 'months' @locale@),
  -- @Jan@ - @Dec@.
  monthNameShort :: FormatTime a => Format r (a -> r)
  monthNameShort = later (build . fmt "%b")
  
  -- | Month of year, leading 0 as needed, @01@ - @12@.
  month :: FormatTime a => Format r (a -> r)
  month = later (build . fmt "%m")
  
  -- | Day of month, leading 0 as needed, @01@ - @31@.
  dayOfMonth :: FormatTime a => Format r (a -> r)
  dayOfMonth = later (build . fmt "%d")
  
  -- | Day of month, @1st@, @2nd@, @25th@, etc.
  dayOfMonthOrd :: FormatTime a => Format r (a -> r)
  dayOfMonthOrd = later (bprint ords . toInt)
    where toInt :: FormatTime a => a -> Int
          toInt = read . formatTime defaultTimeLocale "%d"
  
  -- | Day of month, leading space as needed, @ 1@ - @31@.
  dayOfMonthS :: FormatTime a => Format r (a -> r)
  dayOfMonthS = later (build . fmt "%e")
  
  -- | Day of year for Ordinal Date format, @001@ - @366@.
  day :: FormatTime a => Format r (a -> r)
  day = later (build . fmt "%j")
  
  -- | Year for Week Date format e.g. @2013@.
  weekYear :: FormatTime a => Format r (a -> r)
  weekYear = later (build . fmt "%G")
  
  -- | Last two digits of year for Week Date format, @00@ - @99@.
  weekYY :: FormatTime a => Format r (a -> r)
  weekYY = later (build . fmt "%g")
  
  -- | Century (first two digits of year) for Week Date format, @00@ -
  -- @99@.
  weekCentury :: FormatTime a => Format r (a -> r)
  weekCentury = later (build . fmt "%f")
  
  -- | Week for Week Date format, @01@ - @53@.
  week :: FormatTime a => Format r (a -> r)
  week = later (build . fmt "%V")
  
  -- | Day for Week Date format, @1@ - @7@.
  dayOfWeek :: FormatTime a => Format r (a -> r)
  dayOfWeek = later (build . fmt "%u")
  
  -- | Day of week, short form ('snd' from 'wDays' @locale@), @Sun@ -
  -- @Sat@.
  dayNameShort :: FormatTime a => Format r (a -> r)
  dayNameShort = later (build . fmt "%a")
  
  -- | Day of week, long form ('fst' from 'wDays' @locale@), @Sunday@ -
  -- @Saturday@.
  dayName :: FormatTime a => Format r (a -> r)
  dayName = later (build . fmt "%A")
  
  -- | Week number of year, where weeks start on Sunday (as
  -- 'sundayStartWeek'), @00@ - @53@.
  weekFromZero :: FormatTime a => Format r (a -> r)
  weekFromZero = later (build . fmt "%U")
  
  -- | Day of week number, @0@ (= Sunday) - @6@ (= Saturday).
  dayOfWeekFromZero :: FormatTime a => Format r (a -> r)
  dayOfWeekFromZero = later (build . fmt "%w")
  
  -- | Week number of year, where weeks start on Monday (as
  -- 'mondayStartWeek'), @00@ - @53@.
  weekOfYearMon :: FormatTime a => Format r (a -> r)
  weekOfYearMon = later (build . fmt "%W")
  
  -- * Time spans, diffs, 'NominalDiffTime', 'DiffTime', etc.
  
  -- | Display a time span as one time relative to another. Input is
  -- assumed to be seconds. Typical inputs are 'NominalDiffTime' and
  -- 'DiffTime'.
  diff :: (RealFrac n)
       => Bool     -- ^ Display 'in/ago'?
       -> Format r (n -> r) -- ^ Example: '3 seconds ago', 'in three days'.)
  diff fix =
    later diffed
    where
      diffed ts =
        case find (\(s,_,_) -> abs ts >= s) (reverse ranges) of
          Nothing -> "unknown"
          Just (_,f,base) -> bprint (prefix % f % suffix) (toInt ts base)
        where prefix = now (if fix && ts > 0 then "in " else "")
              suffix = now (if fix && ts < 0 then " ago" else "")
      toInt ts base = abs (round (ts / base)) :: Int
      ranges =
        [(0,int % " milliseconds",0.001)
        ,(1,int % " seconds",1)
        ,(minute',fconst "a minute",0)
        ,(minute'*2,int % " minutes",minute')
        ,(minute'*30,fconst "half an hour",0)
        ,(minute'*31,int % " minutes",minute')
        ,(hour',fconst "an hour",0)
        ,(hour'*2,int % " hours",hour')
        ,(hour'*3,fconst "a few hours",0)
        ,(hour'*4,int % " hours",hour')
        ,(day',fconst "a day",0)
        ,(day'*2,int % " days",day')
        ,(week',fconst "a week",0)
        ,(week'*2,int % " weeks",week')
        ,(month',fconst "a month",0)
        ,(month'*2,int % " months",month')
        ,(year',fconst "a year",0)
        ,(year'*2,int % " years",year')]
        where year' = month' * 12
              month' = day' * 30
              week' = day' * 7
              day' = hour' * 24
              hour' = minute' * 60
              minute' = 60
  
  -- | Display the absolute value time span in years.
  years :: (RealFrac n)
        => Int -- ^ Decimal places.
        -> Format r (n -> r)
  years n = later (bprint (fixed n) . abs . count)
    where count n' = n' / 365 / 24 / 60 / 60
  
  -- | Display the absolute value time span in days.
  days :: (RealFrac n)
        => Int -- ^ Decimal places.
        -> Format r (n -> r)
  days n = later (bprint (fixed n) . abs . count)
    where count n' = n' / 24 / 60 / 60
  
  -- | Display the absolute value time span in hours.
  hours :: (RealFrac n)
        => Int -- ^ Decimal places.
        -> Format r (n -> r)
  hours n = later (bprint (fixed n) . abs . count)
    where count n' = n' / 60 / 60
  
  -- | Display the absolute value time span in minutes.
  minutes :: (RealFrac n)
        => Int -- ^ Decimal places.
        -> Format r (n -> r)
  minutes n = later (bprint (fixed n) . abs . count)
    where count n' = n' / 60
  
  -- | Display the absolute value time span in seconds.
  seconds :: (RealFrac n)
        => Int -- ^ Decimal places.
        -> Format r (n -> r)
  seconds n = later (bprint (fixed n) . abs . count)
    where count n' = n'
  
  -- | Display seconds in the following pattern:
  -- @00:00:00:00@, which ranges from days to seconds.
  diffComponents :: (RealFrac n) => Format r (n -> r)
  diffComponents = customDiffComponents (left 2 '0' % ":" % left 2 '0' % ":" % left 2 '0' % ":" % left 2 '0')
  
  -- | Variation of 'diffComponents',
  -- which lets you explicitly specify how to render each component.
  customDiffComponents :: (RealFrac n) => (forall r'. Format r' (Integer -> Integer -> Integer -> Integer -> r')) -> Format r (n -> r)
  customDiffComponents subFormat = later builder' where
    builder' diffTime = flip evalState (round diffTime) $ do
      seconds' <- state (swap . flip divMod 60)
      minutes' <- state (swap . flip divMod 60)
      hours' <- state (swap . flip divMod 24)
      days' <- get
      return (bprint subFormat days' hours' minutes' seconds')
  
  -- * Internal.
  
  -- | Formatter call. Probably don't want to use this.
  fmt :: FormatTime a => Text -> a -> Text
  fmt f = T.pack . formatTime defaultTimeLocale (T.unpack f)
  
  -- | Helper for creating custom time formatters
  customTimeFmt :: FormatTime a => Text -> Format r (a -> r)
  customTimeFmt f = later (build . fmt f)
  