ip-1.7.6: test/IPv4Text1.hs

{-# LANGUAGE CPP #-}
module IPv4Text1 where

import Net.Types (IPv4(..))
import Data.Text (Text)
import Data.Text.Internal (Text(..))
import Data.Word
import Data.ByteString (ByteString)
import Control.Monad.ST
import Data.Bits (shiftR,(.&.))
import qualified Data.ByteString.Char8  as BC8
import qualified Data.ByteString        as ByteString
import qualified Data.ByteString.Unsafe as ByteString
import qualified Data.Text.Array        as TArray

------------------------
-- This implementation operates directly on
-- a mutable array. It is the fastest one so far.
-- On a 2012 laptop, it can serialize an IPv4
-- address to Text in 35ns. It is somewhat wasteful
-- of space. It allocates a full 30 bytes in case it
-- needs it, but it may need as few as 14 bytes.
------------------------
encode :: IPv4 -> Text
encode (IPv4 w) =
  let w1 = fromIntegral $ 255 .&. shiftR w 24
      w2 = fromIntegral $ 255 .&. shiftR w 16
      w3 = fromIntegral $ 255 .&. shiftR w 8
      w4 = fromIntegral $ 255 .&. w
      (arr,len) = runST $ do
        marr <- TArray.new 15
        i1 <- putAndCount 0 w1 marr
        let n1 = i1
            n1' = i1 + 1
        TArray.unsafeWrite marr n1 dot
        i2 <- putAndCount n1' w2 marr
        let n2 = i2 + n1'
            n2' = n2 + 1
        TArray.unsafeWrite marr n2 dot
        i3 <- putAndCount n2' w3 marr
        let n3 = i3 + n2'
            n3' = n3 + 1
        TArray.unsafeWrite marr n3 dot
        i4 <- putAndCount n3' w4 marr
        theArr <- TArray.unsafeFreeze marr
        return (theArr,i4 + n3')
  in Text arr 0 len

putAndCount :: Int -> Word8 -> TArray.MArray s -> ST s Int
putAndCount pos w marr
  | w < 10 = TArray.unsafeWrite marr pos (i2w w) >> return 1
  | w < 100 = write2 pos w >> return 2
  | otherwise = write3 pos w >> return 3
  where
  write2 off i0 = do
    let i = fromIntegral i0; j = i + i
    TArray.unsafeWrite marr off $ get2 j
    TArray.unsafeWrite marr (off + 1) $ get2 (j + 1)
  write3 off i0 = do
    let i = fromIntegral i0; j = i + i + i
    TArray.unsafeWrite marr off $ get3 j
    TArray.unsafeWrite marr (off + 1) $ get3 (j + 1)
    TArray.unsafeWrite marr (off + 2) $ get3 (j + 2)
  get2 = fromIntegral . ByteString.unsafeIndex twoDigits
  get3 = fromIntegral . ByteString.unsafeIndex threeDigits

-- From Common.Compat, but we don't want to expose the module so we also
-- define 'Codepoint' here.
#if MIN_VERSION_text(2, 0, 0)
type Codepoint = Word8
#else
type Codepoint = Word16
#endif

zero,dot :: Codepoint
zero = 48
{-# INLINE zero #-}
dot = 46
{-# INLINE dot #-}

i2w :: (Integral a) => a -> Codepoint
i2w v = zero + fromIntegral v
{-# INLINE i2w #-}

-- Note: these double backslashes are need here because CPP is enabled.
twoDigits :: ByteString
twoDigits = BC8.pack
  "0001020304050607080910111213141516171819\\
  \2021222324252627282930313233343536373839\\
  \4041424344454647484950515253545556575859\\
  \6061626364656667686970717273747576777879\\
  \8081828384858687888990919293949596979899"

threeDigits :: ByteString
threeDigits =
  ByteString.replicate 300 0 <> BC8.pack
  "100101102103104105106107108109110111112\\
  \113114115116117118119120121122123124125\\
  \126127128129130131132133134135136137138\\
  \139140141142143144145146147148149150151\\
  \152153154155156157158159160161162163164\\
  \165166167168169170171172173174175176177\\
  \178179180181182183184185186187188189190\\
  \191192193194195196197198199200201202203\\
  \204205206207208209210211212213214215216\\
  \217218219220221222223224225226227228229\\
  \230231232233234235236237238239240241242\\
  \243244245246247248249250251252253254255"