Day05/Main.hs

   1 {-# LANGUAGE OverloadedStrings #-} -- for building Text strings
   2 module Main where
   3 import Control.Applicative (Alternative((<|>)))
   4 import Control.Monad (replicateM)
   5 import Data.Text.Lazy (Text)
   6 import Data.Void (Void)
   7 import Prelude
   8 import qualified Data.List as List
   9 import qualified Data.Text.Lazy.Encoding as Text
  10 import qualified Text.Megaparsec as P
  11 import qualified Text.Megaparsec.Char as P
  12 -- import qualified Text.Megaparsec.Debug as P
  13 import qualified Data.ByteString.Lazy as BSL
  14 import Paths_AoC2020
  15
  16 -- | See https://adventofcode.com/2020/day/5 for the problem statements
  17 data Day05Results = Day05Results
  18   { example1 :: SeatID
  19   , batch1 :: SeatID
  20   , batch2 :: SeatID
  21   } deriving (Show)
  22
  23 type SeatID = Int
  24
  25 main :: IO ()
  26 main = do
  27   putStr "Day05Inputs: " >> getDataFileName "" >>= putStrLn
  28   print =<< Day05Results
  29     <$> parseMaxSeatID "example"
  30     <*> parseMaxSeatID "batch"
  31     <*> parseMySeatID "batch"
  32
  33 parserSeatID :: Parser SeatID
  34 parserSeatID = -- P.dbg "parserSeatID" $
  35   (\rows cols ->
  36     mkBinary rows * 8 +
  37     mkBinary cols)
  38   <$> replicateM 7 parserRow
  39   <*> replicateM 3 parserColumns
  40   where
  41   mkBinary :: [Bool] -> Int
  42   mkBinary = List.foldl' (\acc bit -> acc * 2 + if bit then 1 else 0) 0
  43
  44 parserRow :: Parser Bool
  45 parserRow =
  46   False <$ P.char 'F' <|>
  47   True  <$ P.char 'B'
  48 parserColumns :: Parser Bool
  49 parserColumns =
  50   False <$ P.char 'L' <|>
  51   True  <$ P.char 'R'
  52
  53 type Parser output = P.Parsec {-error-}Void {-input-}Text output
  54 parseSeatIDs :: FilePath -> IO [SeatID]
  55 parseSeatIDs input = do
  56   content <- Text.decodeUtf8 <$> (BSL.readFile =<< getDataFileName input)
  57   case P.parse (P.many (parserSeatID <* P.char '\n') <* P.eof) input content of
  58     Left err -> error (P.errorBundlePretty err)
  59     Right seatIDs -> return seatIDs
  60
  61 parseMaxSeatID :: FilePath -> IO SeatID
  62 parseMaxSeatID = (maximum <$>) . parseSeatIDs
  63
  64 parseMySeatID :: FilePath -> IO SeatID
  65 parseMySeatID input = do
  66   seatIDs <- parseSeatIDs input
  67   return $ go $ List.sort seatIDs
  68   where
  69   go (s0:s1:ss) | s0 + 1 == s1 = go (s1:ss)
  70                 | otherwise = s0 + 1
  71   go _ = error "no empty seat"