Time specifications

1 files changed, 16 insertions, 3 deletions

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"