{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative ((<$>), (<*>), Applicative)
import qualified Data.ByteString.Lazy as L
import Data.Conduit (($$), ($=), MonadThrow (..), runResourceT)
import qualified Data.Conduit.List as CL
import Data.Text (Text)
import Test.Hspec
import Text.XML.Stream.Parse (parseLBS, def)
import Cloud.AWS.Lib.Parser.Unordered
main :: IO ()
main = hspec $ do
describe "xml parser" $ do
it "parse normal xml" parseNormal
it "parse xml which contains unordered elements" parseUnordered
it "parse xml which contains empty list" parseEmptyList
it "parse xml which does not contain itemSet tag" parseNotAppearItemSet
it "cannot parse unexpected xml structure" notParseUnexpectedDataStructure
it "ignore unexpected tag" ignoreUnexpectedTag
it "parse top data set" parseTopDataSet
describe "xml parser of maybe version" $
it "parse empty xml" parseEmpty
describe "xml parser of conduit version" $ do
it "parse normal xml" parseTopDataSetConduit
it "parse empty itemSet" parseEmptyItemSetConduit
data TestData = TestData
{ testDataId :: Int
, testDataName :: Text
, testDataDescription :: Maybe Text
, testDataItemsSet :: [TestItem]
} deriving (Eq, Show)
data TestItem = TestItem
{ testItemId :: Int
, testItemName :: Text
, testItemDescription :: Maybe Text
, testItemSubItem :: Maybe TestItem
} deriving (Eq, Show)
parseTestData :: (MonadThrow m, Applicative m) => SimpleXML -> m TestData
parseTestData xml = TestData
<$> xml .< "id"
<*> xml .< "name"
<*> xml .< "description"
<*> getElements xml "itemSet" "item" parseTestItem
parseTestItem :: (MonadThrow m, Applicative m) => SimpleXML -> m TestItem
parseTestItem xml = TestItem
<$> xml .< "id"
<*> xml .< "name"
<*> xml .< "description"
<*> getElementM xml "subItem" parseTestItem
parseNormal :: Expectation
parseNormal = do
d <- runResourceT $ parseLBS def input $$
xmlParser (\xml -> getElement xml "data" parseTestData)
d `shouldBe` input'
where
input = L.concat
[ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
, "<data>"
, " <id>1</id>"
, " <name>test</name>"
, " <description>this is test</description>"
, " <itemSet>"
, " <item>"
, " <id>1</id>"
, " <name>item1</name>"
, " <description>this is item1</description>"
, " <subItem>"
, " <id>11</id>"
, " <name>item1sub</name>"
, " </subItem>"
, " </item>"
, " <item>"
, " <id>2</id>"
, " <name>item2</name>"
, " </item>"
, " </itemSet>"
, "</data>"
]
input' = TestData
{ testDataId = 1
, testDataName = "test"
, testDataDescription = Just "this is test"
, testDataItemsSet =
[ TestItem
{ testItemId = 1
, testItemName = "item1"
, testItemDescription = Just "this is item1"
, testItemSubItem = Just TestItem
{ testItemId = 11
, testItemName = "item1sub"
, testItemDescription = Nothing
, testItemSubItem = Nothing
}
}
, TestItem
{ testItemId = 2
, testItemName = "item2"
, testItemDescription = Nothing
, testItemSubItem = Nothing
}
]
}
parseUnordered :: Expectation
parseUnordered = do
d <- runResourceT $ parseLBS def input $$
xmlParser (\xml -> getElement xml "data" parseTestData)
d `shouldBe` input'
where
input = L.concat
[ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
, "<data>"
, " <name>test</name>"
, " <itemSet>"
, " <item>"
, " <name>item1</name>"
, " <id>1</id>"
, " <subItem>"
, " <name>item1sub</name>"
, " <id>11</id>"
, " </subItem>"
, " <description>this is item1</description>"
, " </item>"
, " <item>"
, " <name>item2</name>"
, " <id>2</id>"
, " </item>"
, " </itemSet>"
, " <description>this is test</description>"
, " <id>1</id>"
, "</data>"
]
input' = TestData
{ testDataId = 1
, testDataName = "test"
, testDataDescription = Just "this is test"
, testDataItemsSet =
[ TestItem
{ testItemId = 1
, testItemName = "item1"
, testItemDescription = Just "this is item1"
, testItemSubItem = Just TestItem
{ testItemId = 11
, testItemName = "item1sub"
, testItemDescription = Nothing
, testItemSubItem = Nothing
}
}
, TestItem
{ testItemId = 2
, testItemName = "item2"
, testItemDescription = Nothing
, testItemSubItem = Nothing
}
]
}
parseEmpty :: Expectation
parseEmpty = do
d <- runResourceT $ parseLBS def input $$
xmlParserM (\xml -> getElement xml "data" parseTestData)
d `shouldBe` input'
where
input = "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
input' = Nothing
parseEmptyList :: Expectation
parseEmptyList = do
d <- runResourceT $ parseLBS def input $$
xmlParser (\xml -> getElement xml "data" parseTestData)
d `shouldBe` input'
where
input = L.concat
[ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
, "<data>"
, " <id>1</id>"
, " <name>test</name>"
, " <description>this is test</description>"
, " <itemSet>"
, " </itemSet>"
, "</data>"
]
input' = TestData
{ testDataId = 1
, testDataName = "test"
, testDataDescription = Just "this is test"
, testDataItemsSet = []
}
parseNotAppearItemSet :: Expectation
parseNotAppearItemSet = do
d <- runResourceT $ parseLBS def input $$
xmlParser (\xml -> getElement xml "data" parseTestData)
d `shouldBe` input'
where
input = L.concat
[ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
, "<data>"
, " <id>1</id>"
, " <name>test</name>"
, "</data>"
]
input' = TestData
{ testDataId = 1
, testDataName = "test"
, testDataDescription = Nothing
, testDataItemsSet = []
}
notParseUnexpectedDataStructure :: Expectation
notParseUnexpectedDataStructure =
runResourceT (parseLBS def input $$
xmlParser (\xml -> getElement xml "data" parseTestData))
`shouldThrow` errorCall "FromText error: no text name=name"
where
input = L.concat
[ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
, "<data>"
, " <id>1</id>"
, " <name>"
, " <first>foo</first>"
, " <last>bar</last>"
, " </name>"
, "</data>"
]
ignoreUnexpectedTag :: Expectation
ignoreUnexpectedTag = do
d <- runResourceT $ parseLBS def input $$
xmlParser (\xml -> getElement xml "data" parseTestData)
d `shouldBe` input'
where
input = L.concat
[ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
, "<data>"
, " <id>1</id>"
, " <unexpectedTag>tag</unexpectedTag>"
, " <name>test</name>"
, " <itemSet>"
, " <unexpectedTag>tag</unexpectedTag>"
, " <unexpectedTag>tag</unexpectedTag>"
, " </itemSet>"
, " <unexpectedTag>tag</unexpectedTag>"
, "</data>"
]
input' = TestData
{ testDataId = 1
, testDataName = "test"
, testDataDescription = Nothing
, testDataItemsSet = []
}
parseTopDataSet :: Expectation
parseTopDataSet = do
d <- runResourceT $ parseLBS def input $$
xmlParser (\xml -> getElements xml "dataSet" "data" parseTestData)
d `shouldBe` input'
where
input = L.concat
[ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
, "<dataSet>"
, " <data>"
, " <id>1</id>"
, " <name>test1</name>"
, " <itemSet>"
, " </itemSet>"
, " <description>this is test 1</description>"
, " </data>"
, " <data>"
, " <id>2</id>"
, " <name>test2</name>"
, " </data>"
, "</dataSet>"
]
input' =
[ TestData
{ testDataId = 1
, testDataName = "test1"
, testDataDescription = Just "this is test 1"
, testDataItemsSet = []
}
, TestData
{ testDataId = 2
, testDataName = "test2"
, testDataDescription = Nothing
, testDataItemsSet = []
}
]
parseTopDataSetConduit :: Expectation
parseTopDataSetConduit = do
d <- runResourceT $ parseLBS def input $=
xmlParserConduit "dataSet" (\xml -> getElement xml "data" parseTestData) $$
CL.consume
d `shouldBe` input'
where
input = L.concat
[ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
, "<dataSet>"
, " <data>"
, " <id>1</id>"
, " <name>test1</name>"
, " <itemSet>"
, " </itemSet>"
, " <description>this is test 1</description>"
, " </data>"
, " <data>"
, " <id>2</id>"
, " <name>test2</name>"
, " </data>"
, "</dataSet>"
]
input' =
[ TestData
{ testDataId = 1
, testDataName = "test1"
, testDataDescription = Just "this is test 1"
, testDataItemsSet = []
}
, TestData
{ testDataId = 2
, testDataName = "test2"
, testDataDescription = Nothing
, testDataItemsSet = []
}
]
parseEmptyItemSetConduit :: Expectation
parseEmptyItemSetConduit = do
d <- runResourceT $ parseLBS def input $=
xmlParserConduit "dataSet" (\xml -> getElement xml "data" parseTestData) $$
CL.consume
d `shouldBe` input'
where
input = L.concat
[ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
, "<dataSet>"
, "</dataSet>"
]
input' = []