{-# LANGUAGE
    OverloadedStrings
  , ScopedTypeVariables
  , UnboxedTuples
  , UnicodeSyntax
  #-}
-- 本當にこんなものを自分で書く必要があったのだらうか。Printf は重いの
-- で駄目だが、それ以外のモジュールを探しても見付からなかった。
module Network.HTTP.Lucu.Format
    ( fmtInt

    , fmtDec
    , fmtHex
    )
    where
import qualified Blaze.ByteString.Builder.Char8 as BC
import Data.Ascii (AsciiBuilder)
import qualified Data.ByteString.Char8 as BS
import qualified Data.Ascii as A
import Data.Char
import Data.Monoid.Unicode
import Prelude.Unicode

fmtInt ∷ ∀n. Integral n ⇒ n → Int → n → AsciiBuilder
{-# INLINEABLE fmtInt #-}
fmtInt base minWidth n
    = let (# raw, len #) = fmt' (abs n) (∅) 0
      in
        if n < 0 then
            ( A.toAsciiBuilder "-" ⊕
              mkPad (minWidth - 1) len ⊕
              raw
            )
        else
            mkPad minWidth len ⊕ raw
    where
      fmt' ∷ n → AsciiBuilder → Int → (# AsciiBuilder, Int #)
      {-# INLINEABLE fmt' #-}
      fmt' x b len
          | x < base
              = let b' = b ⊕ fromDigit x
                in
                  (# b', len + 1 #)
          | otherwise
              = let x' = x `div` base
                    y  = x `mod` base
                    b' = b ⊕ fromDigit y
                in
                  fmt' x' b' (len + 1)

mkPad ∷ Int → Int → AsciiBuilder
{-# INLINEABLE mkPad #-}
mkPad minWidth len
    = A.toAsciiBuilder $
      A.unsafeFromByteString $
      BS.replicate (minWidth - len) '0'

fmtDec ∷ Integral n ⇒ Int → n → AsciiBuilder
{-# INLINE fmtDec #-}
fmtDec minWidth n
    | minWidth == 2 = fmtDec2 n -- optimization 
    | minWidth == 3 = fmtDec3 n -- optimization
    | minWidth == 4 = fmtDec4 n -- optimization
    | otherwise     = fmtInt 10 minWidth n

fmtDec2 ∷ Integral n ⇒ n → AsciiBuilder
{-# INLINEABLE fmtDec2 #-}
fmtDec2 n
    | n < 0 ∨ n ≥ 100 = fmtInt 10 2 n -- fallback
    | n < 10          = A.toAsciiBuilder "0"   ⊕
                        fromDigit n
    | otherwise       = fromDigit (n `div` 10) ⊕
                        fromDigit (n `mod` 10)

fmtDec3 ∷ Integral n ⇒ n → AsciiBuilder
{-# INLINEABLE fmtDec3 #-}
fmtDec3 n
    | n < 0 ∨ n ≥ 1000 = fmtInt 10 3 n -- fallback
    | n < 10           = A.toAsciiBuilder "00"              ⊕
                         fromDigit n
    | n < 100          = A.toAsciiBuilder "0"               ⊕
                         fromDigit ((n `div`  10) `mod` 10) ⊕
                         fromDigit ( n            `mod` 10)
    | otherwise        = fromDigit  (n `div` 100)           ⊕
                         fromDigit ((n `div`  10) `mod` 10) ⊕
                         fromDigit ( n            `mod` 10)

fmtDec4 ∷ Integral n ⇒ n → AsciiBuilder
{-# INLINEABLE fmtDec4 #-}
fmtDec4 n
    | n < 0 ∨ n ≥ 10000 = fmtInt 10 4 n -- fallback
    | n < 10            = A.toAsciiBuilder "000"              ⊕
                          fromDigit n
    | n < 100           = A.toAsciiBuilder "00"               ⊕
                          fromDigit ((n `div`   10) `mod` 10) ⊕
                          fromDigit ( n             `mod` 10)
    | n < 1000          = A.toAsciiBuilder "0"                ⊕
                          fromDigit ((n `div`  100) `mod` 10) ⊕
                          fromDigit ((n `div`   10) `mod` 10) ⊕
                          fromDigit ( n             `mod` 10)
    | otherwise         = fromDigit  (n `div` 1000)           ⊕
                          fromDigit ((n `div`  100) `mod` 10) ⊕
                          fromDigit ((n `div`   10) `mod` 10) ⊕
                          fromDigit ( n             `mod` 10)

fmtHex ∷ Integral n ⇒ Int → n → AsciiBuilder
{-# INLINE fmtHex #-}
fmtHex = fmtInt 16

digitToChar ∷ Integral n ⇒ n → Char
{-# INLINE digitToChar #-}
digitToChar n
    | n < 0     = (⊥)
    | n < 10    = chr (ord '0' + fromIntegral  n    )
    | n < 16    = chr (ord 'A' + fromIntegral (n-10))
    | otherwise = (⊥)

fromDigit ∷ Integral n ⇒ n → AsciiBuilder
{-# INLINE fromDigit #-}
fromDigit = A.unsafeFromBuilder ∘ BC.fromChar ∘ digitToChar