thrift-lib-0.1.0.1: test/BinaryParserTest.hs

{-
  Copyright (c) Meta Platforms, Inc. and affiliates.
  All rights reserved.

  This source code is licensed under the BSD-style license found in the
  LICENSE file in the root directory of this source tree.
-}

module BinaryParserTest where

import Control.Monad (replicateM)
import Control.Applicative

import Data.ByteString (ByteString)

import Prelude hiding (takeWhile)

import Test.HUnit
import TestRunner

import Thrift.Binary.Parser

expectParseSuccess :: (Eq a, Show a) => ByteString -> a -> Parser a -> IO ()
expectParseSuccess inp expectedOut parser =
  case parse parser inp of
    Right value | value == expectedOut -> return ()
    Right wrongOut -> assertFailure $
      "expected " ++ show expectedOut ++ ", got " ++ show wrongOut
    Left err -> assertFailure $ "parse error: " ++ err

mkTestParseSuccess
  :: (Eq a, Show a) => String -> ByteString -> a -> Parser a -> Test
mkTestParseSuccess name inp expectedOut parser =
  TestLabel name $ TestCase $ expectParseSuccess inp expectedOut parser

expectParseFailure :: ByteString -> Parser a -> IO ()
expectParseFailure inp parser =
  case parse parser inp of
    Left _ -> return ()
    Right _ -> assertFailure "parsing should fail"

mkTestParseFailure :: String -> ByteString -> Parser a -> Test
mkTestParseFailure name inp parser =
  TestLabel name $ TestCase $ expectParseFailure inp parser

testAnyWord8 :: Test
testAnyWord8 = mkTestParseSuccess "anyWord8" "\7" 7 anyWord8

testCombineParsers :: Test
testCombineParsers =
  mkTestParseSuccess "combine parsers" "\3\1\2\3" [1,2,3] parseList
  where
    parseList = do
      numElems <- anyWord8
      replicateM (fromIntegral numElems) anyWord8

testAlternative :: Test
testAlternative = TestLabel "backtracking" $ TestCase $ do
  expectParseSuccess "\1" 1 parseWord8OrInt32
  expectParseSuccess "\0\0\0\1" 1 parseWord8OrInt32
  where
    parseWord8OrInt32 :: Parser Int
    parseWord8OrInt32 =
      (word8 1 >> return 1) <|> (fromIntegral <$> getInt32be)

testSkipSpaces :: Test
testSkipSpaces =
  mkTestParseSuccess "skipSpaces" "  \t\7" 7 (skipSpaces >> anyWord8)

testTakeWhile :: Test
testTakeWhile =
  mkTestParseSuccess "takeWhile" "abc\7" "abc" (takeWhile (/= 7))

main :: IO ()
main = testRunner $ TestList
  [ mkTestParseSuccess "getByteString" "abcd" "abc" (getByteString 3)
  , testAnyWord8
  , mkTestParseFailure "anyWord8 not enough bytes" "" anyWord8
  , testCombineParsers
  , testAlternative
  , testSkipSpaces
  , testTakeWhile
  , mkTestParseSuccess "double" "10.2" (10.2 :: Double) double
  , mkTestParseSuccess "double scientific" "1.0e-9" (1.0e-9 :: Double) double
  , mkTestParseSuccess "double negative" "-1.0e-9" (-1.0e-9 :: Double) double
  ]