Railway period calculations

RailwayPeriod.hs

railwayPeriodStart :: Integer -> Integer -> Day
railwayPeriodStart yr pd
  | pd == 1   = fromGregorian (yr - 1) 4 1
  | otherwise = addDays (28 * pd) (dayZero yr)

railwayPeriodEnd :: Integer -> Integer -> Day
railwayPeriodEnd yr pd = addDays (-1) $ railwayPeriodStart yr' (pd' + 1)
  where (yr', pd') = divMod (yr * 13 + pd) 13

railwayPeriodContaining :: Day -> (Integer, Integer)
railwayPeriodContaining d =
  (railwayYear, max 1 $ min 13 $ div (diffDays d $ dayZero railwayYear) 28)
  where
  railwayYear = let (yy,mm,_) = toGregorian d in yy + if mm < 4 then 0 else 1

{- Period 2 normally starts on the Sunday before the first Thursday in May, so this is 56 days before that. -}
dayZero :: Integer -> Day
dayZero railwayYear
  | railwayYear == 1994 = fromGregorian 1994 02 28
  | otherwise    = addDays (mod (4 - toModifiedJulianDay basisDay) 7) basisDay
  where basisDay = fromGregorian (railwayYear - 1) 3 2