import           Control.Exception (assert)
import           Data.List         (elemIndices, groupBy, maximumBy, minimumBy, transpose)
import           Data.Maybe        (isJust, listToMaybe)
import           Data.Ord          (comparing)
import           Debug.Trace       (traceShowId)

main = do
  bingoInput <- getContents
  putStrLn (solution1 bingoInput)
  putStrLn (solution2 bingoInput)

solution1 :: String -> String
solution1 = show . scoreBingo . shortestBingo . parseBingos

solution2 :: String -> String
solution2 = show . scoreBingo . longestBingo . parseBingos

parseBingos :: String -> ([Int], [[[Int]]])
parseBingos input = (calls, cards)
  where
    (callStrings, bingoStrings) = splitAt 2 (lines input)
    calls :: [Int]
    calls = map read ((wordsWhen (==',')) (head callStrings))
    cards :: [[[Int]]]
    cards = chunksToNumbers (chunkByEmpty bingoStrings)
      where
        lineToNumbers :: String -> [Int]
        lineToNumbers = (map read) . words
        linesToNumbers :: [String] -> [[Int]]
        linesToNumbers = map lineToNumbers
        chunksToNumbers :: [[String]] -> [[[Int]]]
        chunksToNumbers = map linesToNumbers

longestBingo :: ([Int], [[[Int]]]) -> ([Int], [Int])
longestBingo (calls, cards) =
  maximumBy (comparing bingoLength) solvedBingos
  where
    bingoLength :: ([Int], [Int]) -> Int
    bingoLength (start, _) = length start
    solvedBingos :: [([Int], [Int])]
    solvedBingos = map (uncurry solveBingo) (zip (repeat calls) cards)

shortestBingo :: ([Int], [[[Int]]]) -> ([Int], [Int])
shortestBingo (calls, cards) =
  minimumBy (comparing bingoLength) solvedBingos
  where
    bingoLength :: ([Int], [Int]) -> Int
    bingoLength (start, _) = length start
    solvedBingos :: [([Int], [Int])]
    solvedBingos = map (uncurry solveBingo) (zip (repeat calls) cards)

solveBingo :: [Int] -> [[Int]] -> ([Int], [Int])
solveBingo calls card =
  (marked, unmarked)
  where
    unmarked = filter (\i -> isJust (elem2dIndex i card)) remaining
    (marked, remaining) = splitAt (length (fst (indices calls card))+1) calls
    indices :: [Int] -> [[Int]] -> ([Int], [Int])
    indices calls cards =
      break (\call -> isSolved (take (call+1) calls) (elem2dIndex (calls !! call) card)) [0..length(calls)-1]
    isSolved :: [Int] -> Maybe (Int, Int) -> Bool
    isSolved _ Nothing = False
    isSolved calls (Just (y, x)) =
      (isSublist (card !! x) calls)
      || (isSublist ((transpose card) !! y) calls)

scoreBingo :: ([Int], [Int]) -> Int
scoreBingo (marked, unmarked) = (last marked) * (sum unmarked)

isSublist :: (Eq a) => [a] -> [a] -> Bool
isSublist a b = all (`elem` b) a

elem2dIndex :: (Eq a) => a -> [[a]] -> Maybe (Int, Int)
elem2dIndex e m = listToMaybe [ (x,y) | (y,r) <- zip [0..] m, x <- elemIndices e r ]

wordsWhen :: (Char -> Bool) -> String -> [String]
wordsWhen p s =  case dropWhile p s of
                      "" -> []
                      s' -> w : wordsWhen p s''
                            where (w, s'') = break p s'

chunkByEmpty :: [String] -> [[String]]
chunkByEmpty [] = []
chunkByEmpty (x:xs) = (if null x then chunk else (x:chunk)) : chunkByEmpty rest
  where
    (chunk,rest) = break (null) xs

-- Tests
testInput1 :: String
testInput1 = unlines [
  "7,4,9,5,11,17,23,2,0,14,21,24,10,16,13,6,15,25,12,22,18,20,8,19,3,26,1",
  "",
  "22 13 17 11  0",
  " 8  2 23  4 24",
  "21  9 14 16  7",
  " 6 10  3 18  5",
  " 1 12 20 15 19",
  "",
  " 3 15  0  2 22",
  " 9 18 13 17  5",
  "19  8  7 25 23",
  "20 11 10 24  4",
  "14 21 16 12  6",
  "",
  "14 21 17 24  4",
  "10 16 15  9 19",
  "18  8 23 26 20",
  "22 11 13  6  5",
  " 2  0 12  3  7"
  ]

test1 :: String
test1 = assert ((solution1 testInput1) == "4512") "success"

test2 :: String
test2 = assert ((solution2 testInput1) == "1924") "success"

isSublistTest1 = isSublist [0, 1, 2] [0, 1, 2, 3]
isSublistTest2 = isSublist [0, 1, 2] [0, 1, 3]
isSublistTest3 = isSublist [0, 1, 3] [0, 1, 3]
isSublistTest4 = isSublist [0, 1, 3] [0, 1, 4, 3, 2]