4c58433c48
There's no instance for Either String, so that makes it not as useful as it could be, so instead just return an Either String.
104 lines
2.4 KiB
Haskell
104 lines
2.4 KiB
Haskell
{- 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 :: String -> Either String Duration
|
|
parseDuration d = maybe parsefail (Right . Duration) $ go 0 d
|
|
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 = Left $ "failed to parse duration \"" ++ d ++ "\" (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) == Right d
|