X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FFormat.hs;h=86bca83aacca170075c0676e0201bab68dac4589;hp=93c2cda9ea065214d84463c40a434dfbf4759cf2;hb=8510a3765130fb171c06b448c50a74e65ac8ae11;hpb=dfc778742934b8f2ac6a6709741c79ecd40c5ff1 diff --git a/Network/HTTP/Lucu/Format.hs b/Network/HTTP/Lucu/Format.hs index 93c2cda..86bca83 100644 --- a/Network/HTTP/Lucu/Format.hs +++ b/Network/HTTP/Lucu/Format.hs @@ -1,6 +1,11 @@ +{-# LANGUAGE + OverloadedStrings + , ScopedTypeVariables + , UnboxedTuples + , UnicodeSyntax + #-} -- 本當にこんなものを自分で書く必要があったのだらうか。Printf は重いの -- で駄目だが、それ以外のモジュールを探しても見付からなかった。 - module Network.HTTP.Lucu.Format ( fmtInt @@ -8,124 +13,110 @@ 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 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' m - | m < base = [intToChar upperCase m] - | otherwise = (intToChar upperCase $! m `mod` base) : fmt' (m `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' -intToChar _ _ = undefined + | 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.toAsciiBuilder ∘ + A.unsafeFromByteString ∘ + BS.singleton ∘ + digitToChar