Network/HTTP/Lucu/Format.hs

   1 -- 本當にこんなものを自分で書く必要があったのだらうか。Printf は重いの
   2 -- で駄目だが、それ以外のモジュールを探しても見付からなかった。
   3
   4 module Network.HTTP.Lucu.Format
   5     ( fmtInt
   6
   7     , fmtDec
   8     , fmtHex
   9     )
  10     where
  11
  12
  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 "+"
  19                     else
  20                         ""
  21           padded  = padStr (minWidth - length sign) pad raw
  22       in
  23         sign ++ padded
  24     where
  25       fmt' :: Int -> String
  26       fmt' m
  27           | m < base  = [intToChar upperCase m]
  28           | otherwise = (intToChar upperCase $! m `mod` base) : fmt' (m `div` base)
  29
  30
  31 fmtDec :: Int -> Int -> String
  32 fmtDec minWidth n
  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
  37 {-# INLINE fmtDec #-}
  38
  39
  40 fmtDec2 :: Int -> String
  41 fmtDec2 n
  42     | n < 0 || n >= 100 = fmtInt 10 undefined 2 '0' False n -- fallback
  43     | n < 10            = [ '0'
  44                           , intToChar undefined n
  45                           ]
  46     | otherwise         = [ intToChar undefined (n `div` 10)
  47                           , intToChar undefined (n `mod` 10)
  48                           ]
  49
  50
  51 fmtDec3 :: Int -> String
  52 fmtDec3 n
  53     | n < 0 || n >= 1000 = fmtInt 10 undefined 3 '0' False n -- fallback
  54     | n < 10             = [ '0'
  55                            , '0'
  56                            , intToChar undefined n
  57                            ]
  58     | n < 100            = [ '0'
  59                            , intToChar undefined ((n `div` 10) `mod` 10)
  60                            , intToChar undefined ( n           `mod` 10)
  61                            ]
  62     | otherwise          = [ intToChar undefined ((n `div` 100) `mod` 10)
  63                            , intToChar undefined ((n `div`  10) `mod` 10)
  64                            , intToChar undefined ( n            `mod` 10)
  65                            ]
  66
  67
  68 fmtDec4 :: Int -> String
  69 fmtDec4 n
  70     | n < 0 || n >= 10000 = fmtInt 10 undefined 4 '0' False n -- fallback
  71     | n < 10              = [ '0'
  72                             , '0'
  73                             , '0'
  74                             , intToChar undefined n
  75                             ]
  76     | n < 100             = [ '0'
  77                             , '0'
  78                             , intToChar undefined ((n `div` 10) `mod` 10)
  79                             , intToChar undefined ( n           `mod` 10)
  80                             ]
  81     | n < 1000            = [ '0'
  82                             , intToChar undefined ((n `div` 100) `mod` 10)
  83                             , intToChar undefined ((n `div`  10) `mod` 10)
  84                             , intToChar undefined ( n            `mod` 10)
  85                             ]
  86     | otherwise           = [ intToChar undefined ((n `div` 1000) `mod` 10)
  87                             , intToChar undefined ((n `div`  100) `mod` 10)
  88                             , intToChar undefined ((n `div`   10) `mod` 10)
  89                             , intToChar undefined ( n             `mod` 10)
  90                             ]
  91
  92
  93 fmtHex :: Bool -> Int -> Int -> String
  94 fmtHex upperCase minWidth
  95     = fmtInt 16 upperCase minWidth '0' False
  96
  97
  98 padStr :: Int -> Char -> String -> String
  99 padStr minWidth pad str
 100     = let delta = minWidth - length str
 101       in
 102         if delta > 0 then
 103             replicate delta pad ++ str
 104         else
 105             str
 106
 107
 108 intToChar :: Bool -> Int -> Char
 109 intToChar _ 0  = '0'
 110 intToChar _ 1  = '1'
 111 intToChar _ 2  = '2'
 112 intToChar _ 3  = '3'
 113 intToChar _ 4  = '4'
 114 intToChar _ 5  = '5'
 115 intToChar _ 6  = '6'
 116 intToChar _ 7  = '7'
 117 intToChar _ 8  = '8'
 118 intToChar _ 9  = '9'
 119 intToChar False 10 = 'a'
 120 intToChar True  10 = 'A'
 121 intToChar False 11 = 'b'
 122 intToChar True  11 = 'B'
 123 intToChar False 12 = 'c'
 124 intToChar True  12 = 'C'
 125 intToChar False 13 = 'd'
 126 intToChar True  13 = 'D'
 127 intToChar False 14 = 'e'
 128 intToChar True  14 = 'E'
 129 intToChar False 15 = 'f'
 130 intToChar True  15 = 'F'
 131 intToChar _ _ = undefined