+{-# LANGUAGE ScopedTypeVariables #-}
+
-- | (Un)picklers for data types present in The Sports Network XML
-- feed.
--
module TSN.Picklers (
pickler_tests,
xp_ambiguous_time,
+ xp_attr_option,
xp_date,
xp_date_padded,
xp_datetime,
fmt = "%A, %B %-d" ++ upper_suffix ++ " (" ++ date_format_padded ++ ")"
+-- | This is a replacement for @xpOption xpFoo@ within an 'xpAttr'.
+-- There's a bug <https://github.com/UweSchmidt/hxt/issues/39> in
+-- newer versions of HXT that prevents us from using the usual
+-- 'xpOption' solution, so this is our stopgap. It should work on
+-- any type that can be unpickled with a plain read/show.
+--
+xp_attr_option :: forall a. (Read a, Show a) => PU (Maybe a)
+xp_attr_option =
+ (to_a, from_a) `xpWrap` xpText
+ where
+ to_a :: String -> Maybe a
+ to_a = readMaybe
+
+ from_a :: Maybe a -> String
+ from_a Nothing = ""
+ from_a (Just x) = show x
+
-- | Create an 'XmlTree' containing only the given text. This is
-- useful for testing (un)picklers, where we don't want to have to
import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
import TSN.Picklers (
xp_ambiguous_time,
+ xp_attr_option,
xp_early_line_date,
xp_time_stamp )
import TSN.XmlImport ( XmlImport(..) )
pickle_team :: PU EarlyLineGameTeamXml
pickle_team =
xpWrap (from_tuple, to_tuple') $
- xp6Tuple (xpAttr "rotation" (xpOption xpInt))
+ xp6Tuple (xpAttr "rotation" xp_attr_option)
(xpOption $ xpAttr "line" (xpOption xpText))
(xpOption $ xpAttr "name" xpText)
(xpOption xpText)
import TSN.Database ( insert_or_select )
import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
import TSN.Location ( Location(..), pickle_location )
-import TSN.Picklers ( xp_time_stamp )
+import TSN.Picklers ( xp_attr_option, xp_time_stamp )
import TSN.Team ( Team(..) )
import TSN.XmlImport ( XmlImport(..) )
import Xml (
pickle_msg_id =
xpElem "msg_id" $
xpWrap (from_tuple, H.convert) $
- xpPair xpInt (xpAttr "EventId" (xpOption xpInt))
+ xpPair xpInt (xpAttr "EventId" xp_attr_option)
where
from_tuple = uncurryN MsgId
import TSN.Codegen ( tsn_codegen_config )
import TSN.Database ( insert_or_select )
import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
-import TSN.Picklers ( xp_date_padded, xp_tba_time, xp_time_stamp )
+import TSN.Picklers (
+ xp_attr_option,
+ xp_date_padded,
+ xp_tba_time,
+ xp_time_stamp )
import TSN.Team ( FromXmlFkTeams(..), Team(..) )
import TSN.XmlImport ( XmlImport(..), XmlImportFkTeams(..) )
import Xml (
xpElem "Casino" $
xpWrap (from_tuple, H.convert) $
xpTriple
- (xpAttr "ClientID" $ xpOption xpInt)
+ (xpAttr "ClientID" $ xp_attr_option)
(xpAttr "Name" $ xpOption xpText)
(xpOption xpText)
where
import TSN.Database ( insert_or_select )
import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
import TSN.Location ( Location(..), pickle_location )
-import TSN.Picklers ( xp_time_stamp )
+import TSN.Picklers ( xp_attr_option, xp_time_stamp )
import TSN.Team (
FromXmlFkTeams(..),
HTeam(..),
pickle_status =
xpElem "status" $
xpWrap (from_tuple, to_tuple') $
- xpTriple (xpAttr "numeral" $ xpOption xpInt)
+ xpTriple (xpAttr "numeral" $ xp_attr_option)
(xpOption $ xpAttr "type" $ xpOption xpText)
xpText
where