Network/HTTP/Lucu/Format.hs

   1 {-# LANGUAGE
   2     OverloadedStrings
   3   , ScopedTypeVariables
   4   , UnboxedTuples
   5   , UnicodeSyntax
   6   #-}
   7 -- 本當にこんなものを自分で書く必要があったのだらうか。Printf は重いの
   8 -- で駄目だが、それ以外のモジュールを探しても見付からなかった。
   9 module Network.HTTP.Lucu.Format
  10     ( fmtInt
  11
  12     , fmtDec
  13     , fmtHex
  14     )
  15     where
  16 import Data.Ascii (AsciiBuilder)
  17 import qualified Data.ByteString.Char8 as BS
  18 import qualified Data.Ascii as A
  19 import Data.Char
  20 import Data.Monoid.Unicode
  21 import Prelude.Unicode
  22
  23 fmtInt ∷ ∀n. Integral n ⇒ n → Int → n → AsciiBuilder
  24 {-# INLINEABLE fmtInt #-}
  25 fmtInt base minWidth n
  26     = let (# raw, len #) = fmt' (abs n) (∅) 0
  27       in
  28         if n < 0 then
  29             ( A.toAsciiBuilder "-" ⊕
  30               mkPad (minWidth - 1) len ⊕
  31               raw
  32             )
  33         else
  34             mkPad minWidth len ⊕ raw
  35     where
  36       fmt' ∷ n → AsciiBuilder → Int → (# AsciiBuilder, Int #)
  37       {-# INLINEABLE fmt' #-}
  38       fmt' x b len
  39           | x < base
  40               = let b' = b ⊕ fromDigit x
  41                 in
  42                   (# b', len + 1 #)
  43           | otherwise
  44               = let x' = x `div` base
  45                     y  = x `mod` base
  46                     b' = b ⊕ fromDigit y
  47                 in
  48                   fmt' x' b' (len + 1)
  49
  50 mkPad ∷ Int → Int → AsciiBuilder
  51 {-# INLINEABLE mkPad #-}
  52 mkPad minWidth len
  53     = A.toAsciiBuilder $
  54       A.unsafeFromByteString $
  55       BS.replicate (minWidth - len) '0'
  56
  57 fmtDec ∷ Integral n ⇒ Int → n → AsciiBuilder
  58 {-# INLINE fmtDec #-}
  59 fmtDec minWidth n
  60     | minWidth == 2 = fmtDec2 n -- optimization
  61     | minWidth == 3 = fmtDec3 n -- optimization
  62     | minWidth == 4 = fmtDec4 n -- optimization
  63     | otherwise     = fmtInt 10 minWidth n
  64
  65 fmtDec2 ∷ Integral n ⇒ n → AsciiBuilder
  66 {-# INLINEABLE fmtDec2 #-}
  67 fmtDec2 n
  68     | n < 0 ∨ n ≥ 100 = fmtInt 10 2 n -- fallback
  69     | n < 10          = A.toAsciiBuilder "0"   ⊕
  70                         fromDigit n
  71     | otherwise       = fromDigit (n `div` 10) ⊕
  72                         fromDigit (n `mod` 10)
  73
  74 fmtDec3 ∷ Integral n ⇒ n → AsciiBuilder
  75 {-# INLINEABLE fmtDec3 #-}
  76 fmtDec3 n
  77     | n < 0 ∨ n ≥ 1000 = fmtInt 10 3 n -- fallback
  78     | n < 10           = A.toAsciiBuilder "00"              ⊕
  79                          fromDigit n
  80     | n < 100          = A.toAsciiBuilder "0"               ⊕
  81                          fromDigit ((n `div`  10) `mod` 10) ⊕
  82                          fromDigit ( n            `mod` 10)
  83     | otherwise        = fromDigit  (n `div` 100)           ⊕
  84                          fromDigit ((n `div`  10) `mod` 10) ⊕
  85                          fromDigit ( n            `mod` 10)
  86
  87 fmtDec4 ∷ Integral n ⇒ n → AsciiBuilder
  88 {-# INLINEABLE fmtDec4 #-}
  89 fmtDec4 n
  90     | n < 0 ∨ n ≥ 10000 = fmtInt 10 4 n -- fallback
  91     | n < 10            = A.toAsciiBuilder "000"              ⊕
  92                           fromDigit n
  93     | n < 100           = A.toAsciiBuilder "00"               ⊕
  94                           fromDigit ((n `div`   10) `mod` 10) ⊕
  95                           fromDigit ( n             `mod` 10)
  96     | n < 1000          = A.toAsciiBuilder "0"                ⊕
  97                           fromDigit ((n `div`  100) `mod` 10) ⊕
  98                           fromDigit ((n `div`   10) `mod` 10) ⊕
  99                           fromDigit ( n             `mod` 10)
 100     | otherwise         = fromDigit  (n `div` 1000)           ⊕
 101                           fromDigit ((n `div`  100) `mod` 10) ⊕
 102                           fromDigit ((n `div`   10) `mod` 10) ⊕
 103                           fromDigit ( n             `mod` 10)
 104
 105 fmtHex ∷ Integral n ⇒ Int → n → AsciiBuilder
 106 {-# INLINE fmtHex #-}
 107 fmtHex = fmtInt 16
 108
 109 digitToChar ∷ Integral n ⇒ n → Char
 110 {-# INLINE digitToChar #-}
 111 digitToChar n
 112     | n < 0     = (⊥)
 113     | n < 10    = chr (ord '0' + fromIntegral  n    )
 114     | n < 16    = chr (ord 'A' + fromIntegral (n-10))
 115     | otherwise = (⊥)
 116
 117 fromDigit ∷ Integral n ⇒ n → AsciiBuilder
 118 {-# INLINE fromDigit #-}
 119 fromDigit = A.toAsciiBuilder ∘
 120             A.unsafeFromByteString ∘
 121             BS.singleton ∘
 122             digitToChar