Data.Time.HTTP.Common now compiles.
authorPHO <pho@cielonegro.org>
Tue, 27 Sep 2011 15:56:54 +0000 (00:56 +0900)
committerPHO <pho@cielonegro.org>
Tue, 27 Sep 2011 16:10:50 +0000 (01:10 +0900)
Ditz-issue: 85eb4c20935bf29db052a35d75039c638817227b

Data/Time/HTTP/Common.hs
time-http.cabal

index e0a899e6c7e801d4dc4f18d601635aaab4dfa272..6a45805ed80be61aa996c7351554b7f82689b9d5 100644 (file)
@@ -1,4 +1,7 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE
+    OverloadedStrings
+  , UnicodeSyntax
+  #-}
 module Data.Time.HTTP.Common
     ( shortWeekDayName
     , shortWeekDayNameP
@@ -26,12 +29,22 @@ module Data.Time.HTTP.Common
     , assertTimeOfDayIsGood
     )
     where
+import Blaze.ByteString.Builder.ByteString as B
+import Blaze.Text.Int as BT
+import Control.Applicative
 import Control.Monad
+import Control.Monad.Unicode
+import Data.Ascii (AsciiBuilder)
+import qualified Data.Ascii as A
+import Data.Attoparsec.Char8 as P
+import Data.Monoid.Unicode
 import Data.Fixed
 import Data.Time
 import Data.Time.Calendar.WeekDate
+import Prelude.Unicode
 
-shortWeekDayName :: Int -> String
+shortWeekDayName ∷ Num n ⇒ n → String
+{-# INLINEABLE shortWeekDayName #-}
 shortWeekDayName 1 = "Mon"
 shortWeekDayName 2 = "Tue"
 shortWeekDayName 3 = "Wed"
@@ -39,24 +52,26 @@ shortWeekDayName 4 = "Thu"
 shortWeekDayName 5 = "Fri"
 shortWeekDayName 6 = "Sat"
 shortWeekDayName 7 = "Sun"
-shortWeekDayName n = error ("shortWeekDayName: unknown day number: " ++ show n)
+shortWeekDayName n = error ("shortWeekDayName: invalid week day: " ⧺ show n)
 
-shortWeekDayNameP :: Stream s m Char => ParsecT s u m Int
+shortWeekDayNameP ∷ Num n ⇒ Parser n
+{-# INLINEABLE shortWeekDayNameP #-}
 shortWeekDayNameP
-    = choice [ string "Mon" >> return 1
+    = choice [ string "Mon"  return 1
              , char 'T'
-               >> choice [ string "ue" >> return 2
-                         , string "hu" >> return 4
-                         ]
-             , string "Wed" >> return 3
-             , string "Fri" >> return 5
+               ≫ choice [ string "ue" ≫ return 2
+                        , string "hu" ≫ return 4
+                        ]
+             , string "Wed"  return 3
+             , string "Fri"  return 5
              , char 'S'
-               >> choice [ string "at" >> return 6
-                         , string "un" >> return 7
-                         ]
+               ≫ choice [ string "at" ≫ return 6
+                        , string "un" ≫ return 7
+                        ]
              ]
 
-longWeekDayName :: Int -> String
+longWeekDayName ∷ Num n ⇒ n → String
+{-# INLINEABLE longWeekDayName #-}
 longWeekDayName 1 = "Monday"
 longWeekDayName 2 = "Tuesday"
 longWeekDayName 3 = "Wednesday"
@@ -64,23 +79,26 @@ longWeekDayName 4 = "Thursday"
 longWeekDayName 5 = "Friday"
 longWeekDayName 6 = "Saturday"
 longWeekDayName 7 = "Sunday"
+longWeekDayName n = error ("longWeekDayName: invalid week day: " ⧺ show n)
 
-longWeekDayNameP :: Stream s m Char => ParsecT s u m Int
+longWeekDayNameP ∷ Num n ⇒ Parser n
+{-# INLINEABLE longWeekDayNameP #-}
 longWeekDayNameP
-    = choice [ string "Monday" >> return 1
+    = choice [ string "Monday"  return 1
              , char 'T'
-               >> choice [ string "uesday"  >> return 2
-                         , string "hursday" >> return 4
-                         ]
-             , string "Wednesday" >> return 3
-             , string "Friday"    >> return 5
+               ≫ choice [ string "uesday"  ≫ return 2
+                        , string "hursday" ≫ return 4
+                        ]
+             , string "Wednesday"  return 3
+             , string "Friday"     return 5
              , char 'S'
-               >> choice [ string "aturday" >> return 6
-                         , string "unday"   >> return 7
-                         ]
+               ≫ choice [ string "aturday" ≫ return 6
+                        , string "unday"   ≫ return 7
+                        ]
              ]
 
-shortMonthName :: Int -> String
+shortMonthName ∷ Num n ⇒ n → String
+{-# INLINEABLE shortMonthName #-}
 shortMonthName  1 = "Jan"
 shortMonthName  2 = "Feb"
 shortMonthName  3 = "Mar"
@@ -93,33 +111,35 @@ shortMonthName  9 = "Sep"
 shortMonthName 10 = "Oct"
 shortMonthName 11 = "Nov"
 shortMonthName 12 = "Dec"
-shortMonthName  n = error ("shortMonthName: unknown month number: " ++ show n)
+shortMonthName  n = error ("shortMonthName: invalid month: " ⧺ show n)
 
-shortMonthNameP :: Stream s m Char => ParsecT s u m Int
+shortMonthNameP ∷ Num n ⇒ Parser n
+{-# INLINEABLE shortMonthNameP #-}
 shortMonthNameP
     = choice [ char 'J'
-               >> choice [ string "an" >> return 1
-                         , char 'u'
-                           >> choice [ char 'n' >> return 6
-                                     , char 'l' >> return 7
-                                     ]
-                         ]
-             , string "Feb" >> return 2
+               ≫ choice [ string "an" ≫ return 1
+                        , char 'u'
+                          ≫ choice [ char 'n' ≫ return 6
+                                   , char 'l' ≫ return 7
+                                   ]
+                        ]
+             , string "Feb"  return 2
              , string "Ma"
-               >> choice [ char 'r' >> return 3
-                         , char 'y' >> return 5
-                         ]
+               ≫ choice [ char 'r' ≫ return 3
+                        , char 'y' ≫ return 5
+                        ]
              , char 'A'
-               >> choice [ string "pr" >> return 4
-                         , string "ug" >> return 8
-                         ]
-             , string "Sep" >> return 9
-             , string "Oct" >> return 10
-             , string "Nov" >> return 11
-             , string "Dec" >> return 12
+               ≫ choice [ string "pr" ≫ return 4
+                        , string "ug" ≫ return 8
+                        ]
+             , string "Sep"  return 9
+             , string "Oct"  return 10
+             , string "Nov"  return 11
+             , string "Dec"  return 12
              ]
 
-longMonthName :: Int -> String
+longMonthName ∷ Num n ⇒ n → String
+{-# INLINEABLE longMonthName #-}
 longMonthName  1 = "January"
 longMonthName  2 = "February"
 longMonthName  3 = "March"
@@ -132,62 +152,70 @@ longMonthName  9 = "September"
 longMonthName 10 = "October"
 longMonthName 11 = "November"
 longMonthName 12 = "December"
-longMonthName  n = error ("longMonthName: unknown month number: " ++ show n)
+longMonthName  n = error ("longMonthName: invalid month: " ⧺ show n)
 
-longMonthNameP :: Stream s m Char => ParsecT s u m Int
+longMonthNameP ∷ Num n ⇒ Parser n
+{-# INLINEABLE longMonthNameP #-}
 longMonthNameP
     = choice [ char 'J'
-               >> choice [ string "anuary" >> return 1
-                         , char 'u'
-                           >> choice [ string "ne" >> return 6
-                                     , string "ly" >> return 7
-                                     ]
-                         ]
-             , string "February" >> return 2
+               ≫ choice [ string "anuary" ≫ return 1
+                        , char 'u'
+                          ≫ choice [ string "ne" ≫ return 6
+                                   , string "ly" ≫ return 7
+                                   ]
+                        ]
+             , string "February"  return 2
              , string "Ma"
-               >> choice [ string "rch" >> return 3
-                         , char 'y' >> return 5
-                         ]
+               ≫ choice [ string "rch" ≫ return 3
+                        , char 'y' ≫ return 5
+                        ]
              , char 'A'
-               >> choice [ string "pril" >> return 4
-                         , string "ugust" >> return 8
-                         ]
-             , string "September" >> return 9
-             , string "October"   >> return 10
-             , string "November"  >> return 11
-             , string "December"  >> return 12
+               ≫ choice [ string "pril" ≫ return 4
+                        , string "ugust" ≫ return 8
+                        ]
+             , string "September"  return 9
+             , string "October"    return 10
+             , string "November"   return 11
+             , string "December"   return 12
              ]
 
-show4 :: Integral i => i -> String
-show4 i
-    | i >= 0 && i < 10    = "000" ++ show i
-    | i >= 0 && i < 100   = "00"  ++ show i
-    | i >= 0 && i < 1000  = '0'    : show i
-    | i >= 0 && i < 10000 = show i
-    | otherwise          = error ("show4: the integer i must satisfy 0 <= i < 10000: " ++ show i)
+show4 ∷ Integral i ⇒ i → AsciiBuilder
+{-# INLINE show4 #-}
+show4 = A.unsafeFromBuilder ∘ go
+    where
+      {-# INLINEABLE go #-}
+      go i | i ≥ 0 ∧ i < 10    = B.fromByteString "000" ⊕ BT.digit    i
+           | i ≥ 0 ∧ i < 100   = B.fromByteString "00"  ⊕ BT.integral i
+           | i ≥ 0 ∧ i < 1000  = B.fromByteString "0"   ⊕ BT.integral i
+           | i ≥ 0 ∧ i < 10000 =                          BT.integral i
+           | otherwise         = error ("show4: the integer i must satisfy 0 <= i < 10000: " ⧺ show i)
 
-show2 :: Integral i => i -> String
-show2 i
-    | i >= 0 && i < 10  = '0' : show i
-    | i >= 0 && i < 100 = show 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 "0" ⊕ BT.digit    i
+           | i ≥ 0 ∧ i < 100 =                        BT.integral i
+           | otherwise       = error ("show2: the integer i must satisfy 0 <= i < 100: " ⧺ show i)
 
-read4 :: (Stream s m Char, Num n) => ParsecT s u m n
-read4 = do n1 <- digit'
-           n2 <- digit'
-           n3 <- digit'
-           n4 <- digit'
+read4 ∷ Num n ⇒ Parser n
+{-# INLINEABLE read4 #-}
+read4 = do n1 ← digit'
+           n2 ← digit'
+           n3 ← digit'
+           n4 ← digit'
            return (n1 * 1000 + n2 * 100 + n3 * 10 + n4)
 
-read2 :: (Stream s m Char, Num n) => ParsecT s u m n
-read2 = do n1 <- digit'
-           n2 <- digit'
+read2 ∷ Num n ⇒ Parser n
+{-# INLINEABLE read2 #-}
+read2 = do n1 ← digit'
+           n2 ← digit'
            return (n1 * 10 + n2)
 
-digit' :: (Stream s m Char, Num n) => ParsecT s u m n
-digit' = liftM fromC digit
+digit' ∷ Num n ⇒ Parser n
+digit' = fromC <$> P.digit
 
-fromC :: Num n => Char -> n
+fromC ∷ Num n ⇒ Char → n
 fromC '0' = 0
 fromC '1' = 1
 fromC '2' = 2
@@ -200,25 +228,25 @@ fromC '8' = 8
 fromC '9' = 9
 fromC _   = undefined
 
-show4digitsTZ :: TimeZone -> String
+show4digitsTZ ∷ TimeZone → AsciiBuilder
 show4digitsTZ tz
     = case timeZoneMinutes tz of
-        offset | offset <  0 -> '-' : showTZ' (negate offset)
-               | otherwise   -> '+' : showTZ' offset
+        offset | offset <  0 → A.toAsciiBuilder "-" ⊕ showTZ' (negate offset)
+               | otherwise   → A.toAsciiBuilder "+" ⊕ showTZ' offset
     where
       showTZ' offset
           = let h = offset `div` 60
                 m = offset - h * 60
             in
-              show2 h ++ show2 m
+              show2 h  show2 m
 
-read4digitsTZ :: Stream s m Char => ParsecT s u m TimeZone
+read4digitsTZ ∷ Parser TimeZone
 read4digitsTZ
-    = do sign   <- (char '+' >> return 1)
-                   <|>
-                   (char '-' >> return (-1))
-         hour   <- read2
-         minute <- read2
+    = do sign   ← (char '+' ≫ return 1)
+                  <|>
+                  (char '-' ≫ return (-1))
+         hour    read2
+         minute  read2
          let tz = TimeZone {
                     timeZoneMinutes    = sign * (hour * 60 + minute)
                   , timeZoneSummerOnly = False
@@ -226,49 +254,52 @@ read4digitsTZ
                   }
          return tz
 
-assertWeekDayIsGood :: Stream s m t => Int -> Day -> ParsecT s u m ()
+assertWeekDayIsGood ∷ Monad m ⇒ Int → Day → m ()
+{-# INLINEABLE assertWeekDayIsGood #-}
 assertWeekDayIsGood givenWD gregDay
     = let (_, _, correctWD ) = toWeekDate  gregDay
           (year, month, day) = toGregorian gregDay
       in
-        unless (givenWD == correctWD)
-                   $ fail
-                   $ concat [ "Gregorian day "
+        unless (givenWD ≡ correctWD)
+            $ fail
+            $ concat [ "Gregorian day "
+                     , show year
+                     , "-"
+                     , show month
+                     , "-"
+                     , show day
+                     , " is "
+                     , longWeekDayName correctWD
+                     , ", not "
+                     , longWeekDayName givenWD
+                     ]
+
+assertGregorianDateIsGood ∷ Monad m ⇒ Integer → Int → Int → m Day
+{-# INLINEABLE assertGregorianDateIsGood #-}
+assertGregorianDateIsGood year month day
+    = case fromGregorianValid year month day of
+        Nothing
+            → fail $ concat [ "Invalid gregorian day: "
                             , show year
                             , "-"
                             , show month
                             , "-"
                             , show day
-                            , " is "
-                            , longWeekDayName correctWD
-                            , ", not "
-                            , longWeekDayName givenWD
                             ]
-
-assertGregorianDateIsGood :: Stream s m t => Integer -> Int -> Int -> ParsecT s u m Day
-assertGregorianDateIsGood year month day
-    = case fromGregorianValid year month day of
-        Nothing
-            -> fail $ concat [ "Invalid gregorian day: "
-                             , show year
-                             , "-"
-                             , show month
-                             , "-"
-                             , show day
-                             ]
         Just gregDay
-            -> return gregDay
+             return gregDay
 
-assertTimeOfDayIsGood :: Stream s m t => Int -> Int -> Pico -> ParsecT s u m TimeOfDay
+assertTimeOfDayIsGood ∷ Monad m ⇒ Int → Int → Pico → m TimeOfDay
+{-# INLINEABLE assertTimeOfDayIsGood #-}
 assertTimeOfDayIsGood hour minute second
     = case makeTimeOfDayValid hour minute second of
         Nothing
-            -> fail $ concat [ "Invalid time of day: "
-                             , show hour
-                             , ":"
-                             , show minute
-                             , ":"
-                             , showFixed True second
-                             ]
+             fail $ concat [ "Invalid time of day: "
+                            , show hour
+                            , ":"
+                            , show minute
+                            , ":"
+                            , showFixed True second
+                            ]
         Just tod
-            -> return tod
+             return tod
index f22e117cbc2d7322482c8fbc1174fdae7b37f67e..f708239a1ee651b18bc3a1b178486842aa9c8e5e 100644 (file)
@@ -38,8 +38,10 @@ Library
 
     Build-depends:
         ascii                == 0.0.*,
+        blaze-builder        == 0.3.*,
+        blaze-textual        == 0.2.*,
         attoparsec           == 0.9.*,
-        base                 == 4.3.*,
+        base                 == 4.*,
         base-unicode-symbols == 0.2.*,
         time                 == 1.2.*