expand with a fromDuration and support for mixed unit durations

1 files changed, 60 insertions, 14 deletions

diff --git a/Utility/HumanTime.hs b/Utility/HumanTime.hs
index 038d1228e..9edc8df53 100644
--- a/Utility/HumanTime.hs
+++ b/Utility/HumanTime.hs
@@ -1,26 +1,72 @@
 {- Time for humans.
  -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Utility.HumanTime where
+module Utility.HumanTime (
+	Duration(..),
+	durationToPOSIXTime,
+	parseDuration,
+	fromDuration,
+) where
 
 import Utility.PartialPrelude
+import Utility.Applicative
 
 import Data.Time.Clock.POSIX (POSIXTime)
+import Data.Char
+import qualified Data.Map as M
 
-{- Parses a human-input time duration, of the form "5h" or "1m". -}
-parseDuration :: String -> Maybe POSIXTime
-parseDuration s = do
-	num <- readish s :: Maybe Integer
-	units <- findUnits =<< lastMaybe s
-	return $ fromIntegral num * units
+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
-	findUnits 's' = Just 1
-	findUnits 'm' = Just 60
-	findUnits 'h' = Just $ 60 * 60
-	findUnits 'd' = Just $ 60 * 60 * 24
-	findUnits 'y' = Just $ 60 * 60 * 24 * 365
-	findUnits _ = Nothing
+  	go n [] = return n
+  	go n s = do
+		num <- readish s :: Maybe Integer
+		let (c:rest) = dropWhile isDigit s
+		u <- M.lookup c unitmap
+		go (n + num * u) rest
+
+fromDuration :: Duration -> String
+fromDuration = concat . map showunit . go [] units . durationSeconds
+  where
+	showunit (u, n)
+		| n > 0 = show n ++ [u]
+		| otherwise = ""
+	go c [] _ = reverse c
+	go c ((u, n):us) d =
+		let (q,r) = d `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