Doc fix, optimization, and more.

[Lucu.git] / Network / HTTP / Lucu / Parser / Http.hs

diff --git a/Network/HTTP/Lucu/Parser/Http.hs b/Network/HTTP/Lucu/Parser/Http.hs
index cb21d299418671fccfe308d13a6befe3f75ed9be..a5dfbd90677853038f2a3ee10e8799f3978adf91 100644 (file)
--- a/Network/HTTP/Lucu/Parser/Http.hs
+++ b/Network/HTTP/Lucu/Parser/Http.hs
@@ -13,20 +13,22 @@ module Network.HTTP.Lucu.Parser.Http
     , text
     , separator
     , quotedStr
+    , qvalue
     )
     where
 
 import           Data.List
 import           Network.HTTP.Lucu.Parser
 
--- |@'isCtl' c@ is True iff @0x20 <= @c@ < 0x7F@.
+-- |@'isCtl' c@ is 'Prelude.False' iff @0x20 <= @c@ < 0x7F@.
 isCtl :: Char -> Bool
 isCtl c
     | c <  '\x1f' = True
     | c >= '\x7f' = True
     | otherwise   = False
 
--- |@'isSeparator' c@ is True iff c is one of HTTP separators.
+-- |@'isSeparator' c@ is 'Prelude.True' iff c is one of HTTP
+-- separators.
 isSeparator :: Char -> Bool
 isSeparator '('  = True
 isSeparator ')'  = True
@@ -49,7 +51,7 @@ isSeparator ' '  = True
 isSeparator '\t' = True
 isSeparator _    = False
 
--- |@'isChar' c@ is True iff @c <= 0x7f@.
+-- |@'isChar' c@ is 'Prelude.True' iff @c <= 0x7f@.
 isChar :: Char -> Bool
 isChar c
     | c <= '\x7f' = True
@@ -105,3 +107,19 @@ quotedStr = do char '"'
       quotedPair = do q <- char '\\'
                       c <- satisfy isChar
                       return [c]
+
+-- |'qvalue' accepts a so-called qvalue.
+qvalue :: Parser Double
+qvalue = do x  <- char '0'
+            xs <- option ""
+                  $ do x  <- char '.'
+                       xs <- many digit -- 本當は三文字までに制限
+                       return (x:xs)
+            return $ read (x:xs)
+         <|>
+         do x  <- char '1'
+            xs <- option ""
+                  $ do x  <- char '.'
+                       xs <- many (char '0') -- 本當は三文字までに制限
+                       return (x:xs)
+            return $ read (x:xs)