-- 本當にこんなものを自分で書く必要があったのだらうか。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' m
          | m < base  = [intToChar upperCase m]
          | otherwise = (intToChar upperCase $! m `mod` base) : fmt' (m `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'
intToChar _ _ = undefined