{-# 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 -------------------------------------------------------------------------------- -- | Like 'X.element' but it crashes if the result is a 'Left'. el :: T.Text -> [(T.Text, T.Text)] -> [X.Node] -> X.Node el t as cs = case X.element t (HM.fromList as) cs of Right x -> x Left s -> error ("el: Left " ++ show s ++ "\"") 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.nodes "" @?= Right [] , HU.testCase "2" $ do Xx.nodes " " @?= Right [X.text " "] , HU.testCase "3" $ do Xx.nodes "" @?= Right [el "foo" [] []] , HU.testCase "4" $ do Xx.nodes "" @?= Right [el "foo" [] []] , HU.testCase "5" $ do Xx.nodes " " @?= Right [X.text " ", el "foo" [] []] , HU.testCase "6" $ do Xx.nodes " " @?= Right [X.text " ", el "foo" [] [], " "] , HU.testCase "7" $ do Xx.nodes "" @?= Right [el "foo" [("a", "")] []] , HU.testCase "8" $ do Xx.nodes "" @?= Right [el "foo" [("a", "b")] []] , HU.testCase "9" $ do Xx.nodes "" @?= Right [el "foo" [("a", "b"), ("c", "")] []] , HU.testCase "10" $ do Xx.nodes "" @?= Right [el "foo" [("a", "b"), ("c", "d")] []] , HU.testCase "11" $ do Xx.nodes "bar" @?= Right [el "foo" [("a", "b")] ["bar"]] , HU.testCase "12" $ do Xx.nodes "" @?= Right [el "foo" [("a", "b")] [el "bar" [] []]] , HU.testCase "13-BAD" $ do -- This should return on either a 'Left', or a @'Right' [el "foo" [] []]@. -- The reason why it doesn't is because 'Xx.nodes' 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.nodes "" @?= Right [] , HU.testCase "14-BAD" $ do -- Similar to test case 13-BAD. This is wrong, but it is what Xeno returns. Xx.nodes "" @?= Right [el "foo" [] []] , HU.testCase "15" $ do Xx.nodes "<foo/>" @?= Right [""] , HU.testCase "16" $ do Xx.nodes "&lt;" @?= Right ["<"] ]