diff options
Diffstat (limited to 'Utility/HumanTime.hs')
-rw-r--r-- | Utility/HumanTime.hs | 104 |
1 files changed, 104 insertions, 0 deletions
diff --git a/Utility/HumanTime.hs b/Utility/HumanTime.hs new file mode 100644 index 0000000..01fbeac --- /dev/null +++ b/Utility/HumanTime.hs @@ -0,0 +1,104 @@ +{- Time for humans. + - + - Copyright 2012-2013 Joey Hess <id@joeyh.name> + - + - License: BSD-2-clause + -} + +module Utility.HumanTime ( + Duration(..), + durationSince, + durationToPOSIXTime, + durationToDays, + daysToDuration, + parseDuration, + fromDuration, + prop_duration_roundtrips +) where + +import Utility.PartialPrelude +import Utility.QuickCheck + +import qualified Data.Map as M +import Data.Time.Clock +import Data.Time.Clock.POSIX (POSIXTime) +import Data.Char +import Control.Applicative +import Prelude + +newtype Duration = Duration { durationSeconds :: Integer } + deriving (Eq, Ord, Read, Show) + +durationSince :: UTCTime -> IO Duration +durationSince pasttime = do + now <- getCurrentTime + return $ Duration $ round $ diffUTCTime now pasttime + +durationToPOSIXTime :: Duration -> POSIXTime +durationToPOSIXTime = fromIntegral . durationSeconds + +durationToDays :: Duration -> Integer +durationToDays d = durationSeconds d `div` dsecs + +daysToDuration :: Integer -> Duration +daysToDuration i = Duration $ i * dsecs + +{- Parses a human-input time duration, of the form "5h", "1m", "5h1m", etc -} +parseDuration :: Monad m => String -> m Duration +parseDuration = maybe parsefail (return . Duration) . go 0 + where + go n [] = return n + go n s = do + num <- readish s :: Maybe Integer + case dropWhile isDigit s of + (c:rest) -> do + u <- M.lookup c unitmap + go (n + num * u) rest + _ -> return $ n + num + parsefail = fail "duration parse error; expected eg \"5m\" or \"1h5m\"" + +fromDuration :: Duration -> String +fromDuration Duration { durationSeconds = d } + | d == 0 = "0s" + | otherwise = concatMap showunit $ take 2 $ go [] units d + where + showunit (u, n) = show n ++ [u] + go c [] _ = reverse c + go c ((u, n):us) v = + let (q,r) = v `quotRem` n + in if q > 0 + then go ((u, q):c) us r + else if null c + then go c us r + else reverse c + +units :: [(Char, Integer)] +units = + [ ('y', ysecs) + , ('d', dsecs) + , ('h', hsecs) + , ('m', msecs) + , ('s', 1) + ] + +unitmap :: M.Map Char Integer +unitmap = M.fromList units + +ysecs :: Integer +ysecs = dsecs * 365 + +dsecs :: Integer +dsecs = hsecs * 24 + +hsecs :: Integer +hsecs = msecs * 60 + +msecs :: Integer +msecs = 60 + +-- Durations cannot be negative. +instance Arbitrary Duration where + arbitrary = Duration <$> nonNegative arbitrary + +prop_duration_roundtrips :: Duration -> Bool +prop_duration_roundtrips d = parseDuration (fromDuration d) == Just d |