Advent of Code 2023 04, but it's pointfree

aoc-2023-04-pointfree.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Day04 (parse, solveA, solveB) where

import Data.Void (Void)
import Data.Text (Text)
import Data.Bits (shiftL, shiftR)
import Data.Bifunctor (first)
import Text.Megaparsec (Parsec, many, eof, runParser, errorBundlePretty)
import Text.Megaparsec.Char (string, space, char)
import Text.Megaparsec.Char.Lexer (decimal)
import Control.Monad (ap)


type Card = (Int, ([Int], [Int]))
type Parser = Parsec Void Text

parseCards :: Parser [Card]
parseCards = many ((,) <$> (string "Card" *> space *> decimal) <*> ((,) <$> (char ':' *> space *> many (decimal <* space)) <*> (char '|' *> space *> many (decimal <* space)))) <* eof

parse :: Text -> Either String [Card]
parse = first errorBundlePretty . runParser parseCards ""

intersect :: [Int] -> [Int] -> [Int]
intersect = filter . flip elem

matching :: Card -> [Int]
matching = uncurry intersect . snd

toScore :: [Int] -> Int
toScore = (`shiftR` 1) . (1 `shiftL`) . length

solveA :: [Card] -> Int
solveA = sum . map (toScore . matching)

copies :: Card -> [Int]
copies = ap (map . (+) . fst) (enumFromTo 1 . length . matching)

nextState :: [Card] -> ([Int], [Card]) -> ([Int], [Card])
nextState = (`ap` snd) . (. fst) . flip (ap . ((,) .) . flip ((<>) . map fst)) . (. (copies =<<)) . map . (. pred) . (!!)

solveB :: [Card] -> Int
solveB = ap (((length . fst . head . filter (null . snd)) .) . iterate . nextState) ([],)