{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative ((<$>), (<*>), Applicative)
import Control.Monad.Trans.Resource(MonadThrow, runResourceT)
import qualified Data.ByteString.Lazy as L
import Data.Conduit (($$), ($=))
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 "unordered parser" $ do
it "can parse normal xml" parseNormal
it "can parse xml which contains unordered elements" parseUnordered
it "cannot parse empty xml" cannotParseEmpty
it "can parse xml which contains empty list" parseEmptyList
it "can parse xml which does not contain itemSet tag" parseNotAppearItemSet
it "cannot parse unexpected xml structure" cannotParseUnexpectedDataStructure
it "ignore unexpected tag" ignoreUnexpectedTag
it "can parse top data set" parseTopDataSet
it "can parse list of text" parseList
it "cannot parse list of text" parseListFailure
it "can parse escaped content" parseEscaped
it "can parse ec2response-like xml" parseEC2Response
describe "unordered parser using conduit" $ do
it "can parse normal xml" parseTopDataSetConduit
it "can parse empty itemSet" parseEmptyItemSetConduit
it "can parse ec2response-like xml" parseEC2ResponseConduit
parseError :: Selector ParseError
parseError = const True
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)
dataConv :: (MonadThrow m, Applicative m) => XmlElement -> m TestData
dataConv e = TestData
<$> e .< "id"
<*> e .< "name"
<*> e .< "description"
<*> elements "itemSet" "item" itemConv e
itemConv :: (MonadThrow m, Applicative m) => XmlElement -> m TestItem
itemConv e = TestItem
<$> e .< "id"
<*> e .< "name"
<*> e .< "description"
<*> elementM "subItem" itemConv e
getElement :: MonadThrow m => L.ByteString -> m XmlElement
getElement input = parseLBS def input $$ elementConsumer
parseNormal :: Expectation
parseNormal = do
result <- getElement input >>= element "data" dataConv
result `shouldBe` expectedData
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>"
]
expectedData = 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
result <- getElement input >>= element "data" dataConv
result `shouldBe` expectedData
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>"
]
expectedData = 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
}
]
}
cannotParseEmpty :: Expectation
cannotParseEmpty =
(getElement input >>= element "data" dataConv)
`shouldThrow` parseError
where
input = "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
parseEmptyList :: Expectation
parseEmptyList = do
result <- getElement input >>= element "data" dataConv
result `shouldBe` expectedData
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>"
]
expectedData = TestData
{ testDataId = 1
, testDataName = "test"
, testDataDescription = Just "this is test"
, testDataItemsSet = []
}
parseNotAppearItemSet :: Expectation
parseNotAppearItemSet = do
result <- getElement input >>= element "data" dataConv
result `shouldBe` expectedData
where
input = L.concat
[ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
, "<data>"
, " <id>1</id>"
, " <name>test</name>"
, "</data>"
]
expectedData = TestData
{ testDataId = 1
, testDataName = "test"
, testDataDescription = Nothing
, testDataItemsSet = []
}
cannotParseUnexpectedDataStructure :: Expectation
cannotParseUnexpectedDataStructure =
(getElement input >>= element "data" dataConv)
`shouldThrow` anyException -- 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
result <- getElement input >>= element "data" dataConv
result `shouldBe` expectedData
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>"
]
expectedData = TestData
{ testDataId = 1
, testDataName = "test"
, testDataDescription = Nothing
, testDataItemsSet = []
}
parseTopDataSet :: Expectation
parseTopDataSet = do
result <- getElement input >>= elements "dataSet" "data" dataConv
result `shouldBe` expectedData
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>"
]
expectedData =
[ TestData
{ testDataId = 1
, testDataName = "test1"
, testDataDescription = Just "this is test 1"
, testDataItemsSet = []
}
, TestData
{ testDataId = 2
, testDataName = "test2"
, testDataDescription = Nothing
, testDataItemsSet = []
}
]
parseTopDataSetConduit :: Expectation
parseTopDataSetConduit = do
result <- runResourceT $ parseLBS def input $= mapElem $=
convertConduit (element "data" dataConv) $$
CL.consume
result `shouldBe` expectedData
where
mapElem = elementConduit $ "dataSet" .- end "data"
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>"
]
expectedData =
[ TestData
{ testDataId = 1
, testDataName = "test1"
, testDataDescription = Just "this is test 1"
, testDataItemsSet = []
}
, TestData
{ testDataId = 2
, testDataName = "test2"
, testDataDescription = Nothing
, testDataItemsSet = []
}
]
parseEmptyItemSetConduit :: Expectation
parseEmptyItemSetConduit = do
result <- runResourceT $ parseLBS def input $= mapElem $=
convertConduit (element "data" dataConv) $$
CL.consume
result `shouldBe` expectedData
where
mapElem = elementConduit $ "dataSet" .- end "data"
input = L.concat
[ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
, "<dataSet>"
, "</dataSet>"
]
expectedData = []
parseList :: Expectation
parseList = do
result <- getElement input >>= elements "dataSet" "data" content
result `shouldBe` expectedData
where
input = L.concat
[ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
, "<dataSet>"
, "<data>item</data>"
, "<data>item</data>"
, "<data>item</data>"
, "</dataSet>"
]
expectedData = ["item", "item", "item"] :: [Text]
parseListFailure :: Expectation
parseListFailure =
(getElement input >>= elements "dataSet" "data" c)
`shouldThrow` parseError
where
c :: XmlElement -> IO Text
c = content
input = L.concat
[ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
, "<dataSet>"
, "<data><dummy/></data>"
, "</dataSet>"
]
parseEscaped :: Expectation
parseEscaped = do
result <- getElement input >>= (.< "escaped")
result `shouldBe` expectedData
where
input = "<escaped>{"version":"1.0","queryDate":"2013-05-08T21:09:40.443+0000","startDate":"2013-05-08T20:09:00.000+0000","statistic":"Maximum","period":3600,"recentDatapoints":[6.89],"threshold":90.5}</escaped>"
expectedData = "{\"version\":\"1.0\",\"queryDate\":\"2013-05-08T21:09:40.443+0000\",\"startDate\":\"2013-05-08T20:09:00.000+0000\",\"statistic\":\"Maximum\",\"period\":3600,\"recentDatapoints\":[6.89],\"threshold\":90.5}" :: Text
parseEC2Response :: Expectation
parseEC2Response = do
(rid, d, nt) <- getElement (input True False) >>= element "response" conv
rid `shouldBe` Just "req-id"
d `shouldBe` expectedData
nt `shouldBe` Nothing
(rid', d', nt') <- getElement (input False True) >>= element "response" conv
rid' `shouldBe` Nothing
d' `shouldBe` expectedData
nt' `shouldBe` Just "next-token"
where
conv :: (MonadThrow m, Applicative m) => XmlElement -> m (Maybe Text, TestData, Maybe Text)
conv e = (,,)
<$> e .< "requestId"
<*> element "data" dataConv e
<*> e .< "nextToken"
input hasReqId hasNextToken = L.concat
[ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
, "<response>"
, if hasReqId then " <requestId>req-id</requestId>" else ""
, " <data>"
, " <id>1</id>"
, " <name>test1</name>"
, " <itemSet>"
, " </itemSet>"
, " <description>this is test</description>"
, " </data>"
, if hasNextToken then " <nextToken>next-token</nextToken>" else ""
, "</response>"
]
expectedData = TestData
{ testDataId = 1
, testDataName = "test1"
, testDataDescription = Just "this is test"
, testDataItemsSet = []
}
parseEC2ResponseConduit :: Expectation
parseEC2ResponseConduit = do
(rid, d, nt) <- runResourceT $ parseLBS def (input True False) $= mapElem $$ sink
rid `shouldBe` Just ("req-id" :: Text)
d `shouldBe` expectedData
nt `shouldBe` (Nothing :: Maybe Text)
(rid', d', nt') <- runResourceT $ parseLBS def (input False True) $= mapElem $$ sink
rid' `shouldBe` Nothing
d' `shouldBe` expectedData
nt' `shouldBe` Just "next-token"
where
mapElem = elementConduit $ "response" .=
[ end "requestId"
, "dataSet" .- end "data"
, end "nextToken"
]
sink = do
rid <- tryConvert (.< "requestId")
d <- convertMany $ element "data" dataConv
nt <- tryConvert (.< "nextToken")
return (rid, d, nt)
input hasReqId hasNextToken = L.concat
[ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
, "<response>"
, if hasReqId then " <requestId>req-id</requestId>" else ""
, " <dataSet>"
, " <data>"
, " <id>1</id>"
, " <name>test1</name>"
, " <itemSet>"
, " </itemSet>"
, " <description>this is test</description>"
, " </data>"
, " <data>"
, " <id>2</id>"
, " <name>test2</name>"
, " </data>"
, " </dataSet>"
, if hasNextToken then " <nextToken>next-token</nextToken>" else ""
, "</response>"
]
expectedData =
[ TestData
{ testDataId = 1
, testDataName = "test1"
, testDataDescription = Just "this is test"
, testDataItemsSet = []
}
, TestData
{ testDataId = 2
, testDataName = "test2"
, testDataDescription = Nothing
, testDataItemsSet = []
}
]