day4: Complete second puzzle

Yes, this is more than mildly horrible. But it's late and this works.

4/bingo.hs

@@ -1,5 +1,5 @@
 import           Control.Exception (assert)
-import           Data.List         (elemIndices, groupBy, minimumBy, transpose)
+import           Data.List         (elemIndices, groupBy, maximumBy, minimumBy, transpose)
 import           Data.Maybe        (isJust, listToMaybe)
 import           Data.Ord          (comparing)
 import           Debug.Trace       (traceShowId)
@@ -7,10 +7,14 @@ 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
@@ -27,6 +31,15 @@ parseBingos input = (calls, cards)
         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
@@ -99,6 +112,9 @@ testInput1 = unlines [
 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]