instance Read CalendarDiffDays
authorAshley Yakeley <ashley@semantic.org>
Mon, 15 Jan 2018 07:40:53 +0000 (23:40 -0800)
committerAshley Yakeley <ashley@semantic.org>
Mon, 15 Jan 2018 07:40:53 +0000 (23:40 -0800)
lib/Data/Time/Calendar/CalendarDiffDays.hs
test/main/Test/Arbitrary.hs
test/main/Test/Calendar/Duration.hs

index 7d68cdb..bf4fa10 100644 (file)
@@ -10,9 +10,12 @@ import Data.Monoid
 #endif
 
 #if MIN_VERSION_base(4,9,0)
-import Data.Semigroup
+import Data.Semigroup hiding (option)
 #endif
 
+import Data.Char
+import Text.ParserCombinators.ReadP hiding (string)
+
 data CalendarDiffDays = CalendarDiffDays
     { calendarMonths :: Integer
     , calendarDays :: Integer
@@ -42,6 +45,30 @@ instance Show CalendarDiffDays where
         ds = if d == 0 then "" else show d ++ "D"
         in if dur == mempty then "P0D" else "P" ++ ys ++ ms ++ ds
 
+instance Read CalendarDiffDays where
+    readsPrec _ = readParen False $ readP_to_S $ skipSpaces >> do
+        let
+            ch :: Char -> ReadP ()
+            ch c = char c >> return ()
+
+            readInteger :: ReadP Integer
+            readInteger = do
+                neg <- option False $ ch '-' >> return True
+                digits <- many1 (satisfy isDigit)
+                return $ (if neg then negate else id) $ read digits
+
+            readItem :: Char -> ReadP Integer
+            readItem c = option 0 $ do
+                i <- readInteger
+                ch c
+                return i
+        ch 'P'
+        y <- readItem 'Y'
+        m <- readItem 'M'
+        w <- readItem 'W'
+        d <- readItem 'D'
+        return $ CalendarDiffDays (y * 12 + m) (w * 7 + d)
+
 calendarDay :: CalendarDiffDays
 calendarDay = CalendarDiffDays 0 1
 
index 8896b3a..746120c 100644 (file)
@@ -31,6 +31,9 @@ instance Arbitrary Day where
 instance CoArbitrary Day where
     coarbitrary (ModifiedJulianDay d) = coarbitrary d
 
+instance Arbitrary CalendarDiffDays where
+    arbitrary = liftM2 CalendarDiffDays arbitrary arbitrary
+
 instance Arbitrary DiffTime where
     arbitrary = oneof [intSecs, fracSecs] -- up to 1 leap second
       where
index 8b8938d..aec769d 100644 (file)
@@ -42,5 +42,8 @@ testDiffs =
         , testClip (2017, 02, 01) (2017, 04, 07) (-2, -6)
         ]
 
+testReadShow :: TestTree
+testReadShow = testProperty "read . show" $ \(t :: CalendarDiffDays) -> read (show t) == t
+
 testDuration :: TestTree
-testDuration = testGroup "CalendarDiffDays" [testAddDiff, testDiffs]
+testDuration = testGroup "CalendarDiffDays" [testAddDiff, testDiffs, testReadShow]