X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn-import.git;a=blobdiff_plain;f=src%2FTSN%2FXML%2FScores.hs;h=f7a03a61bac53376b69055258739cf333a0739db;hp=f0ce6dea8373a18a3cd5cfeaf2b8f522924889e6;hb=fdd85d5ed7944e6a6373c99c2e341f370cd931f8;hpb=ddb77c32ec8d5d76b10a5ea642810595a408b82f diff --git a/src/TSN/XML/Scores.hs b/src/TSN/XML/Scores.hs index f0ce6de..f7a03a6 100644 --- a/src/TSN/XML/Scores.hs +++ b/src/TSN/XML/Scores.hs @@ -32,11 +32,9 @@ import Database.Groundhog ( countAll, deleteAll, insert_, - migrate, - runMigration, - silentMigrationLogger ) + migrate ) import Database.Groundhog.Core ( DefaultKey ) -import Database.Groundhog.Generic ( runDbConn ) +import Database.Groundhog.Generic ( runDbConn, runMigrationSilent ) import Database.Groundhog.Sqlite ( withSqliteConn ) import Database.Groundhog.TH ( groundhog, @@ -59,11 +57,12 @@ import Text.XML.HXT.Core ( xpWrap ) -- Local imports. +import Misc ( double_just ) import TSN.Codegen ( tsn_codegen_config ) 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(..), @@ -446,17 +445,13 @@ pickle_status :: PU ScoreGameStatus 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 from_tuple (x,y,z) = ScoreGameStatus x (join y) z to_tuple' ScoreGameStatus{..} = - (db_status_numeral, s, db_status_text) - where - s = case db_status_type of - Nothing -> Nothing - Just _ -> Just db_status_type + (db_status_numeral, double_just db_status_type, db_status_text) -- | Convert a 'ScoreGameXml' to/from \. @@ -524,8 +519,7 @@ pickle_hteam = (xpOption xpText) -- Team name where from_tuple (x,y,z)= HTeamXml (HTeam (Team x Nothing z)) (join y) - to_tuple' (HTeamXml (HTeam t) Nothing) = (team_id t, Nothing, name t) - to_tuple' (HTeamXml (HTeam t) jhp) = (team_id t, Just jhp, name t) + to_tuple' (HTeamXml (HTeam t) jhp) = (team_id t, double_just jhp, name t) @@ -629,7 +623,7 @@ test_on_delete_cascade = testGroup "cascading delete tests" let d = undefined :: ScoreGame let e = undefined :: Score_Location actual <- withSqliteConn ":memory:" $ runDbConn $ do - runMigration silentMigrationLogger $ do + runMigrationSilent $ do migrate a migrate b migrate c