Day06/Main.hs

   1 {-# LANGUAGE OverloadedStrings #-} -- for building Text strings
   2 module Main where
   3 import Control.Applicative (Alternative((<|>)))
   4 import Data.Text.Lazy (Text)
   5 import Data.Void (Void)
   6 import Prelude
   7 import qualified Control.Applicative.Permutations as P
   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/6 for the problem statements
  17 data Day06Results = Day06Results
  18   { example1 :: Int
  19   , batch1 :: Int
  20   , example2 :: Int
  21   , batch2 :: Int
  22   } deriving (Show)
  23
  24 main :: IO ()
  25 main = do
  26   putStr "Day06Inputs: " >> getDataFileName "" >>= putStrLn
  27   print =<< Day06Results
  28     <$> (unionGroups <$> parse "example")
  29     <*> (unionGroups <$> parse "batch")
  30     <*> (intersectGroups <$> parse "example")
  31     <*> (intersectGroups <$> parse "batch")
  32
  33 type Parser output = P.Parsec {-error-}Void {-input-}Text output
  34
  35 type Answer = [Char]
  36 parserAnswer :: Parser Answer
  37 parserAnswer =
  38   -- P.dbg "parserAnswer" $
  39   (P.notFollowedBy (P.char '\n') *>) $
  40   P.runPermutation $
  41     List.foldl' (\acc a -> maybe id (:) <$> a <*> acc) (pure [])
  42     [ P.toPermutationWithDefault Nothing (Just <$> P.char c)
  43     | c <- ['a'..'z']
  44     ]
  45
  46 parserGroup :: Parser [Answer]
  47 parserGroup =
  48   -- P.dbg "parserGroup" $
  49   P.some $ parserAnswer <* P.char '\n'
  50
  51 parserGroups :: Parser [[Answer]]
  52 parserGroups =
  53   -- P.dbg "parserGroups" $
  54   P.many $ parserGroup <* (() <$ P.char '\n' <|> P.eof)
  55
  56 unionGroups :: [[Answer]] -> Int
  57 unionGroups = sum . ((length . List.foldr List.union []) <$>)
  58 intersectGroups :: [[Answer]] -> Int
  59 intersectGroups = sum . ((length . List.foldr1 List.intersect) <$>)
  60
  61 parse :: FilePath -> IO [[Answer]]
  62 parse input = do
  63   content <- Text.decodeUtf8 <$> (BSL.readFile =<< getDataFileName input)
  64   case P.parse (parserGroups <* P.eof) input content of
  65     Left err -> error (P.errorBundlePretty err)
  66     Right groups -> return groups