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 qualified Blaze.ByteString.Builder.Char8 as BC
  17 import Data.Ascii (AsciiBuilder)
  18 import qualified Data.ByteString.Char8 as BS
  19 import qualified Data.Ascii as A
  20 import Data.Char
  21 import Data.Monoid.Unicode
  22 import Prelude.Unicode
  23
  24 fmtInt ∷ ∀n. Integral n ⇒ n → Int → n → AsciiBuilder
  25 {-# INLINEABLE fmtInt #-}
  26 fmtInt base minWidth n
  27     = let (# raw, len #) = fmt' (abs n) (∅) 0
  28       in
  29         if n < 0 then
  30             ( A.toAsciiBuilder "-" ⊕
  31               mkPad (minWidth - 1) len ⊕
  32               raw
  33             )
  34         else
  35             mkPad minWidth len ⊕ raw
  36     where
  37       fmt' ∷ n → AsciiBuilder → Int → (# AsciiBuilder, Int #)
  38       {-# INLINEABLE fmt' #-}
  39       fmt' x b len
  40           | x < base
  41               = let b' = b ⊕ fromDigit x
  42                 in
  43                   (# b', len + 1 #)
  44           | otherwise
  45               = let x' = x `div` base
  46                     y  = x `mod` base
  47                     b' = b ⊕ fromDigit y
  48                 in
  49                   fmt' x' b' (len + 1)
  50
  51 mkPad ∷ Int → Int → AsciiBuilder
  52 {-# INLINEABLE mkPad #-}
  53 mkPad minWidth len
  54     = A.toAsciiBuilder $
  55       A.unsafeFromByteString $
  56       BS.replicate (minWidth - len) '0'
  57
  58 fmtDec ∷ Integral n ⇒ Int → n → AsciiBuilder
  59 {-# INLINE fmtDec #-}
  60 fmtDec minWidth n
  61     | minWidth == 2 = fmtDec2 n -- optimization
  62     | minWidth == 3 = fmtDec3 n -- optimization
  63     | minWidth == 4 = fmtDec4 n -- optimization
  64     | otherwise     = fmtInt 10 minWidth n
  65
  66 fmtDec2 ∷ Integral n ⇒ n → AsciiBuilder
  67 {-# INLINEABLE fmtDec2 #-}
  68 fmtDec2 n
  69     | n < 0 ∨ n ≥ 100 = fmtInt 10 2 n -- fallback
  70     | n < 10          = A.toAsciiBuilder "0"   ⊕
  71                         fromDigit n
  72     | otherwise       = fromDigit (n `div` 10) ⊕
  73                         fromDigit (n `mod` 10)
  74
  75 fmtDec3 ∷ Integral n ⇒ n → AsciiBuilder
  76 {-# INLINEABLE fmtDec3 #-}
  77 fmtDec3 n
  78     | n < 0 ∨ n ≥ 1000 = fmtInt 10 3 n -- fallback
  79     | n < 10           = A.toAsciiBuilder "00"              ⊕
  80                          fromDigit n
  81     | n < 100          = A.toAsciiBuilder "0"               ⊕
  82                          fromDigit ((n `div`  10) `mod` 10) ⊕
  83                          fromDigit ( n            `mod` 10)
  84     | otherwise        = fromDigit  (n `div` 100)           ⊕
  85                          fromDigit ((n `div`  10) `mod` 10) ⊕
  86                          fromDigit ( n            `mod` 10)
  87
  88 fmtDec4 ∷ Integral n ⇒ n → AsciiBuilder
  89 {-# INLINEABLE fmtDec4 #-}
  90 fmtDec4 n
  91     | n < 0 ∨ n ≥ 10000 = fmtInt 10 4 n -- fallback
  92     | n < 10            = A.toAsciiBuilder "000"              ⊕
  93                           fromDigit n
  94     | n < 100           = A.toAsciiBuilder "00"               ⊕
  95                           fromDigit ((n `div`   10) `mod` 10) ⊕
  96                           fromDigit ( n             `mod` 10)
  97     | n < 1000          = A.toAsciiBuilder "0"                ⊕
  98                           fromDigit ((n `div`  100) `mod` 10) ⊕
  99                           fromDigit ((n `div`   10) `mod` 10) ⊕
 100                           fromDigit ( n             `mod` 10)
 101     | otherwise         = fromDigit  (n `div` 1000)           ⊕
 102                           fromDigit ((n `div`  100) `mod` 10) ⊕
 103                           fromDigit ((n `div`   10) `mod` 10) ⊕
 104                           fromDigit ( n             `mod` 10)
 105
 106 fmtHex ∷ Integral n ⇒ Int → n → AsciiBuilder
 107 {-# INLINE fmtHex #-}
 108 fmtHex = fmtInt 16
 109
 110 digitToChar ∷ Integral n ⇒ n → Char
 111 {-# INLINE digitToChar #-}
 112 digitToChar n
 113     | n < 0     = (⊥)
 114     | n < 10    = chr (ord '0' + fromIntegral  n    )
 115     | n < 16    = chr (ord 'A' + fromIntegral (n-10))
 116     | otherwise = (⊥)
 117
 118 fromDigit ∷ Integral n ⇒ n → AsciiBuilder
 119 {-# INLINE fromDigit #-}
 120 fromDigit = A.unsafeFromBuilder ∘ BC.fromChar ∘ digitToChar