module Formatting.Time where
import Data.List
import Data.Text.Lazy.Builder
import Formatting.Formatters hiding (build)
import Formatting.Holey
import Formatting.Internal
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Buildable
import Data.Time
import System.Locale
tz :: FormatTime a => Format a
tz = later (build . fmt "%z")
tzName :: FormatTime a => Format a
tzName = later (build . fmt "%Z")
datetime :: FormatTime a => Format a
datetime = later (build . fmt "%c")
hm :: FormatTime a => Format a
hm = later (build . fmt "%R")
hms :: FormatTime a => Format a
hms = later (build . fmt "%T")
hmsL :: FormatTime a => Format a
hmsL = later (build . fmt "%X")
hmsPL :: FormatTime a => Format a
hmsPL = later (build . fmt "%r")
dayHalf :: FormatTime a => Format a
dayHalf = later (build . fmt "%P")
dayHalfU :: FormatTime a => Format a
dayHalfU = later (build . fmt "%p")
hour24 :: FormatTime a => Format a
hour24 = later (build . fmt "%H")
hour12 :: FormatTime a => Format a
hour12 = later (build . fmt "%I")
hour24S :: FormatTime a => Format a
hour24S = later (build . fmt "%k")
hour12S :: FormatTime a => Format a
hour12S = later (build . fmt "%l")
minute :: FormatTime a => Format a
minute = later (build . fmt "%M")
second :: FormatTime a => Format a
second = later (build . fmt "%S")
pico :: FormatTime a => Format a
pico = later (build . fmt "%q")
decimals :: FormatTime a => Format a
decimals = later (build . fmt "%Q")
epoch :: FormatTime a => Format a
epoch = later (build . fmt "%s")
dateSlash :: FormatTime a => Format a
dateSlash = later (build . fmt "%D")
dateDash :: FormatTime a => Format a
dateDash = later (build . fmt "%F")
dateSlashL :: FormatTime a => Format a
dateSlashL = later (build . fmt "%x")
year :: FormatTime a => Format a
year = later (build . fmt "%Y")
yy :: FormatTime a => Format a
yy = later (build . fmt "%y")
century :: FormatTime a => Format a
century = later (build . fmt "%C")
monthName :: FormatTime a => Format a
monthName = later (build . fmt "%B")
monthNameShort :: FormatTime a => Format a
monthNameShort = later (build . fmt "%b")
month :: FormatTime a => Format a
month = later (build . fmt "%m")
dayOfMonth :: FormatTime a => Format a
dayOfMonth = later (build . fmt "%d")
dayOfMonthS :: FormatTime a => Format a
dayOfMonthS = later (build . fmt "%e")
day :: FormatTime a => Format a
day = later (build . fmt "%j")
weekYear :: FormatTime a => Format a
weekYear = later (build . fmt "%G")
weekYY :: FormatTime a => Format a
weekYY = later (build . fmt "%g")
weekCentury :: FormatTime a => Format a
weekCentury = later (build . fmt "%f")
week :: FormatTime a => Format a
week = later (build . fmt "%V")
dayOfWeek :: FormatTime a => Format a
dayOfWeek = later (build . fmt "%u")
dayNameShort :: FormatTime a => Format a
dayNameShort = later (build . fmt "%a")
dayName :: FormatTime a => Format a
dayName = later (build . fmt "%A")
weekFromZero :: FormatTime a => Format a
weekFromZero = later (build . fmt "%U")
dayOfWeekFromZero :: FormatTime a => Format a
dayOfWeekFromZero = later (build . fmt "%w")
weekOfYearMon :: FormatTime a => Format a
weekOfYearMon = later (build . fmt "%W")
diff :: Bool
-> Format (UTCTime, UTCTime)
diff fix =
later (fromLazyText . diffed)
where
diffed (t1,t2) =
case find (\(s,_,_) -> abs ts >= s) ranges of
Nothing -> "unknown"
Just (_,f,base) -> format (prefix % f % suffix) (toInt ts base)
where ts = diffUTCTime t1 t2
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))
ranges =
[(0,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
fmt :: FormatTime a => Text -> a -> Text
fmt f = T.pack . formatTime defaultTimeLocale (T.unpack f)