+{-# LANGUAGE
+ OverloadedStrings
+ , ScopedTypeVariables
+ , UnboxedTuples
+ , UnicodeSyntax
+ #-}
-- 本當にこんなものを自分で書く必要があったのだらうか。Printf は重いの
-- で駄目だが、それ以外のモジュールを探しても見付からなかった。
-
module Network.HTTP.Lucu.Format
( fmtInt
, 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
+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
- sign ++ padded
+ if n < 0 then
+ ( A.toAsciiBuilder "-" ⊕
+ mkPad (minWidth - 1) len ⊕
+ raw
+ )
+ else
+ mkPad minWidth len ⊕ raw
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
+ 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 undefined minWidth '0' False n
-{-# INLINE fmtDec #-}
-
+ | otherwise = fmtInt 10 minWidth n
-fmtDec2 :: Int -> String
+fmtDec2 ∷ Integral n ⇒ n → AsciiBuilder
+{-# INLINEABLE fmtDec2 #-}
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
+ | 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 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
+ | 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 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
+ | 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.toAsciiBuilder ∘
+ A.unsafeFromByteString ∘
+ BS.singleton ∘
+ digitToChar
projects / Lucu.git / blobdiff