{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE ScopedTypeVariables #-} module Main where import Control.Applicative (many) import qualified Data.ByteString as B import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Lazy as BL import qualified Data.HashMap.Strict as HM import qualified Data.Text as T import qualified Test.Tasty as Tasty import qualified Test.Tasty.Runners as Tasty import Test.Tasty.QuickCheck ((===)) import qualified Test.Tasty.QuickCheck as QC import qualified Test.Tasty.HUnit as HU import Test.Tasty.HUnit ((@?=)) import qualified Test.QuickCheck.Instances () import qualified Xmlbf as X import qualified Xmlbf.Xeno as Xx -------------------------------------------------------------------------------- main :: IO () main = Tasty.defaultMainWithIngredients [ Tasty.consoleTestReporter , Tasty.listingTests ] tt_main -------------------------------------------------------------------------------- tt_main :: Tasty.TestTree tt_main = -- All of the testcases suffixed "-BAD" below are actually undesired results -- provided by xeno. They are kept here as an acknowledgement of this -- known behavior. Tasty.testGroup "main" [ HU.testCase "1" $ do Xx.fromRawXml "" @?= Right [] , HU.testCase "2" $ do Xx.fromRawXml " " @?= Right (X.text " ") , HU.testCase "3" $ do Xx.fromRawXml "" @?= Right (X.element "foo" [] []) , HU.testCase "4" $ do Xx.fromRawXml "" @?= Right (X.element "foo" [] []) , HU.testCase "5" $ do Xx.fromRawXml " " @?= Right (X.text " " <> X.element "foo" [] []) , HU.testCase "6" $ do Xx.fromRawXml " " @?= Right (X.text " " <> X.element "foo" [] [] <> X.text " ") , HU.testCase "7" $ do Xx.fromRawXml "" @?= Right (X.element "foo" [("a", "")] []) , HU.testCase "8" $ do Xx.fromRawXml "" @?= Right (X.element "foo" [("a", "b")] []) , HU.testCase "9" $ do Xx.fromRawXml "" @?= Right (X.element "foo" [("a", "b"), ("c", "")] []) , HU.testCase "10" $ do Xx.fromRawXml "" @?= Right (X.element "foo" [("a", "b"), ("c", "d")] []) , HU.testCase "11" $ do Xx.fromRawXml "bar" @?= Right (X.element "foo" [("a", "b")] (X.text "bar")) , HU.testCase "12" $ do Xx.fromRawXml "" @?= Right (X.element "foo" [("a", "b")] (X.element "bar" [] [])) , HU.testCase "13-BAD" $ do -- This should return on either a 'Left', or a @'Right' [X.element "foo" [] []]@. -- The reason why it doesn't is because 'Xx.fromRawXml' wraps @""@ as -- @""@ before parsing, which causes the @x@ element to be -- successfully parsed, but not the inner @foo@. This is a problem in Xeno. Xx.fromRawXml "" @?= Right [] , HU.testCase "14-BAD" $ do -- Similar to test case 13-BAD. This is wrong, but it is what Xeno returns. Xx.fromRawXml "" @?= Right (X.element "foo" [] []) , HU.testCase "15" $ do Xx.fromRawXml "<foo/>" @?= Right (X.text "") , HU.testCase "16" $ do Xx.fromRawXml "&lt;" @?= Right (X.text "<") , HU.testCase "17" $ do -- Test BOM presence Xx.fromRawXml "\xEF\xBB\xBF" @?= Xx.fromRawXml "" ]