-{-# 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
projects / Lucu.git / commitdiff