aoc-2022/src/Parse.hs

{-# LANGUAGE ImportQualifiedPost #-}

module Parse where

import Common
import Data.Char (digitToInt)
import Data.Function ((&))
import Data.Text qualified as T
import Data.Void
import Text.Megaparsec qualified as M
import Text.Megaparsec.Char (digitChar)
import Text.Megaparsec.Char qualified as MC
import Text.Megaparsec.Char.Lexer qualified as MCL
import Util (both)

import Data.List (transpose)
import Data.List.Extra (chunksOf)

import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (fromMaybe)

type Parser = M.Parsec Void T.Text

someLines :: Parser a -> Parser [a]
someLines p = p `M.sepEndBy1` MC.newline

number :: Parser Int
number = MCL.decimal

int :: Parser Int
int = MCL.signed (pure ()) number

digit :: Parser Int
digit = digitToInt <$> digitChar

parsecDay ::
    Parser a ->
    (a -> Result, a -> Result) ->
    Day
parsecDay parser parts =
    ParsecDay
        ( \path text ->
            ( case M.parse (parser <* M.eof) path text of
                Left e -> Left $ M.errorBundlePretty e
                Right parsedInput -> Right $ both (parsedInput &) parts
            )
        )

parseCRT :: [String] -> String
parseCRT = map (\grid -> fromMaybe '?' (M.lookup grid gridToChar)) . slice
  where
    slice :: [String] -> [[String]]
    slice = transpose . map (chunksOf 5)

gridToChar :: Map [String] Char
gridToChar =
    M.fromList
        [
            (
                [ ".##.."
                , "#..#."
                , "#..#."
                , "####."
                , "#..#."
                , "#..#."
                ]
            , 'A'
            )
        ,
            (
                [ "###.."
                , "#..#."
                , "###.."
                , "#..#."
                , "#..#."
                , "###.."
                ]
            , 'B'
            )
        ,
            (
                [ "#...."
                , "#...."
                , "#...."
                , "#...."
                , "#...."
                , "####."
                ]
            , 'L'
            )
        ,
            (
                [ "###.."
                , "#..#."
                , "#..#."
                , "###.."
                , "#...."
                , "#...."
                ]
            , 'P'
            )
        ,
            (
                [ "#..#."
                , "#..#."
                , "#..#."
                , "#..#."
                , "#..#."
                , ".##.."
                ]
            , 'U'
            )
        ,
            (
                [ "####."
                , "...#."
                , "..#.."
                , ".#..."
                , "#...."
                , "####."
                ]
            , 'Z'
            )
        ]