BuilderSpec.hs

{-# LANGUAGE NegativeLiterals  #-}
{-# LANGUAGE OverloadedStrings #-}
module Pinch.Internal.BuilderSpec (spec) where

import Control.Arrow           (second)
import Data.ByteString         (ByteString)
import Data.ByteString.Builder (toLazyByteString)
import Data.ByteString.Lazy    (toStrict)
import Data.Int                (Int64)
import Data.Word               (Word8)
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck

import qualified Data.ByteString as B

import Pinch.Arbitrary
import Pinch.Internal.Builder (Build)

import qualified Pinch.Internal.Builder as BB

run :: Build -> (Int64, ByteString)
run = second (toStrict . toLazyByteString) . BB.run


encodeCases
    :: (a -> Build) -> [([Word8], a)] -> Expectation
encodeCases encode = mapM_ . uncurry $ \bytes a -> do
    let (size, encoded) = run (encode a)
        expected = B.pack bytes
    encoded `shouldBe` expected
    fromIntegral size `shouldBe` B.length expected


spec :: Spec
spec = describe "Builder" $ do

    it "can encode 8-bit integers" $
        encodeCases BB.int8
            [ ([0x01], 1)
            , ([0x05], 5)
            , ([0x7f], 127)
            , ([0xff], -1)
            , ([0x80], -128)
            ]

    it "can encode 16-bit integers" $
        encodeCases BB.int16
            [ ([0x00, 0x01], 1)
            , ([0x00, 0xff], 255)
            , ([0x01, 0x00], 256)
            , ([0x01, 0x01], 257)
            , ([0x7f, 0xff], 32767)
            , ([0xff, 0xff], -1)
            , ([0xff, 0xfe], -2)
            , ([0xff, 0x00], -256)
            , ([0xff, 0x01], -255)
            , ([0x80, 0x00], -32768)
            ]

    it "can encode 32-bit integers" $
        encodeCases BB.int32
            [ ([0x00, 0x00, 0x00, 0x01], 1)
            , ([0x00, 0x00, 0x00, 0xff], 255)
            , ([0x00, 0x00, 0xff, 0xff], 65535)
            , ([0x00, 0xff, 0xff, 0xff], 16777215)
            , ([0x7f, 0xff, 0xff, 0xff], 2147483647)
            , ([0xff, 0xff, 0xff, 0xff], -1)
            , ([0xff, 0xff, 0xff, 0x00], -256)
            , ([0xff, 0xff, 0x00, 0x00], -65536)
            , ([0xff, 0x00, 0x00, 0x00], -16777216)
            , ([0x80, 0x00, 0x00, 0x00], -2147483648)
            ]

    it "can encode 64-bit integers" $
        encodeCases BB.int64
            [ ([0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01], 1)
            , ([0x00, 0x00, 0x00, 0x00, 0xff, 0xff, 0xff, 0xff], 4294967295)
            , ([0x00, 0x00, 0x00, 0xff, 0xff, 0xff, 0xff, 0xff], 1099511627775)
            , ([0x00, 0x00, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff], 281474976710655)
            , ([0x00, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff], 72057594037927935)
            , ([0x7f, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff], 9223372036854775807)
            , ([0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff], -1)
            , ([0xff, 0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00], -4294967296)
            , ([0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00], -1099511627776)
            , ([0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00], -281474976710656)
            , ([0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00], -72057594037927936)
            , ([0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00], -9223372036854775808)
            ]

    it "can encode doubles" $
        encodeCases BB.double
            [ ([0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00], 0.0)
            , ([0x3f, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00], 1.0)
            , ([0x3f, 0xf0, 0x00, 0x00, 0x00, 0x06, 0xdf, 0x38], 1.0000000001)
            , ([0x3f, 0xf1, 0x99, 0x99, 0x99, 0x99, 0x99, 0x9a], 1.1)
            , ([0xbf, 0xf1, 0x99, 0x99, 0x99, 0x99, 0x99, 0x9a], -1.1)
            , ([0x40, 0x09, 0x21, 0xfb, 0x54, 0x44, 0x2d, 0x18], 3.141592653589793)
            , ([0xbf, 0xf0, 0x00, 0x00, 0x00, 0x06, 0xdf, 0x38], -1.0000000001)
            ]

    prop "can encode bytestrings" $ \(SomeByteString bs) ->
        run (BB.byteString bs) === (fromIntegral $ B.length bs, bs)

    it "can join multiple operations using (>>)" $
        encodeCases (\(a, b) -> BB.int16 a >> BB.byteString b)
            [ ( [0x12, 0x34, 0x61, 0x62, 0x63, 0x64]
              , (4660, "abcd")
              )
            , ( [0x00, 0x00, 0x68, 0x65, 0x6c, 0x6c, 0x6f]
              , (0, "hello")
              )
            ]

    it "can join multiple operations using (>>=)" $
        encodeCases (\(a, b) -> BB.int16 a >>= \() -> BB.byteString b)
            [ ( [0x12, 0x34, 0x61, 0x62, 0x63, 0x64]
              , (4660, "abcd")
              )
            , ( [0x00, 0x00, 0x68, 0x65, 0x6c, 0x6c, 0x6f]
              , (0, "hello")
              )
            ]