From: Michael Orlitzky Date: Fri, 6 Mar 2015 21:20:46 +0000 (-0500) Subject: Fix present-but-empty vleague parsing in jfilexml. X-Git-Tag: 0.2.2^0 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=fdd85d5ed7944e6a6373c99c2e341f370cd931f8;p=dead%2Fhtsn-import.git Fix present-but-empty vleague parsing in jfilexml. Bump to version 0.2.2 in the cabal file. --- diff --git a/.ghci b/.ghci index dfeb6df..ecb3593 100644 --- a/.ghci +++ b/.ghci @@ -8,6 +8,7 @@ src/Configuration.hs src/ConnectionString.hs src/ExitCodes.hs + src/Misc.hs src/OptionalConfiguration.hs src/TSN/Codegen.hs src/TSN/Database.hs @@ -41,6 +42,7 @@ import CommandLine import Configuration import ConnectionString import ExitCodes +import Misc import OptionalConfiguration import TSN.Codegen import TSN.Database diff --git a/htsn-import.cabal b/htsn-import.cabal index df0f59c..30378fe 100644 --- a/htsn-import.cabal +++ b/htsn-import.cabal @@ -1,5 +1,5 @@ name: htsn-import -version: 0.2.1 +version: 0.2.2 cabal-version: >= 1.8 author: Michael Orlitzky maintainer: Michael Orlitzky @@ -283,6 +283,7 @@ executable htsn-import Configuration ConnectionString ExitCodes + Misc OptionalConfiguration TSN.Codegen TSN.Database diff --git a/src/Misc.hs b/src/Misc.hs new file mode 100644 index 0000000..cb992c7 --- /dev/null +++ b/src/Misc.hs @@ -0,0 +1,24 @@ +-- | Miscellaneous utility functions +module Misc ( + double_just ) +where + +-- | If given 'Nothing', return 'Nothing'. Otherwise wrap our argument +-- in another 'Just'. This is used when handling optional XML +-- elements that are optionally empty. If the element is missing, we +-- want 'Nothing'. And if the contents are missing, we want +-- 'Nothing' then too. But if something is present, we need @Just +-- (Just foo)@ for the types to match up. +-- +-- ==== __Examples__: +-- +-- >>> double_just Nothing +-- Nothing +-- >>> double_just (Just 2) +-- Just (Just 2) +-- +double_just :: (Maybe a) -> Maybe (Maybe a) +double_just val = + case val of + Nothing -> Nothing + just_something -> Just just_something diff --git a/src/TSN/XML/EarlyLine.hs b/src/TSN/XML/EarlyLine.hs index 7f5a890..fe11b98 100644 --- a/src/TSN/XML/EarlyLine.hs +++ b/src/TSN/XML/EarlyLine.hs @@ -67,6 +67,7 @@ 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 ( @@ -572,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 diff --git a/src/TSN/XML/JFile.hs b/src/TSN/XML/JFile.hs index 80d13fe..f570784 100644 --- a/src/TSN/XML/JFile.hs +++ b/src/TSN/XML/JFile.hs @@ -23,7 +23,7 @@ module TSN.XML.JFile ( where -- System imports -import Control.Monad ( forM_ ) +import Control.Monad ( forM_, join ) import Data.List ( intercalate ) import Data.String.Utils ( split ) import Data.Time ( UTCTime(..) ) @@ -61,6 +61,7 @@ import Text.XML.HXT.Core ( -- 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 ) @@ -458,7 +459,7 @@ pickle_gamelist = pickle_game :: PU JFileGameXml pickle_game = xpElem "game" $ - xpWrap (from_tuple, H.convert) $ + xpWrap (from_tuple, to_tuple') $ xp14Tuple (xpElem "game_id" xpInt) (xpElem "schedule_id" xpInt) pickle_odds_info @@ -466,7 +467,7 @@ pickle_game = (xpElem "Game_Date" xp_date_padded) (xpElem "Game_Time" xp_tba_time) pickle_away_team - (xpOption $ xpElem "vleague" xpText) + (xpOption $ xpElem "vleague" (xpOption xpText)) pickle_home_team (xpOption $ xpElem "hleague" xpText) (xpElem "vscore" xpInt) @@ -474,7 +475,11 @@ pickle_game = (xpOption $ xpElem "time_r" xpText) pickle_status where - from_tuple = uncurryN JFileGameXml + from_tuple (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = + JFileGameXml a b c d e f g (join h) i j k l m n + + to_tuple' (JFileGameXml a b c d e f g h i j k l m n) = + (a, b, c, d, e, f, g, double_just h, i, j, k, l, m, n) pickle_odds_info :: PU JFileGameOddsInfo diff --git a/src/TSN/XML/Scores.hs b/src/TSN/XML/Scores.hs index 858e62b..f7a03a6 100644 --- a/src/TSN/XML/Scores.hs +++ b/src/TSN/XML/Scores.hs @@ -57,6 +57,7 @@ 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 ) @@ -450,11 +451,7 @@ pickle_status = 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 \. @@ -522,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) diff --git a/test/Doctests.hs b/test/Doctests.hs index af4bcb5..07e4bd7 100644 --- a/test/Doctests.hs +++ b/test/Doctests.hs @@ -9,5 +9,6 @@ import Test.DocTest ( doctest ) main :: IO () main = doctest [ "-isrc", "-idist/build/autogen", + "src/Misc.hs", "src/TSN/Codegen.hs", "src/TSN/Picklers.hs"]