aoc-2024-haskell/day4/Main.hs

module Main where

import System.Environment (getArgs)
import Control.Monad (void)
import Data.List (transpose)

import Text.Parsec (parse, Parsec, endBy, many, char, anyChar, (<|>), try, string, lookAhead, getPosition, sourceName)
import Text.Parsec.Char (oneOf)
import Text.ParserCombinators.Parsec (eof)

rows :: Parsec String () [String]
rows = endBy (many $ oneOf "XMAS") (void $ char '\n') <* eof

rotate90 :: [[a]] -> [[a]]
rotate90 = reverse . transpose

diagonals :: [[a]] -> [[a]]
diagonals = (++)
    -- Lower half (excluding the main diagonal)
    <$> reverse . transpose . map reverse . zipWith take [1..] . drop 1
    -- Upper half
    <*> transpose . zipWith drop [0..]

-- | counts the number of "XMAS" (as well as the backwards "SAMX") in the input
countLineXMAS :: Parsec String () Int
countLineXMAS =
    try (lookAhead (string "XMAS" <|> string "SAMX")
        >> anyChar >> (+1) <$> countLineXMAS)
    <|> (anyChar >> countLineXMAS)
    <|> (eof >> return 0)

countAllXMAS :: Parsec String () Int
countAllXMAS = do
    grid <- rows
    let linesOfInterest = grid ++ concatMap ($ grid) [transpose, diagonals, diagonals . rotate90]
    sName <- sourceName <$> getPosition
    counts <- mapM (either (\p -> fail $ "Parse Error! " ++ show p) return . parse countLineXMAS sName) linesOfInterest
    return $ sum counts

part1 :: FilePath -> IO Int
part1 fp = do
    content <- readFile fp
    case parse countAllXMAS fp content of
        Left e -> fail $ "Oh no! " ++ show e
        Right v -> return v

windows3 :: [a] -> [(a, a, a)]
windows3 (a:b:c:tl) = (a, b, c) : windows3 (b:c:tl)
windows3 _ = []

windows3x3 :: [[a]] -> [((a, a, a), (a, a, a), (a, a, a))]
windows3x3 ls = [(wa, wb, wc)
    | (a, b, c) <- windows3 ls
    , (wa, wb, wc) <- zip3 (windows3 a) (windows3 b) (windows3 c)]

countCrossMAS :: [String] -> Int
countCrossMAS = sum
    . map (\((tl, _, tr),
             (_ , c, _ ),
             (bl, _, br)) ->
        if isMAS [tl, c, br] && isMAS [tr, c, bl] then 1 else 0)
    . windows3x3
    where
        isMAS :: String -> Bool
        isMAS = (||) <$> (==) "MAS" <*> (==) "SAM"

part2 :: FilePath -> IO Int
part2 fp = do
    content <- readFile fp
    case parse rows fp content of
        Left e -> fail $ "Oh no! " ++ show e
        Right r -> return $ countCrossMAS r

main :: IO ()
main = do
    args <- getArgs
    (fp:_) <- return args
    resPart1 <- part1 fp
    resPart2 <- part2 fp
    putStrLn $ "Solution (Part 1) : " ++ show resPart1
    putStrLn $ "Solution (Part 2) : " ++ show resPart2