feat: add date parser

Author: drlkf

src/Text/Megaparsec/Time.hs

@@ -1,7 +1,8 @@
 {-# LANGUAGE FlexibleContexts #-}
 
 module Text.Megaparsec.Time
-  ( dayParser
+  ( dateParser
+  , dayParser
   , durationParser
   , hoursParser
   , minutesParser
@@ -19,13 +20,20 @@ import           Data.Time                 (DayOfWeek (..), NominalDiffTime,
                                             secondsToNominalDiffTime)
 import           Data.Void                 (Void)
 import           Text.Megaparsec           (Parsec, try)
-import           Text.Megaparsec.Char      (char, digitChar, space, string')
+import           Text.Megaparsec.Char      (char, digitChar, space, space1,
+                                            string')
 import           Text.Megaparsec.Utils     (posNumParser)
 
-dayParser :: Parsec Void String (Either Int DayOfWeek)
+type DayResult = Either Int DayOfWeek
+
+dateParser :: Parsec Void String (Maybe DayResult, TimeOfDay)
+dateParser = (,) <$> optional (try (dayParser <* space1)) <*> timeParser
+
+dayParser :: Parsec Void String DayResult
 dayParser = choice
   [ Right <$> shortDay
   , Right <$> longDay
+  , Left <$> (try (string' "yesterday") $> -1)
   , Left <$> (try (string' "tomorrow") $> 1)
   , Right <$> absoluteDay
   , Left <$> relativeDay

test/Text/Megaparsec/TimeSpec.hs

@@ -17,8 +17,9 @@ import           Test.Hspec           (Spec, context, describe, it, shouldBe,
 import           Test.QuickCheck      (Arbitrary (..), Gen, elements, forAll,
                                        property, suchThat)
 import           Text.Megaparsec      (Parsec, errorBundlePretty, runParser)
-import           Text.Megaparsec.Time (dayParser, durationParser, hoursParser,
-                                       minutesParser, secondsParser, timeParser)
+import           Text.Megaparsec.Time (dateParser, dayParser, durationParser,
+                                       hoursParser, minutesParser,
+                                       secondsParser, timeParser)
 import           Text.Printf          (printf)
 
 instance Arbitrary TimeOfDay where
@@ -45,6 +46,15 @@ parseOrPrettyError p = first errorBundlePretty . runParser p "test"
 
 spec :: Spec
 spec = do
+  describe "date" $ do
+    it "time only" $
+      parseOrPrettyError dateParser "11:03" `shouldBe`
+      Right (Nothing, TimeOfDay 11 3 0)
+
+    it "with day" $
+      parseOrPrettyError dateParser "yesterday 11:03" `shouldBe`
+      Right (Just (Left (-1)), TimeOfDay 11 3 0)
+
   describe "day" $ do
     let weekday d = d < Saturday
 
@@ -67,10 +77,10 @@ spec = do
 
     context "tomorrow" $ do
       it "capitalized" $
-        parseOrPrettyError dayParser "Tomorrow "`shouldBe` Right (Left 1)
+        parseOrPrettyError dayParser "Tomorrow" `shouldBe` Right (Left 1)
 
       it "lowercase" $
-        parseOrPrettyError dayParser "tomorrow "`shouldBe` Right (Left 1)
+        parseOrPrettyError dayParser "tomorrow" `shouldBe` Right (Left 1)
 
     it "future day" . forAll (abs <$> arbitrary) $ \x ->
       parseOrPrettyError dayParser (printf "+%d" x) `shouldBe` Right (Left x)