X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FFormat.hs;h=42508b92e849b2f720cffbac7e02acc4ef9293b1;hb=5477896;hp=26319b737391e238f6e5c90ab1d9209054efa796;hpb=858129cb755aa09da2b7bd758efb8519f2c89103;p=Lucu.git diff --git a/Network/HTTP/Lucu/Format.hs b/Network/HTTP/Lucu/Format.hs index 26319b7..42508b9 100644 --- a/Network/HTTP/Lucu/Format.hs +++ b/Network/HTTP/Lucu/Format.hs @@ -1,8 +1,11 @@ --- #hide - +{-# LANGUAGE + OverloadedStrings + , ScopedTypeVariables + , UnboxedTuples + , UnicodeSyntax + #-} -- 本當にこんなものを自分で書く必要があったのだらうか。Printf は重いの -- で駄目だが、それ以外のモジュールを探しても見付からなかった。 - module Network.HTTP.Lucu.Format ( fmtInt @@ -10,119 +13,108 @@ module Network.HTTP.Lucu.Format , fmtHex ) where - - -fmtInt :: Int -> Bool -> Int -> Char -> Bool -> Int -> String -fmtInt base upperCase minWidth pad forceSign n - = base `seq` minWidth `seq` pad `seq` forceSign `seq` n `seq` - let raw = reverse $! fmt' (abs n) - sign = if forceSign || n < 0 then - if n < 0 then "-" else "+" - else - "" - padded = padStr (minWidth - length sign) pad raw +import qualified Blaze.ByteString.Builder.Char8 as BC +import Data.Ascii (AsciiBuilder) +import qualified Data.ByteString.Char8 as BS +import qualified Data.Ascii as A +import Data.Char +import Data.Monoid.Unicode +import Prelude.Unicode + +fmtInt ∷ ∀n. Integral n ⇒ n → Int → n → AsciiBuilder +{-# INLINEABLE fmtInt #-} +fmtInt base minWidth n + = let (# raw, len #) = fmt' (abs n) (∅) 0 in - sign ++ padded + if n < 0 then + ( A.toAsciiBuilder "-" ⊕ + mkPad (minWidth - 1) len ⊕ + raw + ) + else + mkPad minWidth len ⊕ raw where - fmt' :: Int -> String - fmt' n - | n < base = (intToChar upperCase n) : [] - | otherwise = (intToChar upperCase $! n `mod` base) : fmt' (n `div` base) - - -fmtDec :: Int -> Int -> String + fmt' ∷ n → AsciiBuilder → Int → (# AsciiBuilder, Int #) + {-# INLINEABLE fmt' #-} + fmt' x b len + | x < base + = let b' = b ⊕ fromDigit x + in + (# b', len + 1 #) + | otherwise + = let x' = x `div` base + y = x `mod` base + b' = b ⊕ fromDigit y + in + fmt' x' b' (len + 1) + +mkPad ∷ Int → Int → AsciiBuilder +{-# INLINEABLE mkPad #-} +mkPad minWidth len + = A.toAsciiBuilder $ + A.unsafeFromByteString $ + BS.replicate (minWidth - len) '0' + +fmtDec ∷ Integral n ⇒ Int → n → AsciiBuilder +{-# INLINE fmtDec #-} fmtDec minWidth n | minWidth == 2 = fmtDec2 n -- optimization | minWidth == 3 = fmtDec3 n -- optimization | minWidth == 4 = fmtDec4 n -- optimization - | otherwise = fmtInt 10 undefined minWidth '0' False n -{-# INLINE fmtDec #-} + | otherwise = fmtInt 10 minWidth n - -fmtDec2 :: Int -> String +fmtDec2 ∷ Integral n ⇒ n → AsciiBuilder +{-# INLINEABLE fmtDec2 #-} fmtDec2 n - | n < 0 || n >= 100 = fmtInt 10 undefined 2 '0' False n -- fallback - | n < 10 = '0' - : intToChar undefined n - : [] - | otherwise = intToChar undefined (n `div` 10) - : intToChar undefined (n `mod` 10) - : [] - - -fmtDec3 :: Int -> String + | n < 0 ∨ n ≥ 100 = fmtInt 10 2 n -- fallback + | n < 10 = A.toAsciiBuilder "0" ⊕ + fromDigit n + | otherwise = fromDigit (n `div` 10) ⊕ + fromDigit (n `mod` 10) + +fmtDec3 ∷ Integral n ⇒ n → AsciiBuilder +{-# INLINEABLE fmtDec3 #-} fmtDec3 n - | n < 0 || n >= 1000 = fmtInt 10 undefined 3 '0' False n -- fallback - | n < 10 = '0' : '0' - : intToChar undefined n - : [] - | n < 100 = '0' - : intToChar undefined ((n `div` 10) `mod` 10) - : intToChar undefined ( n `mod` 10) - : [] - | otherwise = intToChar undefined ((n `div` 100) `mod` 10) - : intToChar undefined ((n `div` 10) `mod` 10) - : intToChar undefined ( n `mod` 10) - : [] - - -fmtDec4 :: Int -> String + | n < 0 ∨ n ≥ 1000 = fmtInt 10 3 n -- fallback + | n < 10 = A.toAsciiBuilder "00" ⊕ + fromDigit n + | n < 100 = A.toAsciiBuilder "0" ⊕ + fromDigit ((n `div` 10) `mod` 10) ⊕ + fromDigit ( n `mod` 10) + | otherwise = fromDigit (n `div` 100) ⊕ + fromDigit ((n `div` 10) `mod` 10) ⊕ + fromDigit ( n `mod` 10) + +fmtDec4 ∷ Integral n ⇒ n → AsciiBuilder +{-# INLINEABLE fmtDec4 #-} fmtDec4 n - | n < 0 || n >= 10000 = fmtInt 10 undefined 4 '0' False n -- fallback - | n < 10 = '0' : '0' : '0' - : intToChar undefined n - : [] - | n < 100 = '0' : '0' - : intToChar undefined ((n `div` 10) `mod` 10) - : intToChar undefined ( n `mod` 10) - : [] - | n < 1000 = '0' - : intToChar undefined ((n `div` 100) `mod` 10) - : intToChar undefined ((n `div` 10) `mod` 10) - : intToChar undefined ( n `mod` 10) - : [] - | otherwise = intToChar undefined ((n `div` 1000) `mod` 10) - : intToChar undefined ((n `div` 100) `mod` 10) - : intToChar undefined ((n `div` 10) `mod` 10) - : intToChar undefined ( n `mod` 10) - : [] - - -fmtHex :: Bool -> Int -> Int -> String -fmtHex upperCase minWidth - = fmtInt 16 upperCase minWidth '0' False - - -padStr :: Int -> Char -> String -> String -padStr minWidth pad str - = let delta = minWidth - length str - in - if delta > 0 then - replicate delta pad ++ str - else - str - - -intToChar :: Bool -> Int -> Char -intToChar _ 0 = '0' -intToChar _ 1 = '1' -intToChar _ 2 = '2' -intToChar _ 3 = '3' -intToChar _ 4 = '4' -intToChar _ 5 = '5' -intToChar _ 6 = '6' -intToChar _ 7 = '7' -intToChar _ 8 = '8' -intToChar _ 9 = '9' -intToChar False 10 = 'a' -intToChar True 10 = 'A' -intToChar False 11 = 'b' -intToChar True 11 = 'B' -intToChar False 12 = 'c' -intToChar True 12 = 'C' -intToChar False 13 = 'd' -intToChar True 13 = 'D' -intToChar False 14 = 'e' -intToChar True 14 = 'E' -intToChar False 15 = 'f' -intToChar True 15 = 'F' \ No newline at end of file + | n < 0 ∨ n ≥ 10000 = fmtInt 10 4 n -- fallback + | n < 10 = A.toAsciiBuilder "000" ⊕ + fromDigit n + | n < 100 = A.toAsciiBuilder "00" ⊕ + fromDigit ((n `div` 10) `mod` 10) ⊕ + fromDigit ( n `mod` 10) + | n < 1000 = A.toAsciiBuilder "0" ⊕ + fromDigit ((n `div` 100) `mod` 10) ⊕ + fromDigit ((n `div` 10) `mod` 10) ⊕ + fromDigit ( n `mod` 10) + | otherwise = fromDigit (n `div` 1000) ⊕ + fromDigit ((n `div` 100) `mod` 10) ⊕ + fromDigit ((n `div` 10) `mod` 10) ⊕ + fromDigit ( n `mod` 10) + +fmtHex ∷ Integral n ⇒ Int → n → AsciiBuilder +{-# INLINE fmtHex #-} +fmtHex = fmtInt 16 + +digitToChar ∷ Integral n ⇒ n → Char +{-# INLINE digitToChar #-} +digitToChar n + | n < 0 = (⊥) + | n < 10 = chr (ord '0' + fromIntegral n ) + | n < 16 = chr (ord 'A' + fromIntegral (n-10)) + | otherwise = (⊥) + +fromDigit ∷ Integral n ⇒ n → AsciiBuilder +{-# INLINE fromDigit #-} +fromDigit = A.unsafeFromBuilder ∘ BC.fromChar ∘ digitToChar