1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
{- Time for humans.
-
- Copyright 2012-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Utility.HumanTime (
Duration(..),
durationToPOSIXTime,
parseDuration,
fromDuration,
prop_duration_roundtrips
) where
import Utility.PartialPrelude
import Utility.Applicative
import Utility.QuickCheck
import Data.Time.Clock.POSIX (POSIXTime)
import Data.Char
import Control.Applicative
import qualified Data.Map as M
newtype Duration = Duration { durationSeconds :: Integer }
deriving (Eq, Ord, Read, Show)
durationToPOSIXTime :: Duration -> POSIXTime
durationToPOSIXTime = fromIntegral . durationSeconds
{- Parses a human-input time duration, of the form "5h", "1m", "5h1m", etc -}
parseDuration :: String -> Maybe Duration
parseDuration = 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
fromDuration :: Duration -> String
fromDuration Duration { durationSeconds = d }
| d == 0 = "0s"
| otherwise = concat $ map showunit $ go [] units d
where
showunit (u, n)
| n > 0 = show n ++ [u]
| otherwise = ""
go c [] _ = reverse c
go c ((u, n):us) v =
let (q,r) = v `quotRem` n
in go ((u, q):c) us r
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
|
