From 3dc71afee7b4efc214e159176e380182ac5141dd Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 16 Feb 2017 19:13:32 +0100 Subject: Time specifications --- lib/Postdelay/TimeSpec.hs | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) (limited to 'lib/Postdelay/TimeSpec.hs') diff --git a/lib/Postdelay/TimeSpec.hs b/lib/Postdelay/TimeSpec.hs index edd70c1..f84a196 100644 --- a/lib/Postdelay/TimeSpec.hs +++ b/lib/Postdelay/TimeSpec.hs @@ -64,11 +64,24 @@ timeOfDay = label "Time of day" $ shiftBack (1 % Day) . assign time <$> choice , TimeOfDay 12 0 0 <$ string' "noon" , TimeOfDay 16 0 0 <$ string' "teatime" , try $ do - h <- boundedNatural True $ 0 <=..<= 24 - m <- boundedNatural True $ 0 <=..<= 59 - s <- option 0 $ boundedRational True $ 0 <=..< 61 + h <- hour24 True + m <- minute True + s <- option 0 $ second True return $ TimeOfDay h m s + , try $ do + h <- hour12 False + m <- option 0 $ char ':' *> minute False + s <- option 0 $ char ':' *> second False + spaceConsumer + amPm <- (0 <$ string' "am") <|> (12 <$ string' "pm") + return $ TimeOfDay (h + amPm) m s ] + where + hour12 pad = label "Modulus 12 hour" . fmap (flip mod 12) . boundedNatural pad $ 1 <=..<= 12 + hour24 pad = label "Modulus 24 hour" . boundedNatural pad $ 0 <=..< 24 + minute pad = label "Minute" . boundedNatural pad $ 0 <=..< 60 + second pad = label "Second" . boundedRational pad $ 0 <=..< 61 + dateSpec = label "Date" $ (date <~) <$> choice [ view date <$ string' "today" , views date succ <$ string' "tomorrow" -- cgit v1.2.3