1 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE QuasiQuotes #-}
4 {-# LANGUAGE ScopedTypeVariables #-}
5 {-# LANGUAGE StandaloneDeriving #-}
6 {-# LANGUAGE TemplateHaskell #-}
7 {-# LANGUAGE TypeFamilies #-}
9 -- | Parse TSN XML for the DTD "newsxml.dtd". Each document contains a
10 -- root element \<message\> that contains an entire news item.
17 import Data.Tuple.Curry ( uncurryN )
18 import Database.Groundhog()
19 import Database.Groundhog.TH
20 import Test.Tasty ( TestTree, testGroup )
21 import Test.Tasty.HUnit ( (@?=), testCase )
22 import Text.XML.HXT.Core (
37 import Xml ( pickle_unpickle )
66 time_stamp :: String }
70 -- mkPersist defaultCodegenConfig [groundhog|
76 pickle_msg_id :: PU MsgId
79 xpWrap (from_tuple, to_tuple) $
80 xpPair xpPrim (xpAttr "EventId" xpText0)
82 from_tuple = uncurryN MsgId
83 to_tuple m = (msg_id_text m, event_id m)
85 instance XmlPickler MsgId where
86 xpickle = pickle_msg_id
88 pickle_location :: PU Location
91 xpWrap (from_tuple, to_tuple) $
92 xpTriple (xpElem "city" xpText)
93 (xpElem "state" xpPrim)
94 (xpElem "location" xpText)
96 from_tuple = uncurryN Location
97 to_tuple l = (city l, state l, country l)
99 instance XmlPickler Location where
100 xpickle = pickle_location
103 pickle_message :: PU Message
106 xpWrap (from_tuple, to_tuple) $
107 xp12Tuple (xpElem "XML_File_ID" xpPrim)
109 (xpElem "heading" xpText)
110 (xpElem "category" xpText)
111 (xpElem "sport" xpText)
112 (xpElem "url" xpText)
113 (xpList $ xpElem "team" xpText)
115 (xpElem "sms" xpText)
116 (xpElem "text" xpText)
117 (xpElem "continue" xpText)
118 (xpElem "time_stamp" xpText)
120 from_tuple = uncurryN Message
121 to_tuple m = (xml_file_id m,
134 instance XmlPickler Message where
135 xpickle = pickle_message
140 news_tests :: TestTree
144 [ test_pickle_of_unpickle_is_identity ]
147 test_pickle_of_unpickle_is_identity :: TestTree
148 test_pickle_of_unpickle_is_identity =
149 testCase "pickle composed with unpickle is the identity" $ do
150 let path = "test/xml/newsxml.xml"
151 (expected :: [Message], actual) <- pickle_unpickle "message" path