{-# LANGUAGE OverloadedStrings #-}
-- | Simple test suite.
module Main where
import Data.Either (isRight)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Test.Hspec
import Xeno.SAX (validate)
import Xeno.DOM (Content(..), parse, name, contents, attributes, children)
import Xeno.Types
main :: IO ()
main = hspec spec
spec :: SpecWith ()
spec = do
describe "Xeno.DOM tests" $ do
it "DOM from bytestring substring" $ do
let substr = BS.drop 5 "5<8& xml"
parsedRoot = fromRightE $ parse substr
name parsedRoot `shouldBe` "valid"
it "Leading whitespace characters are accepted by parse" $
isRight (parse "\n") `shouldBe` True
let doc =
parse
"\n"
it "children test" $
map name (children $ fromRightE doc) `shouldBe` ["test", "test", "b", "test", "test"]
it "attributes" $
attributes (head (children $ fromRightE doc)) `shouldBe` [("id", "1"), ("extra", "2")]
it "xml prologue test" $ do
let docWithPrologue = "\nHello, world!"
parsedRoot = fromRightE $ Xeno.DOM.parse docWithPrologue
name parsedRoot `shouldBe` "greeting"
describe
"hexml tests"
(do mapM_
(\(v, i) -> it (show i) (shouldBe (validate i) v))
(hexml_examples_sax ++ extra_examples_sax)
mapM_
(\(v, i) -> it (show i) (shouldBe (either (Left . show) (Right . id) (contents <$> parse i)) v))
cdata_tests
-- If this works without crashing we're happy.
let nsdoc = "Content."
it
"namespaces" $
validate nsdoc `shouldBe` True
)
hexml_examples_sax :: [(Bool, ByteString)]
hexml_examples_sax =
[(True, "herethere")
,(True, "")
,(True, "")
,(True, "here more text at the end")
,(True, "") -- SAX doesn't care about tag balancing
,(False, "\nHello, world!")
]
extra_examples_sax :: [(Bool, ByteString)]
extra_examples_sax =
[(True, "")
,(True, "")
,(True, "")
]
-- | We want to make sure that the parser doesn't jump out of the CDATA
-- area prematurely because it encounters a single ].
cdata_tests :: [(Either a [Content], ByteString)]
cdata_tests =
[ ( Right [CData "Oneliner CDATA."]
, "")
, ( Right [CData "This is strong but not XML tags."]
, "This is strong but not XML tags.]]>")
, ( Right [CData "A lonely ], sad isn't it?"]
, "")
]
-- | Horrible hack. Don't try this at home.
fromRightE :: Either XenoException a -> a
fromRightE = either (error . show) id
mapLeft :: Applicative f => (a -> f b) -> Either a b -> f b
mapLeft f = either f pure
mapRight :: Applicative f => (b -> f a) -> Either a b -> f a
mapRight = either pure