ip-1.7.8: test/IPv4Text1.hs

{-# LANGUAGE CPP #-}

module IPv4Text1 where

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

------------------------
-- 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.
{- FOURMOLU_DISABLE -}
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"
{- FOURMOLU_ENABLE -}