1 -- 本當にこんなものを自分で書く必要があったのだらうか。Printf は重いの
2 -- で駄目だが、それ以外のモジュールを探しても見付からなかった。
4 module Network.HTTP.Lucu.Format
13 fmtInt :: Int -> Bool -> Int -> Char -> Bool -> Int -> String
14 fmtInt base upperCase minWidth pad forceSign n
15 = base `seq` minWidth `seq` pad `seq` forceSign `seq` n `seq`
16 let raw = reverse $! fmt' (abs n)
17 sign = if forceSign || n < 0 then
18 if n < 0 then "-" else "+"
21 padded = padStr (minWidth - length sign) pad raw
27 | m < base = (intToChar upperCase m) : []
28 | otherwise = (intToChar upperCase $! m `mod` base) : fmt' (m `div` base)
31 fmtDec :: Int -> Int -> String
33 | minWidth == 2 = fmtDec2 n -- optimization
34 | minWidth == 3 = fmtDec3 n -- optimization
35 | minWidth == 4 = fmtDec4 n -- optimization
36 | otherwise = fmtInt 10 undefined minWidth '0' False n
40 fmtDec2 :: Int -> String
42 | n < 0 || n >= 100 = fmtInt 10 undefined 2 '0' False n -- fallback
44 : intToChar undefined n
46 | otherwise = intToChar undefined (n `div` 10)
47 : intToChar undefined (n `mod` 10)
51 fmtDec3 :: Int -> String
53 | n < 0 || n >= 1000 = fmtInt 10 undefined 3 '0' False n -- fallback
55 : intToChar undefined n
58 : intToChar undefined ((n `div` 10) `mod` 10)
59 : intToChar undefined ( n `mod` 10)
61 | otherwise = intToChar undefined ((n `div` 100) `mod` 10)
62 : intToChar undefined ((n `div` 10) `mod` 10)
63 : intToChar undefined ( n `mod` 10)
67 fmtDec4 :: Int -> String
69 | n < 0 || n >= 10000 = fmtInt 10 undefined 4 '0' False n -- fallback
70 | n < 10 = '0' : '0' : '0'
71 : intToChar undefined n
74 : intToChar undefined ((n `div` 10) `mod` 10)
75 : intToChar undefined ( n `mod` 10)
78 : intToChar undefined ((n `div` 100) `mod` 10)
79 : intToChar undefined ((n `div` 10) `mod` 10)
80 : intToChar undefined ( n `mod` 10)
82 | otherwise = intToChar undefined ((n `div` 1000) `mod` 10)
83 : intToChar undefined ((n `div` 100) `mod` 10)
84 : intToChar undefined ((n `div` 10) `mod` 10)
85 : intToChar undefined ( n `mod` 10)
89 fmtHex :: Bool -> Int -> Int -> String
90 fmtHex upperCase minWidth
91 = fmtInt 16 upperCase minWidth '0' False
94 padStr :: Int -> Char -> String -> String
95 padStr minWidth pad str
96 = let delta = minWidth - length str
99 replicate delta pad ++ str
104 intToChar :: Bool -> Int -> Char
115 intToChar False 10 = 'a'
116 intToChar True 10 = 'A'
117 intToChar False 11 = 'b'
118 intToChar True 11 = 'B'
119 intToChar False 12 = 'c'
120 intToChar True 12 = 'C'
121 intToChar False 13 = 'd'
122 intToChar True 13 = 'D'
123 intToChar False 14 = 'e'
124 intToChar True 14 = 'E'
125 intToChar False 15 = 'f'
126 intToChar True 15 = 'F'
127 intToChar _ _ = undefined