X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FEarlyLine.hs;h=fe11b980f5503a9a0bf5373fe04ec2638b3721a9;hb=fdd85d5ed7944e6a6373c99c2e341f370cd931f8;hp=98c5631e4138d08b18193e05452b1a68b6c27e4f;hpb=625be7f5011c1d9487b375a4cbd4486a069c42eb;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/EarlyLine.hs b/src/TSN/XML/EarlyLine.hs index 98c5631..fe11b98 100644 --- a/src/TSN/XML/EarlyLine.hs +++ b/src/TSN/XML/EarlyLine.hs @@ -42,11 +42,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, @@ -69,10 +67,12 @@ import Text.XML.HXT.Core ( xpWrap ) -- Local imports. +import Misc ( double_just ) import TSN.Codegen ( tsn_codegen_config ) 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(..) ) @@ -561,7 +561,7 @@ pickle_home_team = xpElem "teamH" pickle_team 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) @@ -573,10 +573,6 @@ pickle_team = to_tuple' (EarlyLineGameTeamXml u v w x y z) = (u, double_just v, w, x, double_just y, double_just z) - where - double_just val = case val of - Nothing -> Nothing - just_something -> Just just_something @@ -600,7 +596,7 @@ early_line_tests = -- test does not mean that unpickling succeeded. -- test_pickle_of_unpickle_is_identity :: TestTree -test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests" $ +test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests" [ check "pickle composed with unpickle is the identity" "test/xml/earlylineXML.xml", @@ -616,7 +612,7 @@ test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests" $ -- | Make sure we can actually unpickle these things. -- test_unpickle_succeeds :: TestTree -test_unpickle_succeeds = testGroup "unpickle tests" $ +test_unpickle_succeeds = testGroup "unpickle tests" [ check "unpickling succeeds" "test/xml/earlylineXML.xml", @@ -634,7 +630,7 @@ test_unpickle_succeeds = testGroup "unpickle tests" $ -- record. -- test_on_delete_cascade :: TestTree -test_on_delete_cascade = testGroup "cascading delete tests" $ +test_on_delete_cascade = testGroup "cascading delete tests" [ check "deleting early_lines deletes its children" "test/xml/earlylineXML.xml", @@ -647,7 +643,7 @@ test_on_delete_cascade = testGroup "cascading delete tests" $ let b = undefined :: EarlyLineGame actual <- withSqliteConn ":memory:" $ runDbConn $ do - runMigration silentMigrationLogger $ do + runMigrationSilent $ do migrate a migrate b _ <- dbimport results