Network/HTTP/Lucu/Format.hs

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