PU,
XmlPickler(..),
unpickleDoc,
- xp12Tuple,
+ xp13Tuple,
xpAttr,
xpElem,
xpInt,
xml_teams :: [NewsTeamXml],
xml_locations :: [NewsLocationXml],
xml_sms :: String,
+ xml_editor :: Maybe String,
xml_text :: String,
xml_continue :: String,
xml_time_stamp :: String }
db_sport :: String,
db_url :: String,
db_sms :: String,
+ db_editor :: Maybe String,
db_text :: String,
db_continue :: String }
deriving (Data, Eq, Show, Typeable)
def
def
db_sms
+ db_editor
db_text
db_continue
def
-- We don't need the key argument (from_xml_fk) since the XML type
-- contains more information in this case.
- from_xml (MessageXml _ _ c _ e f _ _ i j k _) =
- Message c e f i j k
+ from_xml (MessageXml _ _ c _ e f _ _ i j k l _) =
+ Message c e f i j k l
mkPersist tsn_codegen_config [groundhog|
pickle_message =
xpElem "message" $
xpWrap (from_tuple, to_tuple) $
- xp12Tuple (xpElem "XML_File_ID" xpInt)
+ xp13Tuple (xpElem "XML_File_ID" xpInt)
(xpElem "heading" xpText)
pickle_msg_id
(xpElem "category" xpText)
(xpList $ pickle_news_team)
(xpList $ pickle_location)
(xpElem "SMS" xpText)
+ (xpOption (xpElem "Editor" xpText))
(xpElem "text" xpText)
pickle_continue
(xpElem "time_stamp" xpText)
xml_teams m,
xml_locations m,
xml_sms m,
+ xml_editor m,
xml_text m,
xml_continue m,
xml_time_stamp m)
testGroup
"News tests"
[ test_news_fields_have_correct_names,
- test_pickle_of_unpickle_is_identity,
- test_unpickle_succeeds ]
+ test_pickle_of_unpickle_is_identity1,
+ test_pickle_of_unpickle_is_identity2,
+ test_unpickle_succeeds1,
+ test_unpickle_succeeds2 ]
test_news_fields_have_correct_names :: TestTree
map (\x -> tsn_db_field_namer "herp" "derp" 8675309 x 90210) field_names
actual :: [String]
- actual = ["mid", "sport", "url", "sms", "text", "continue"]
+ actual = ["mid", "sport", "url", "sms", "editor", "text", "continue"]
check (x,y) = (x @?= y)
-- | Warning, succeess of this test does not mean that unpickling
-- succeeded.
-test_pickle_of_unpickle_is_identity :: TestTree
-test_pickle_of_unpickle_is_identity =
+test_pickle_of_unpickle_is_identity1 :: TestTree
+test_pickle_of_unpickle_is_identity1 =
testCase "pickle composed with unpickle is the identity" $ do
let path = "test/xml/newsxml.xml"
(expected :: [MessageXml], actual) <- pickle_unpickle "message" path
actual @?= expected
+-- | Repeat of 'test_pickle_of_unpickle_is_identity1' with a different
+-- XML file.
+test_pickle_of_unpickle_is_identity2 :: TestTree
+test_pickle_of_unpickle_is_identity2 =
+ testCase "pickle composed with unpickle is the identity (with Editor)" $ do
+ let path = "test/xml/newsxml-with-editor.xml"
+ (expected :: [MessageXml], actual) <- pickle_unpickle "message" path
+ actual @?= expected
-test_unpickle_succeeds :: TestTree
-test_unpickle_succeeds =
+test_unpickle_succeeds1 :: TestTree
+test_unpickle_succeeds1 =
testCase "unpickling succeeds" $ do
let path = "test/xml/newsxml.xml"
actual <- unpickleable path pickle_message
let expected = True
actual @?= expected
+
+test_unpickle_succeeds2 :: TestTree
+test_unpickle_succeeds2 =
+ testCase "unpickling succeeds (with Editor)" $ do
+ let path = "test/xml/newsxml-with-editor.xml"
+ actual <- unpickleable path pickle_message
+ let expected = True
+ actual @?= expected