summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
Diffstat (limited to 'Utility')
-rw-r--r--Utility/HumanTime.hs74
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