better time display

This commit is contained in:
Joey Hess 2013-10-11 00:29:28 -04:00
parent e9745f2da2
commit e36da0e5ad

View file

@ -12,6 +12,10 @@ module Utility.Scheduled (
NextTime(..), NextTime(..),
nextTime, nextTime,
fromSchedule, fromSchedule,
fromScheduledTime,
toScheduledTime,
fromRecurrance,
toRecurrance,
toSchedule, toSchedule,
parseSchedule, parseSchedule,
prop_schedule_roundtrips prop_schedule_roundtrips
@ -26,6 +30,7 @@ import Data.Time.Calendar
import Data.Time.Calendar.WeekDate import Data.Time.Calendar.WeekDate
import Data.Time.Calendar.OrdinalDate import Data.Time.Calendar.OrdinalDate
import Data.Tuple.Utils import Data.Tuple.Utils
import Data.Char
{- Some sort of scheduled event. -} {- Some sort of scheduled event. -}
data Schedule = Schedule Recurrance ScheduledTime data Schedule = Schedule Recurrance ScheduledTime
@ -185,15 +190,34 @@ toRecurrance s = case words s of
fromScheduledTime :: ScheduledTime -> String fromScheduledTime :: ScheduledTime -> String
fromScheduledTime AnyTime = "any time" fromScheduledTime AnyTime = "any time"
fromScheduledTime (SpecificTime h m) = show h ++ ":" ++ pad 2 (show m) fromScheduledTime (SpecificTime h m) =
show h' ++ (if m > 0 then ":" ++ pad 2 (show m) else "") ++ " " ++ ampm
where where
pad n s = take (n - length s) (repeat '0') ++ s pad n s = take (n - length s) (repeat '0') ++ s
(h', ampm)
| h == 0 = (12, "AM")
| h < 12 = (h, "AM")
| h == 12 = (h, "PM")
| otherwise = (h - 12, "PM")
toScheduledTime :: String -> Maybe ScheduledTime toScheduledTime :: String -> Maybe ScheduledTime
toScheduledTime "any time" = Just AnyTime toScheduledTime "any time" = Just AnyTime
toScheduledTime s = toScheduledTime v = case words v of
let (h, m) = separate (== ':') s (s:ampm:[])
in SpecificTime <$> readish h <*> readish m | map toUpper ampm == "AM" ->
go s (\h -> if h == 12 then 0 else h)
| map toUpper ampm == "PM" ->
go s (+ 12)
| otherwise -> Nothing
(s:[]) -> go s id
_ -> Nothing
where
go :: String -> (Int -> Int) -> Maybe ScheduledTime
go s adjust =
let (h, m) = separate (== ':') s
in SpecificTime
<$> (adjust <$> readish h)
<*> if null m then Just 0 else readish m
fromSchedule :: Schedule -> String fromSchedule :: Schedule -> String
fromSchedule (Schedule recurrance scheduledtime) = unwords fromSchedule (Schedule recurrance scheduledtime) = unwords