Optimized as possible as I can.

[Lucu.git] / Network / HTTP / Lucu / Format.hs

diff --git a/Network/HTTP/Lucu/Format.hs b/Network/HTTP/Lucu/Format.hs
new file mode 100644 (file)
index 0000000..26319b7
--- /dev/null
+++ b/Network/HTTP/Lucu/Format.hs
@@ -0,0 +1,128 @@
+-- #hide
+
+-- 本當にこんなものを自分で書く必要があったのだらうか。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' n
+          | n < base  = (intToChar upperCase n) : []
+          | otherwise = (intToChar upperCase $! n `mod` base) : fmt' (n `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'
\ No newline at end of file