better time display
This commit is contained in:
parent
e9745f2da2
commit
e36da0e5ad
1 changed files with 28 additions and 4 deletions
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue