X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FTSN%2FXML%2FScores.hs;h=e4680a5f71e3d39dd41098c192b6262548aa9346;hb=6bf6a25053c2f721d67a70b1eaa1a018da5baa87;hp=8660b1f6b857aed7919d48fd9fd0d6ce1613658a;hpb=6c0f782525b51d1f99f337ddfebc31d54c499b3d;p=dead%2Fhtsn-import.git diff --git a/src/TSN/XML/Scores.hs b/src/TSN/XML/Scores.hs index 8660b1f..e4680a5 100644 --- a/src/TSN/XML/Scores.hs +++ b/src/TSN/XML/Scores.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} @@ -10,27 +11,26 @@ -- contains a single \ and some \s. -- module TSN.XML.Scores ( + dtd, pickle_message, -- * Tests scores_tests, -- * WARNING: these are private but exported to silence warnings - Score_ScoreLocationConstructor(..), + Score_LocationConstructor(..), ScoreConstructor(..), - ScoreGameConstructor(..), - ScoreGameTeamConstructor(..), - ScoreLocationConstructor(..), - ScoreGame_ScoreGameTeamConstructor(..) ) + ScoreGameConstructor(..) ) where -- System imports. -import Control.Monad ( forM_ ) +import Control.Monad ( join ) import Data.Data ( Data ) import Data.Time ( UTCTime ) import Data.Tuple.Curry ( uncurryN ) import Data.Typeable ( Typeable ) import Database.Groundhog ( countAll, - executeRaw, + deleteAll, + insert_, migrate, runMigration, silentMigrationLogger ) @@ -38,180 +38,318 @@ import Database.Groundhog.Core ( DefaultKey ) import Database.Groundhog.Generic ( runDbConn ) import Database.Groundhog.Sqlite ( withSqliteConn ) import Database.Groundhog.TH ( - defaultCodegenConfig, groundhog, mkPersist ) +import qualified GHC.Generics as GHC ( Generic ) import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.HUnit ( (@?=), testCase ) import Text.XML.HXT.Core ( PU, xp7Tuple, xp11Tuple, - xp12Tuple, xpAttr, xpElem, xpInt, xpList, xpOption, - xpPair, xpPrim, xpText, xpTriple, xpWrap ) -- Local imports. -import TSN.Codegen ( - tsn_codegen_config ) +import Generics ( Generic(..), to_tuple ) +import TSN.Codegen ( tsn_codegen_config ) +import TSN.Database ( insert_or_select ) import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) -import TSN.Picklers ( xp_gamedate, xp_time_stamp ) -import TSN.XmlImport ( XmlImport(..), XmlImportFk(..) ) +import TSN.Location ( Location(..), pickle_location ) +import TSN.Picklers ( xp_time_stamp ) +import TSN.Team ( + FromXmlFkTeams(..), + HTeam(..), + Team(..), + VTeam(..) ) +import TSN.XmlImport ( XmlImport(..), XmlImportFkTeams(..) ) import Xml ( + Child(..), FromXml(..), - FromXmlFk(..), ToDb(..), pickle_unpickle, unpickleable, unsafe_unpickle ) +-- | The DTD to which this module corresponds. Used to invoke dbimport. -- --- DB/XML Data types +dtd :: String +dtd = "scoresxml.dtd" + + +-- +-- * DB/XML Data types -- -- * Score / Message +-- | Database representation of a 'Message'. It lacks the +-- 'xml_locations' and 'xml_game' which are related via foreign keys +-- instead. +-- data Score = Score { db_xml_file_id :: Int, db_heading :: String, - db_game_id :: Int, - db_schedule_id :: Int, + db_game_id :: Maybe Int, -- ^ We've seen an empty one + db_schedule_id :: Maybe Int, -- ^ We've seen an empty one db_tsnupdate :: Maybe Bool, db_category :: String, db_sport :: String, - db_season_type :: String, + db_season_type :: Maybe String, -- ^ We've seen an empty one db_time_stamp :: UTCTime } + +-- | XML representation of the top level \ element (i.e. a +-- 'Score'). +-- data Message = Message { xml_xml_file_id :: Int, xml_heading :: String, - xml_game_id :: Int, - xml_schedule_id :: Int, + xml_game_id :: Maybe Int, -- ^ We've seen an empty one + xml_schedule_id :: Maybe Int, -- ^ We've seen an empty one xml_tsnupdate :: Maybe Bool, xml_category :: String, xml_sport :: String, - xml_locations :: [ScoreLocation], - xml_season_type :: String, + xml_locations :: [Location], + xml_season_type :: Maybe String, -- ^ We've seen an empty one xml_game :: ScoreGameXml, xml_time_stamp :: UTCTime } - deriving (Eq, Show) + deriving (Eq, GHC.Generic, Show) + + +-- | For 'Generics.to_tuple'. +-- +instance Generic Message + + +instance ToDb Message where + -- | The database representation of a 'Message' is a 'Score'. + type Db Message = Score + +instance FromXml Message where + -- | When converting from the XML representation to the database + -- one, we drop the list of locations which will be foreign-keyed to + -- us instead. + from_xml Message{..} = + Score { + db_xml_file_id = xml_xml_file_id, + db_heading = xml_heading, + db_game_id = xml_game_id, + db_schedule_id = xml_schedule_id, + db_tsnupdate = xml_tsnupdate, + db_category = xml_category, + db_sport = xml_sport, + db_season_type = xml_season_type, + db_time_stamp = xml_time_stamp } + + +-- | This lets us insert the XML representation 'Message' directly. +-- +instance XmlImport Message -- * ScoreGame / ScoreGameXml +-- | This is an embedded field within 'SportsGame'. Each \ +-- element has two attributes, a numeral and a type. It also +-- contains some text. Rather than put these in their own table, we +-- include them in the parent 'SportsGame'. +-- data ScoreGameStatus = ScoreGameStatus { - db_status_numeral :: Int, - db_status_type :: String, -- ^ These are probably only one-character long, - -- but they all take the same amount of space - -- in Postgres. + db_status_numeral :: Maybe Int, + db_status_type :: Maybe String, -- ^ These are probably only one-character, + -- long, but they all take the same + -- amount of space in Postgres. db_status_text :: String } deriving (Data, Eq, Show, Typeable) + +-- | Database representation of a game. +-- data ScoreGame = ScoreGame { db_scores_id :: DefaultKey Score, - db_vscore :: Int, - db_hscore :: Int, + db_away_team_id :: DefaultKey Team, + db_home_team_id :: DefaultKey Team, + db_away_team_score :: Int, + db_home_team_score :: Int, + db_away_team_pitcher :: Maybe String, -- ^ Found in the child \ + db_home_team_pitcher :: Maybe String, -- ^ Found in the child \ db_time_r :: Maybe String, -- ^ Time remaining, the format is uncertain. db_status :: ScoreGameStatus, db_notes :: Maybe String } +-- | XML representation of a \ element (i.e. a 'ScoreGame'). +-- data ScoreGameXml = ScoreGameXml { - xml_vteam :: ScoreGameVTeam, - xml_hteam :: ScoreGameHTeam, - xml_vscore :: Int, - xml_hscore :: Int, + xml_vteam :: VTeamXml, + xml_hteam :: HTeamXml, + xml_away_team_score :: Int, + xml_home_team_score :: Int, xml_time_r :: Maybe String, -- ^ Time remaining, the format is uncertain. xml_status :: ScoreGameStatus, xml_notes :: Maybe String } - deriving (Eq, Show) + deriving (Eq, GHC.Generic, Show) --- * ScoreGameTeam -data ScoreGameTeam = - ScoreGameTeam { - team_id :: String, - team_name :: String } - deriving (Eq, Show) +-- | For 'Generics.to_tuple'. +-- +instance Generic ScoreGameXml + + +instance ToDb ScoreGameXml where + -- | The database representation of a 'ScoreGameXml' is a + -- 'ScoreGame'. + -- + type Db ScoreGameXml = ScoreGame + + +instance Child ScoreGameXml where + -- | Each 'ScoreGameXml' is contained in (i.e. has a foreign key to) + -- a 'Score'. + -- + type Parent ScoreGameXml = Score + + +instance FromXmlFkTeams ScoreGameXml where + -- | To create a 'ScoreGame' from a 'ScoreGameXml', we need three + -- foreign keys: the parent message, and the away/home teams. + -- + from_xml_fk_teams fk fk_away fk_home ScoreGameXml{..} = + ScoreGame { + db_scores_id = fk, + db_away_team_id = fk_away, + db_home_team_id = fk_home, + db_away_team_score = xml_away_team_score, + db_home_team_score = xml_home_team_score, + db_away_team_pitcher = xml_vpitcher xml_vteam, + db_home_team_pitcher = xml_hpitcher xml_hteam, + db_time_r = xml_time_r, + db_status = xml_status, + db_notes = xml_notes } + +-- | This lets us import the database representation 'ScoreGameXml' +-- directly. +-- +instance XmlImportFkTeams ScoreGameXml + -newtype ScoreGameVTeam = - ScoreGameVTeam ScoreGameTeam - deriving (Eq, Show) -newtype ScoreGameHTeam = - ScoreGameHTeam ScoreGameTeam +-- * Score_Location + +-- | Join each 'Score' with its 'Location's. Database-only. We use a +-- join table because the locations are kept unique but there are +-- multiple locations per 'Score'. +-- +data Score_Location = + Score_Location + (DefaultKey Score) + (DefaultKey Location) + + +-- * HTeamXml / VTeamXml + +-- | XML Representation of a home team. This document type is unusual +-- in that the \ elements can have a pitcher attribute +-- attached to them. We still want to maintain the underlying 'Team' +-- representation, so we say that a home team is a 'Team' and +-- (maybe) a pitcher. +-- +data HTeamXml = + HTeamXml { + xml_ht :: HTeam, + xml_hpitcher :: Maybe String } deriving (Eq, Show) --- * ScoreGame_ScoreGameTeam +instance ToDb HTeamXml where + -- | The database analogue of a 'HTeamXml' is its 'Team'. + type Db HTeamXml = Team + +instance FromXml HTeamXml where + -- | The conversion from XML to database is simply the 'Team' accessor. + -- + from_xml = hteam . xml_ht --- | Join a ScoreGame with its home/away teams. +-- | Allow import of the XML representation directly, without +-- requiring a manual conversion to the database type first. -- -data ScoreGame_ScoreGameTeam = - ScoreGame_ScoreGameTeam - (DefaultKey ScoreGame) -- ^ game id - (DefaultKey ScoreGameTeam) -- ^ vteam id - (DefaultKey ScoreGameTeam) -- ^ hteam id +instance XmlImport HTeamXml --- * ScoreLocation -data ScoreLocation = - ScoreLocation { - city :: Maybe String, - state :: Maybe String, - country :: String } +-- | XML Representation of an away team. This document type is unusual +-- in that the \ elements can have a pitcher attribute +-- attached to them. We still want to maintain the underlying 'Team' +-- representation, so we say that an away team is a 'Team' and +-- (maybe) a pitcher. +-- +data VTeamXml = + VTeamXml { + xml_vt :: VTeam, + xml_vpitcher :: Maybe String } deriving (Eq, Show) +instance ToDb VTeamXml where + -- | The database analogue of a 'VTeamXml' is its 'Team'. + type Db VTeamXml = Team --- * Score_ScoreLocation +instance FromXml VTeamXml where + -- | The conversion from XML to database is simply the 'Team' accessor. + -- + from_xml = vteam . xml_vt -data Score_ScoreLocation = - Score_ScoreLocation - (DefaultKey Score) - (DefaultKey ScoreLocation) +-- | Allow import of the XML representation directly, without +-- requiring a manual conversion to the database type first. +-- +instance XmlImport VTeamXml +instance DbImport Message where + dbmigrate _ = + run_dbmigrate $ do + migrate (undefined :: Location) + migrate (undefined :: Team) + migrate (undefined :: Score) + migrate (undefined :: ScoreGame) + migrate (undefined :: Score_Location) + dbimport m = do + -- Insert the message and get its ID. + msg_id <- insert_xml m --- These types don't have special XML representations or field name --- collisions so we use the defaultCodegenConfig and give their --- fields nice simple names. -mkPersist defaultCodegenConfig [groundhog| -- entity: ScoreGameTeam - dbName: scores_games_teams - constructors: - - name: ScoreGameTeam - uniques: - - name: unique_scores_games_team - type: constraint - fields: [team_id] + -- Insert all of the locations contained within this message and + -- collect their IDs in a list. We use insert_or_select because + -- most of the locations will already exist, and we just want to + -- get the ID of the existing location when there's a collision. + location_ids <- mapM insert_or_select (xml_locations m) -- entity: ScoreLocation - dbName: scores_locations - constructors: - - name: ScoreLocation - uniques: - - name: unique_scores_location - type: constraint - fields: [city, state, country] + -- Now use that list to construct 'Score_ScoreLocation' objects, + -- and insert them. + mapM_ (insert_ . Score_Location msg_id) location_ids -|] + -- Insert the hteam/vteams, noting the IDs. + vteam_id <- insert_xml_or_select (xml_vteam $ xml_game m) + hteam_id <- insert_xml_or_select (xml_hteam $ xml_game m) + + -- Now use those along with the msg_id to construct the game. + insert_xml_fk_teams_ msg_id vteam_id hteam_id (xml_game m) + + return ImportSucceeded @@ -219,6 +357,7 @@ mkPersist defaultCodegenConfig [groundhog| -- use our own codegen to peel those off before naming the columns. mkPersist tsn_codegen_config [groundhog| - entity: Score + dbName: scores constructors: - name: Score uniques: @@ -236,6 +375,7 @@ mkPersist tsn_codegen_config [groundhog| - name: db_status_text dbName: status_text + - entity: ScoreGame dbName: scores_games constructors: @@ -250,35 +390,18 @@ mkPersist tsn_codegen_config [groundhog| - { name: status_type, dbName: status_type } - { name: status_text, dbName: status_text } -- entity: ScoreGame_ScoreGameTeam - dbName: scores__scores_games_teams - constructors: - - name: ScoreGame_ScoreGameTeam - fields: - - name: scoreGame_ScoreGameTeam0 # Default created by mkNormalFieldName - dbName: scores_games_id - reference: - onDelete: cascade - - name: scoreGame_ScoreGameTeam1 # Default created by mkNormalFieldName - dbName: scores_games_teams_vteam_id - reference: - onDelete: cascade - - name: scoreGame_ScoreGameTeam2 # Default created by mkNormalFieldName - dbName: scores_games_teams_hteam_id - reference: - onDelete: cascade -- entity: Score_ScoreLocation - dbName: scores__scores_locations +- entity: Score_Location + dbName: scores__locations constructors: - - name: Score_ScoreLocation + - name: Score_Location fields: - - name: score_ScoreLocation0 # Default created by mkNormalFieldName + - name: score_Location0 # Default created by mkNormalFieldName dbName: scores_id reference: onDelete: cascade - - name: score_ScoreLocation1 # Default created by mkNormalFieldName - dbName: scores_locations_id + - name: score_Location1 # Default created by mkNormalFieldName + dbName: locations_id reference: onDelete: cascade |] @@ -288,7 +411,7 @@ mkPersist tsn_codegen_config [groundhog| -- Pickling -- --- | Convert a 'Message' to/from XML. +-- | Convert a 'Message' to/from \. -- pickle_message :: PU Message pickle_message = @@ -296,57 +419,44 @@ pickle_message = xpWrap (from_tuple, to_tuple) $ xp11Tuple (xpElem "XML_File_ID" xpInt) (xpElem "heading" xpText) - (xpElem "game_id" xpInt) - (xpElem "schedule_id" xpInt) + (xpElem "game_id" (xpOption xpInt)) + (xpElem "schedule_id" (xpOption xpInt)) (xpOption $ xpElem "tsnupdate" xpPrim) (xpElem "category" xpText) (xpElem "sport" xpText) (xpList pickle_location) - (xpElem "seasontype" xpText) + (xpElem "seasontype" (xpOption xpText)) pickle_game (xpElem "time_stamp" xp_time_stamp) where from_tuple = uncurryN Message - to_tuple m = (xml_xml_file_id m, - xml_heading m, - xml_game_id m, - xml_schedule_id m, - xml_tsnupdate m, - xml_category m, - xml_sport m, - xml_locations m, - xml_season_type m, - xml_game m, - xml_time_stamp m) --- | Convert a 'ScoreLocation' to/from XML. +-- | Convert a 'ScoreGameStatus' to/from \. The \"type\" +-- attribute can be either missing or empty, so we're really parsing +-- a double-Maybe here. We use the monad join to collapse it into +-- one. See also: the hteam/vteam picklers. -- -pickle_location :: PU ScoreLocation -pickle_location = - xpElem "location" $ - xpWrap (from_tuple, to_tuple) $ - xpTriple (xpOption (xpElem "city" xpText)) - (xpOption (xpElem "state" xpText)) - (xpElem "country" xpText) - where - from_tuple = - uncurryN ScoreLocation - to_tuple l = (city l, state l, country l) - - pickle_status :: PU ScoreGameStatus pickle_status = xpElem "status" $ - xpWrap (from_tuple, to_tuple) $ - xpTriple (xpAttr "numeral" xpInt) - (xpAttr "type" xpText) + xpWrap (from_tuple, to_tuple') $ + xpTriple (xpAttr "numeral" $ xpOption xpInt) + (xpOption $ xpAttr "type" $ xpOption xpText) xpText where - from_tuple = uncurryN ScoreGameStatus - to_tuple (ScoreGameStatus x y z) = (x,y,z) + 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 + +-- | Convert a 'ScoreGameXml' to/from \. +-- pickle_game :: PU ScoreGameXml pickle_game = xpElem "game" $ @@ -360,40 +470,64 @@ pickle_game = (xpOption $ xpElem "notes" xpText) where from_tuple = uncurryN ScoreGameXml - to_tuple ScoreGameXml{..} = (xml_vteam, - xml_hteam, - xml_vscore, - xml_hscore, - xml_time_r, - xml_status, - xml_notes) -pickle_vteam :: PU ScoreGameVTeam +-- | Convert a 'VTeamXml' to/from \. The team names +-- always seem to be present here, but in the shared representation, +-- they're optional (because they show up blank elsewhere). So, we +-- pretend they're optional. +-- +-- The \"pitcher\" attribute is a little bit funny. Usually, when +-- there's no pitcher, the attribute itself is missing. But once in +-- a blue moon, it will be present with no text. We want to treat +-- both cases the same, so what we really parse is a Maybe (Maybe +-- String), and then use the monad 'join' to collapse it into a single +-- Maybe. +-- +pickle_vteam :: PU VTeamXml pickle_vteam = xpElem "vteam" $ - xpWrap (from_tuple, to_tuple) $ - xpPair (xpAttr "id" xpText) - xpText + xpWrap (from_tuple, to_tuple') $ + xpTriple (xpAttr "id" xpText) + (xpOption $ xpAttr "pitcher" (xpOption xpText)) + (xpOption xpText) -- Team name where - from_tuple = ScoreGameVTeam . uncurry ScoreGameTeam - to_tuple (ScoreGameVTeam (ScoreGameTeam x y)) = (x,y) + from_tuple (x,y,z) = VTeamXml (VTeam (Team x Nothing z)) (join y) + + to_tuple' (VTeamXml (VTeam t) Nothing) = (team_id t, Nothing, name t) + to_tuple' (VTeamXml (VTeam t) jvp) = (team_id t, Just jvp, name t) -pickle_hteam :: PU ScoreGameHTeam +-- | Convert a 'HTeamXml' to/from \. Identical to 'pickle_vteam' +-- modulo the \"h\" and \"v\". The team names always seem to be +-- present here, but in the shared representation, they're optional +-- (because they show up blank elsewhere). So, we pretend they're +-- optional. +-- +-- The \"pitcher\" attribute is a little bit funny. Usually, when +-- there's no pitcher, the attribute itself is missing. But once in +-- a blue moon, it will be present with no text. We want to treat +-- both cases the same, so what we really parse is a Maybe (Maybe +-- String), and then use the monad 'join' to collapse it into a single +-- Maybe. +-- +pickle_hteam :: PU HTeamXml pickle_hteam = xpElem "hteam" $ - xpWrap (from_tuple, to_tuple) $ - xpPair (xpAttr "id" xpText) - xpText + xpWrap (from_tuple, to_tuple') $ + xpTriple (xpAttr "id" xpText) + (xpOption $ xpAttr "pitcher" (xpOption xpText)) + (xpOption xpText) -- Team name where - from_tuple = ScoreGameHTeam . uncurry ScoreGameTeam - to_tuple (ScoreGameHTeam (ScoreGameTeam x y)) = (x,y) + 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) + ---- ---- Tasty tests ---- +-- +-- * Tasty tests +-- -- | A list of all tests for this module. -- @@ -401,7 +535,8 @@ scores_tests :: TestTree scores_tests = testGroup "Scores tests" - [ test_pickle_of_unpickle_is_identity, + [ test_on_delete_cascade, + test_pickle_of_unpickle_is_identity, test_unpickle_succeeds ] @@ -415,7 +550,16 @@ test_pickle_of_unpickle_is_identity = testGroup "pickle-unpickle tests" "test/xml/scoresxml.xml", check "pickle composed with unpickle is the identity (no locations)" - "test/xml/scoresxml-no-locations.xml" ] + "test/xml/scoresxml-no-locations.xml", + + check "pickle composed with unpickle is the identity (pitcher, no type)" + "test/xml/scoresxml-pitcher-no-type.xml", + + check "pickle composed with unpickle is the identity (empty numeral)" + "test/xml/scoresxml-empty-numeral.xml", + + check "pickle composed with unpickle is the identity (empty type)" + "test/xml/scoresxml-empty-type.xml" ] where check desc path = testCase desc $ do (expected, actual) <- pickle_unpickle pickle_message path @@ -430,9 +574,71 @@ test_unpickle_succeeds = testGroup "unpickle tests" "test/xml/scoresxml.xml", check "unpickling succeeds (no locations)" - "test/xml/scoresxml-no-locations.xml" ] + "test/xml/scoresxml-no-locations.xml", + + check "unpickling succeeds (pitcher, no type)" + "test/xml/scoresxml-pitcher-no-type.xml", + + check "unpickling succeeds (empty numeral)" + "test/xml/scoresxml-empty-numeral.xml", + + check "unpickling succeeds (empty type)" + "test/xml/scoresxml-empty-type.xml" ] where check desc path = testCase desc $ do actual <- unpickleable path pickle_message let expected = True actual @?= expected + + +-- | Make sure everything gets deleted when we delete the top-level +-- record. +-- +test_on_delete_cascade :: TestTree +test_on_delete_cascade = testGroup "cascading delete tests" + [ check "unpickling succeeds" + "test/xml/scoresxml.xml" + 4, -- 2 teams, 2 locations + + check "unpickling succeeds (no locations)" + "test/xml/scoresxml-no-locations.xml" + 2, -- 2 teams, 0 locations + + check "unpickling succeeds (pitcher, no type)" + "test/xml/scoresxml-pitcher-no-type.xml" + 3, -- 2 teams, 1 location + + check "unpickling succeeds (empty numeral)" + "test/xml/scoresxml-empty-numeral.xml" + 3, -- 2 teams, 1 location + + check "unpickling succeeds (empty type)" + "test/xml/scoresxml-empty-type.xml" + 4 -- 2 teams, 2 locations + ] + where + check desc path expected = testCase desc $ do + score <- unsafe_unpickle path pickle_message + let a = undefined :: Location + let b = undefined :: Team + let c = undefined :: Score + let d = undefined :: ScoreGame + let e = undefined :: Score_Location + actual <- withSqliteConn ":memory:" $ runDbConn $ do + runMigration silentMigrationLogger $ do + migrate a + migrate b + migrate c + migrate d + migrate e + _ <- dbimport score + -- No idea how 'delete' works, so do this instead. + deleteAll c + count_a <- countAll a + count_b <- countAll b + count_c <- countAll c + count_d <- countAll d + count_e <- countAll e + return $ sum [count_a, count_b, count_c, + count_d, count_e ] + actual @?= expected