AoC/2021/day05/day05.hs

import qualified Data.Map as M
import Data.List.Split
import Control.Arrow
import Control.Monad

main :: IO ()
main = do
  input <-  map (map read . filter (/="->")) <$> map (splitOneOf ", ") <$> lines <$> readFile "input"
  let process = length . M.filter (> 1) . M.fromListWith (+) . toMap
  print $ join (***) process $ (filterOrth input,input)

filterOrth :: [[Int]] -> [[Int]]
filterOrth [] = []
filterOrth ([x1,y1,x2,y2]:ss)
  | x1==x2 || y1==y2 = [x1,y1,x2,y2]:filterOrth ss
  | otherwise = filterOrth ss

toMap :: [[Int]] -> [((Int,Int),Int)]
toMap [] = []
toMap ([x1,y1,x2,y2]:xs)
  | y1==y2 = zip ySame (repeat 1) ++ toMap xs
  | x1==x2 = zip xSame (repeat 1) ++ toMap xs
  | otherwise = zip diag (repeat 1) ++ toMap xs
    where diag = zip xRange yRange
          ySame = zip xRange (repeat y1)
          xSame = zip (repeat x1) yRange
          xRange = [x1,x1-(signum $ x1-x2)..x2]
          yRange = [y1,y1-(signum $ y1-y2)..y2]