module Data.Time.Extra where
import Control.Monad.Trans
import Data.List
import Data.Text (Text,pack)
import Data.Time
import System.Locale
import Text.Printf
getYear :: FormatTime t => t -> Integer
getYear = read . formatTime defaultTimeLocale "%Y"
getMonth :: FormatTime t => t -> Integer
getMonth = read . formatTime defaultTimeLocale "%m"
getDay :: FormatTime t => t -> Integer
getDay = read . formatTime defaultTimeLocale "%d"
relative :: UTCTime
-> UTCTime
-> Bool
-> Text
relative t1 t2 fix = pack $ maybe "unknown" format $ find (\(s,_,_) -> abs span'>=s) $ reverse ranges where
minute = 60; hour = minute * 60; day = hour * 24;
week = day * 7; month = day * 30; year = month * 12
format range =
(if fix && span'>0 then "in " else "")
++ case range of
(_,str,0) -> str
(_,str,base) -> printf str (abs $ round (span' / base) :: Integer)
++ (if fix && span'<0 then " ago" else "")
span' = t1 `diffUTCTime` t2
ranges = [(0,"%d seconds",1)
,(minute,"a minute",0)
,(minute*2,"% minutes",minute)
,(minute*30,"half an hour",0)
,(minute*31,"%d minutes",minute)
,(hour,"an hour",0)
,(hour*2,"%d hours",hour)
,(hour*3,"a few hours",0)
,(hour*4,"%d hours",hour)
,(day,"a day",0)
,(day*2,"%d days",day)
,(week,"a week",0)
,(week*2,"%d weeks",week)
,(month,"a month",0)
,(month*2,"%d months",month)
,(year,"a year",0)
,(year*2,"%d years",year)
]
stopwatch :: MonadIO m => m a -> m (a,NominalDiffTime)
stopwatch computation = do
start <- liftIO $ getCurrentTime
!a <- computation
end <- liftIO $ getCurrentTime
return (a,end `diffUTCTime` start)
bench :: MonadIO m => Integer -> m a -> m (a,NominalDiffTime)
bench i computation = go i Nothing where
go n Nothing = do
(a,time) <- stopwatch computation
go (n1) (Just (a,time))
go 0 (Just x) = do
return x
go n (Just (_,avgTime)) = do
(a,timeNew) <- stopwatch computation
go (n1) (Just (a,(timeNew + avgTime) / 2))