Add support for parsing weeks

source/library/Database/PostgreSQL/Simple/Interval/Unstable.hs

@@ -581,9 +581,7 @@ render x =
         <> " us"
 
 -- | Parses an interval. This is not a general purpose parser. It only supports
--- the formats that PostgreSQL generates. For example, it will fail to parse an
--- interval like @"1 week"@ because PostgreSQL never uses weeks when rendering
--- intervals.
+-- the formats that PostgreSQL generates.
 parse :: A.Parser Interval
 parse =
   -- Start with parsers that have non-empty prefixes, in order to avoid
@@ -636,6 +634,7 @@ parsePostgresVerbose = do
     flip A.sepBy " " $
       A.choice
         [ Years <$> A.signed A.decimal <* maybePlural " year",
+          Weeks <$> A.signed A.decimal <* maybePlural " week",
           Months <$> A.signed A.decimal <* maybePlural " mon",
           Days <$> A.signed A.decimal <* maybePlural " day",
           Hours <$> A.signed A.decimal <* maybePlural " hour",
@@ -652,6 +651,7 @@ parsePostgres = do
     flip A.sepBy " " $
       A.choice
         [ Years <$> A.signed A.decimal <* maybePlural " year",
+          Weeks <$> A.signed A.decimal <* maybePlural " week",
           Months <$> A.signed A.decimal <* maybePlural " mon",
           Days <$> A.signed A.decimal <* maybePlural " day"
         ]
@@ -688,6 +688,7 @@ maybePlural word = (<>) <$> A.string word <*> A.option "" "s"
 -- are accepted, like years and months.
 data Component
   = Years !Integer
+  | Weeks !Integer
   | Months !Integer
   | Days !Integer
   | Hours !Integer
@@ -701,6 +702,7 @@ data Component
 fromComponent :: Component -> Maybe Interval
 fromComponent c = case c of
   Years y -> fromYears =<< Bits.toIntegralSized y
+  Weeks w -> fromWeeks =<< Bits.toIntegralSized w
   Months m -> fromMonths <$> Bits.toIntegralSized m
   Days d -> fromDays <$> Bits.toIntegralSized d
   Hours h -> fromHours =<< Bits.toIntegralSized h
@@ -722,6 +724,7 @@ fromComponents =
 negateComponent :: Component -> Component
 negateComponent c = case c of
   Years y -> Years (-y)
+  Weeks w -> Weeks (-w)
   Months m -> Months (-m)
   Days d -> Days (-d)
   Hours h -> Hours (-h)

source/test-suite/Main.hs

@@ -402,6 +402,27 @@ spec = H.describe "Database.PostgreSQL.Simple.Interval" $ do
       let actual = Attoparsec.parseOnly I.parse "-infinity"
       actual `H.shouldBe` Right (I.MkInterval minBound minBound minBound)
 
+    H.describe "weeks" $ do
+      H.it "succeeds with zero" $ do
+        let actual = Attoparsec.parseOnly I.parse "0 weeks"
+        actual `H.shouldBe` Right (I.MkInterval 0 0 0)
+
+      H.it "succeeds with implicit positive" $ do
+        let actual = Attoparsec.parseOnly I.parse "1 week"
+        actual `H.shouldBe` Right (I.MkInterval 0 7 0)
+
+      H.it "succeeds with explicit positive" $ do
+        let actual = Attoparsec.parseOnly I.parse "+2 weeks"
+        actual `H.shouldBe` Right (I.MkInterval 0 14 0)
+
+      H.it "succeeds with negative" $ do
+        let actual = Attoparsec.parseOnly I.parse "-3 weeks"
+        actual `H.shouldBe` Right (I.MkInterval 0 (-21) 0)
+
+      H.it "succeeds with verbose" $ do
+        let actual = Attoparsec.parseOnly I.parse "@ 4 weeks"
+        actual `H.shouldBe` Right (I.MkInterval 0 28 0)
+
     Monad.forM_ intervalStyles $ \(_, field) ->
       Monad.forM_ examples $ \example -> do
         let input = field example