import HUnit
import Time
import System.Environment
import Text.Regex

-- We have (Weather Summaries) and (Weather Forecasts) in files.
type Forecast = (String, [(String, String, (Integer, Integer), Integer)])
type Summary = (String, Double, (Integer, Integer), String)
type Weather a = (CalendarTime, Either a String)


-- We don't record the day on which the forcast made in ForecastRecords
data ForecastRecord = ForecastRecord { forYear :: Integer, forMonth :: Integer, forDay :: Int,
                                       clouds :: String, minT :: Integer, maxT :: Integer,
                                       precip :: Integer }

instance Eq ForecastRecord where
  (==) (ForecastRecord a b c d e f g) (ForecastRecord a' b' c' d' e' f' g') =
    a == a' && b == b' && c == c' && d == d' && e == e' && f == f' && g == g'

instance Show ForecastRecord where
  show (ForecastRecord a b c d e f g) = 
    "(ForecastRecord " ++ (unwords [show a, show b, show c, d, show e, show f, show g]) ++ " )"


data SummaryRecord = SummaryRecord { year :: Integer, month :: Integer, day :: Int,
                                     sClouds :: Double, sMinT :: Integer, sMaxT :: Integer,
                                     sPrecip :: String }
                                     
instance Eq SummaryRecord where
  (==) (SummaryRecord a b c d e f g) (SummaryRecord a' b' c' d' e' f' g') =
    a == a' && b == b' && c == c' && d == d' && e == e' && f == f' && g == g'

instance Show SummaryRecord where
  show (SummaryRecord a b c d e f g) = 
    "(SummaryRecord " ++ (unwords [show a, show b, show c, show d, show e, show f, g]) ++ " )"


-- reads several things from a String into a list, as though
-- they were surrounded by '[]' and separated by ','
readMany :: (Read a) => String -> [a]
readMany s =
 if (lex s) == [("", "")] then
    []
 else
    case reads s of
      [(x, new_s)] -> x : readMany new_s
      o -> error ("Parse error in readMany: " ++ (show s))

readManyTests = TestLabel "readMany" (TestList [
  readMany "1 2 3" ~=? [1, 2, 3],
  readMany "(1, 2) (3, 5) " ~=? [(1,2), (3,5)],
  readMany "" ~=? ([] :: [Integer]),
  readMany "  " ~=? ([] :: [Integer])])


-- raises an error if no match
matchRegexFail :: String -> String -> String
matchRegexFail r s = 
  case matchRegex (mkRegex r) s of
    Nothing -> error ("No Match for " ++ (show r) ++ " in " ++ (show s))
    Just [] -> error ("Strange No Match for " ++ (show r) ++ " in " ++ (show s))
    Just x -> x !! 0


-- gets a month number out of a string "MON xx"
monthToNum :: String -> Integer
monthToNum s =
  case matchRegex (mkRegex "(JAN|FEB|MAR|APR|MAY|JUN|JUL|AUG|SEP|OCT|NOV|DEC)") s of
    Nothing -> error ("Could not find month " ++ (show s))
    Just [] -> error ("Could not find month - impossible " ++ (show s))
    Just (a : b) ->
      case a of 
        "JAN" -> 1
        "FEB" -> 2
        "MAR" -> 3
        "APR" -> 4
        "MAY" -> 5
        "JUN" -> 6
        "JUL" -> 7
        "AUG" -> 8
        "SEP" -> 9
        "OCT" -> 10
        "NOV" -> 11
        "DEC" -> 12
        s -> error ("Bad month " ++ (show s))

-- gets the forecasts for n days in the future
getNDayForecasts :: Int -> [Forecast] -> [ForecastRecord]
getNDayForecasts n = map (getNDayForecast n)

-- gets the forecast for n days in the future
getNDayForecast :: Int -> Forecast -> ForecastRecord
getNDayForecast n (date, fcsts) =
  case fcsts !! n of
    (monthAndDay, cloud, (minT, maxT), precip) ->
      let y = read (matchRegexFail "(20[0-9][0-9])$" date)
          m = monthToNum monthAndDay
          d = read (matchRegexFail "([0-3]?[0-9])" monthAndDay)
          y' = if m == 1 && d <= n + 1 then y + 1 else y
      in
        ForecastRecord {forYear = y', forMonth = m, forDay = d,
                        clouds = cloud, minT = minT, maxT = maxT, precip = precip}
  
getNDayForecastTests = TestLabel "getNDayForecast" (TestList [
  getNDayForecast 0 ("ASd eg r 2004", [("JAN 11", "2", (3, 4), 5),
                                       ("FEB 2", "7", (8, 9), 10)]) ~=?
    ForecastRecord 2004 1 11 "2" 3 4 5,
  getNDayForecast 1 ("blah blah 2020", [("DEC 20", "11", (44, 55), 6),
                                        ("DEC 21", "22", (11, 111), 66)]) ~=?
    ForecastRecord 2020 12 21 "22" 11 111 66,
  getNDayForecast 1 ("blah blah 2020", [("JAN 01", "11", (44, 55), 6),
                                        ("JAN 02", "22", (11, 111), 66)]) ~=?
    ForecastRecord 2021 1 2 "22" 11 111 66,
  getNDayForecast 0 ("blah blah 2020", [("JAN 1", "11", (44, 55), 6),
                                        ("JAN 02", "22", (11, 111), 66)]) ~=?
    ForecastRecord 2021 1 1 "11" 44 55 6])


summaryToSRec :: Summary -> SummaryRecord
summaryToSRec (date, cloud, (min, max), precip) = 
  SummaryRecord { year = read (matchRegexFail "(20[0-9][0-9])$" date),
                  month = monthToNum date,
                  day = read (matchRegexFail " ([0-3]?[0-9]) " date),
                  sClouds = cloud, sMinT = min, sMaxT = max, sPrecip = precip }
                  
summaryToSRecTests = TestLabel "summaryToSRec" (TestList [
  summaryToSRec (" 518 PM MST SUN FEB 1 2004",0.6,(18,32),"0.00") ~=?
    SummaryRecord 2004 2 1 0.6 18 32 "0.00",
  summaryToSRec (" 518 PM MST FRI JAN 30 2004",0.8,(33,46),"T") ~=?
    SummaryRecord 2004 1 30 0.8 33 46 "T"])
  
  
-- Pairs off the forecasts with the corresponding summaries.  Both lists
-- must be in chronological order.
zipFcastsSums :: [ForecastRecord] -> [SummaryRecord] -> [(ForecastRecord, SummaryRecord)]
zipFcastsSums [] _ = []
zipFcastsSums _ [] = []
zipFcastsSums ((fr @ (ForecastRecord fy fm fd _ _ _ _)) : frest)
              ((sr @ (SummaryRecord sy sm sd _ _ _ _)) : srest) =
  if (fy, fm, fd) == (sy, sm, sd) then
    (fr, sr) : zipFcastsSums frest srest
  else if (fy, fm, fd) < (sy, sm, sd) then
    zipFcastsSums frest (sr : srest)
  else
    zipFcastsSums (fr : frest) srest
  
zipFcastsSumsTests = TestLabel "zipFcastSums" (TestList [
  zipFcastsSums [] [] ~=? [],
  zipFcastsSums [] [SummaryRecord 1 2 3 4 5 6 "T"] ~=? [],
  zipFcastsSums [ForecastRecord 1 2 3 "" 5 6 7] [] ~=? [],
  zipFcastsSums [ForecastRecord 1 2 3 "" 5 6 7]
                [SummaryRecord 2 2 3 5 5 6 "T"] ~=? [],
  zipFcastsSums [ForecastRecord 2003 1 1 "1" 1 1 1,
                 ForecastRecord 2003 1 3 "2" 2 2 2,
                 ForecastRecord 2003 1 5 "3" 3 3 3]
                [SummaryRecord 2003 1 2 1 1 1 "1",
                 SummaryRecord 2003 1 3 2 2 2 "2",
                 SummaryRecord 2003 1 5 3 3 3 "3"] ~=?
           [(ForecastRecord 2003 1 3 "2" 2 2 2, SummaryRecord 2003 1 3 2 2 2 "2"),
            (ForecastRecord 2003 1 5 "3" 3 3 3, SummaryRecord 2003 1 5 3 3 3 "3")]])
  
  
-- figures out how accurate the weather forecasts are
analyze :: Int -> [Forecast] -> [Summary] -> String
analyze numDays forecasts summaries = 
  let nDayFcasts = getNDayForecasts numDays forecasts
      sums = map summaryToSRec summaries
      pairs = zipFcastsSums nDayFcasts sums
      temps = map (\(fr, sr) -> abs (minT fr - sMinT sr) + abs (maxT fr - sMaxT sr)) pairs
      cloudRight = map (\(fr, sr) -> compareClouds (clouds fr) (sClouds sr)) pairs
  in
    "Temperature Deviations: " ++ show temps ++ "\nAverage: " ++ (show (fromIntegral (sum temps) / fromIntegral (length temps))) ++
    "\nCorrect Cloudy: " ++ show cloudRight ++ "\nRatio: " ++ 
    (show (fromIntegral (length (filter (\x -> x) cloudRight)) / fromIntegral (length cloudRight))) ++ "\n"

analyzeTests = TestLabel "analyze" (TestList [
  analyze 0 [(" 305 PM MST WED JAN 28 2004",[("JAN 29","MOCLDY",(29,39),20),("JAN 30","MOCLDY",(30,43),20),("JAN 31","MOCLDY",(24,31),20),("FEB 01","PTCLDY",(18,30),0),("FEB 02","PTCLDY",(25,32),20),("FEB 03","MOCLDY",(22,36),20),("FEB 04","PTCLDY",(22,41),10)]),
             (" 255 PM MST THU JAN 29 2004",[("JAN 30","MOCLDY",(33,45),30),("JAN 31","MOCLDY",(26,31),20),("FEB 01","SNOW",(18,29),50),("FEB 02","PTCLDY",(22,31),30),("FEB 03","MOCLDY",(29,34),40),("FEB 04","PTCLDY",(25,39),20),("FEB 05","PTCLDY",(23,36),0)]),
             (" 359 PM MST FRI JAN 30 2004",[("JAN 31","MOCLDY",(25,30),30),("FEB 01","PTCLDY",(17,29),20),("FEB 02","MOCLDY",(18,33),20),("FEB 03","MOCLDY",(29,38),40),("FEB 04","MOCLDY",(23,35),30),("FEB 05","PTCLDY",(23,35),0),("FEB 06","PTCLDY",(23,35),0)]),
             (" 400 PM MST SAT JAN 31 2004",[("FEB 01","PTCLDY",(15,31),10),("FEB 02","CLOUDY",(21,37),20),("FEB 03","CLOUDY",(26,36),30),("FEB 04","MOCLDY",(26,33),30),("FEB 05","PTCLDY",(21,32),0),("FEB 06","MOCLDY",(18,36),30),("FEB 07","PTCLDY",(22,32),20)]),
             (" 400 PM MST SUN FEB 1 2004",[("FEB 02","MOCLDY",(22,36),20),("FEB 03","CLOUDY",(26,34),40),("FEB 04","MOCLDY",(19,32),40),("FEB 05","SUNNY",(18,31),10),("FEB 06","PTCLDY",(17,34),20),("FEB 07","PTCLDY",(22,32),20),("FEB 08","PTCLDY",(18,31),10)])]
            [(" 520 PM MST WED JAN 28 2004",0.9,(27,38),"0.01"),
             (" 514 PM MST THU JAN 29 2004",1.0,(31,42),"0.00"),
             (" 518 PM MST FRI JAN 30 2004",0.8,(33,46),"T"),
             (" 542 PM MST SAT JAN 31 2004",0.6,(20,32),"0.00"),
             (" 518 PM MST SUN FEB 1 2004",0.6,(18,32),"0.00")] ~=?
     "Temperature Deviations: [5,1,7,4]\nAverage: 4.25\nCorrect Cloudy: [False,False,True,False]\nRatio: 0.25\n"])

-- compares the predicted cloudiness with the actual cloud cover.
compareClouds :: String -> Double -> Bool
compareClouds fcast actual =
  (fcast == "CLOUDY" && actual > 0.70) ||
  (fcast == "MOCLDY" && actual > 0.45 && actual < 0.80) || 
  (fcast == "PTCLDY" && actual > 0.20 && actual < 0.55) ||
  (fcast == "SUNNY" && actual < 0.30)
  

-- Removes the Weather wrapper
stripWeather :: Weather a -> a
stripWeather (_, Right _) = error "Bad Weather Data"
stripWeather (_, Left x) = x

main = do args <- getArgs
          forecastFile <- readFile "forecasts"
          summaryFile <- readFile "summaries"
          putStr (analyze (read (args !! 0) - 1)
                          (map stripWeather (readMany forecastFile))
                          (map stripWeather (readMany summaryFile)))
                         
                         
tests = TestList [readManyTests, getNDayForecastTests, summaryToSRecTests,
                  zipFcastsSumsTests, analyzeTests]