aboutsummaryrefslogtreecommitdiff
path: root/Utility/HumanTime.hs
blob: 644e6fbabfbea1fd8797cc9c3b2000c3e6ac5745 (plain)
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