Tests for Data.Time.Asctime
authorPHO <pho@cielonegro.org>
Wed, 28 Sep 2011 16:36:52 +0000 (01:36 +0900)
committerPHO <pho@cielonegro.org>
Wed, 28 Sep 2011 16:36:52 +0000 (01:36 +0900)
Ditz-issue: c8c594f249504e28212f18a8a5c6b8a708b99f79

Data/Time/Asctime.hs
Data/Time/Asctime/Internal.hs
Data/Time/HTTP/Common.hs
GNUmakefile
Test/Time/HTTP.hs
time-http.cabal

index 449fb12c9d5f339f43be966388591463e67612cb..0814e451f9f0f82e37f849da656740adb0e09103 100644 (file)
@@ -5,7 +5,7 @@
 --
 -- ANSI C's asctime() format looks like:
 --
--- @Wdy Mon DD HH:MM:SS YYYY@
+-- @Wdy Mon [D]D HH:MM:SS YYYY@
 --
 -- The exact syntax is as follows:
 --
@@ -15,7 +15,7 @@
 -- > month     ::= "Jan" | "Feb" | "Mar" | "Apr"
 -- >             | "May" | "Jun" | "Jul" | "Aug"
 -- >             | "Sep" | "Oct" | "Nov" | "Dec"
--- > day       ::= 2DIGIT
+-- > day       ::= 2DIGIT | SP 1DIGIT
 -- > time      ::= 2DIGIT ':' 2DIGIT [':' 2DIGIT]
 -- > year      ::= 4DIGIT
 --
index f7077596c0a1d7e9a36b1ed642ade35344896d43..1681fc0d281752af5a66775c159fa6923230baa5 100644 (file)
@@ -19,10 +19,10 @@ import Data.Time.HTTP.Common
 -- |Parse an ANSI C's @asctime()@ string.
 asctime ∷ Parser LocalTime
 asctime = do weekDay ← shortWeekDayNameP
-             _       ← string ", "
+             _       ← char ' '
              month   ← shortMonthNameP
              _       ← char ' '
-             day     ← read2
+             day     ← read2'
              _       ← char ' '
              hour    ← read2
              _       ← char ':'
@@ -46,10 +46,10 @@ toAsciiBuilder localTime
           timeOfDay          = localTimeOfDay localTime
       in
         shortWeekDayName week
-        ⊕ A.toAsciiBuilder " "
+        ⊕ A.toAsciiBuilder " "
         ⊕ shortMonthName month
         ⊕ A.toAsciiBuilder " "
-        ⊕ show2 day
+        ⊕ show2' day
         ⊕ A.toAsciiBuilder " "
         ⊕ show2 (todHour timeOfDay)
         ⊕ A.toAsciiBuilder ":"
index cf5412c28b093eca5844e8286cec529f78f4a6e8..1cfa89e9c63528268d721d309927dc58f981f586 100644 (file)
@@ -15,11 +15,13 @@ module Data.Time.HTTP.Common
     , longMonthName
     , longMonthNameP
 
-    , show2
     , show4
+    , show2
+    , show2'
 
-    , read2
     , read4
+    , read2
+    , read2'
 
     , show4digitsTZ
     , read4digitsTZ
@@ -211,6 +213,14 @@ show2 = A.unsafeFromBuilder ∘ go
            | i ≥ 0 ∧ i < 100 =                        BT.integral i
            | otherwise       = error ("show2: the integer i must satisfy 0 <= i < 100: " ⧺ show i)
 
+show2' ∷ Integral i ⇒ i → AsciiBuilder
+{-# INLINE show2' #-}
+show2' = A.unsafeFromBuilder ∘ go
+    where
+      go i | i ≥ 0 ∧ i < 10  = B.fromByteString " " ⊕ BT.digit    i
+           | i ≥ 0 ∧ i < 100 =                        BT.integral i
+           | otherwise       = error ("show2': the integer i must satisfy 0 <= i < 100: " ⧺ show i)
+
 read4 ∷ Num n ⇒ Parser n
 {-# INLINEABLE read4 #-}
 read4 = do n1 ← digit'
@@ -225,6 +235,12 @@ read2 = do n1 ← digit'
            n2 ← digit'
            return (n1 * 10 + n2)
 
+read2' ∷ Num n ⇒ Parser n
+{-# INLINEABLE read2' #-}
+read2' = do n1 ← (char ' ' *> pure 0) <|> digit'
+            n2 ← digit'
+            return (n1 * 10 + n2)
+
 digit' ∷ Num n ⇒ Parser n
 digit' = fromC <$> P.digit
 
index 6473d6fc419f0a1442242a2c13e9700aedfe54ae..b51a53dc121c4bd0f2cf10c2a1002e8a82b97d05 100644 (file)
@@ -1,3 +1,4 @@
 CONFIGURE_ARGS = -O2 --enable-tests
+RUN_COMMAND = time ./dist/build/test-time-http/test-time-http
 
 include cabal-package.mk
index 97c5da85f429b954ed5ae4b74c831dac48212779..bb60928a75da1497e8c74fee3dc4c08bb231bd38 100644 (file)
@@ -1,8 +1,15 @@
 {-# LANGUAGE
-    UnicodeSyntax
+    OverloadedStrings
+  , UnicodeSyntax
+  , ViewPatterns
   #-}
 module Main (main) where
+import Control.Applicative
+import Control.Applicative.Unicode
+import Data.Time
+import qualified Data.Time.Asctime as Asctime
 import System.Exit
+import Prelude.Unicode
 import Test.QuickCheck
 
 main ∷ IO ()
@@ -17,6 +24,24 @@ runTest prop
            Failure {}           → exitFailure
            NoExpectedFailure {} → exitFailure
 
+instance Arbitrary Day where
+    arbitrary = ModifiedJulianDay <$> arbitrary
+
+instance Arbitrary TimeOfDay where
+    arbitrary
+        = do h ← choose (0, 23)
+             m ← choose (0, 59)
+             s ← choose (0, 60)
+             return $ TimeOfDay h m (fromIntegral (s ∷ Int))
+
+instance Arbitrary LocalTime where
+    arbitrary = LocalTime <$> arbitrary ⊛ arbitrary
+
 tests ∷ [Property]
-tests = [
+tests = [ -- Asctime
+          property ( Asctime.fromAscii "Sun Nov  6 08:49:37 1994"
+                     ≡ Right (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)) )
+        , property ( Asctime.toAscii (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37))
+                     ≡ "Sun Nov  6 08:49:37 1994" )
+        , property $ \lt → Right lt ≡ Asctime.fromAscii (Asctime.toAscii lt)
         ]
index 75b99042247c408784bb383f33219fd3ae8a4e08..d8c1c2a13df6239b7c7bd7d9998fffd560a96665 100644 (file)
@@ -42,9 +42,9 @@ Library
 
     Build-depends:
         ascii                == 0.0.*,
+        attoparsec           == 0.9.*,
         blaze-builder        == 0.3.*,
         blaze-textual        == 0.2.*,
-        attoparsec           == 0.9.*,
         base                 == 4.*,
         base-unicode-symbols == 0.2.*,
         time                 == 1.2.*
@@ -62,9 +62,9 @@ Test-Suite test-time-http
     Build-depends:
         QuickCheck           == 2.4.*,
         ascii                == 0.0.*,
+        attoparsec           == 0.9.*,
         blaze-builder        == 0.3.*,
         blaze-textual        == 0.2.*,
-        attoparsec           == 0.9.*,
         base                 == 4.*,
         base-unicode-symbols == 0.2.*,
         time                 == 1.2.*