+-- #hide
+
+-- 本當にこんなものを自分で書く必要があったのだらうか。Printf は重いの
+-- で駄目だが、それ以外のモジュールを探しても見付からなかった。
+
+module Network.HTTP.Lucu.Format
+ ( fmtInt
+
+ , fmtDec
+ , 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
+ in
+ sign ++ padded
+ 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
+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 #-}
+
+
+fmtDec2 :: Int -> String
+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
+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
+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