{-# Language QuasiQuotes, TemplateHaskell #-}
{-|
Module      : Main
Description : Day 8 solution
Copyright   : (c) Eric Mertens, 2019
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2019/day/8>

-}
module Main (main) where

import Advent              (count, chunks, format)
import Control.Applicative ((<|>),many)
import Data.List           (minimumBy)
import Data.Ord            (comparing)

type Layer = [[P]]

data P = P0 | P1 | P2
  deriving (P -> P -> Bool
(P -> P -> Bool) -> (P -> P -> Bool) -> Eq P
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: P -> P -> Bool
== :: P -> P -> Bool
$c/= :: P -> P -> Bool
/= :: P -> P -> Bool
Eq, Eq P
Eq P =>
(P -> P -> Ordering)
-> (P -> P -> Bool)
-> (P -> P -> Bool)
-> (P -> P -> Bool)
-> (P -> P -> Bool)
-> (P -> P -> P)
-> (P -> P -> P)
-> Ord P
P -> P -> Bool
P -> P -> Ordering
P -> P -> P
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: P -> P -> Ordering
compare :: P -> P -> Ordering
$c< :: P -> P -> Bool
< :: P -> P -> Bool
$c<= :: P -> P -> Bool
<= :: P -> P -> Bool
$c> :: P -> P -> Bool
> :: P -> P -> Bool
$c>= :: P -> P -> Bool
>= :: P -> P -> Bool
$cmax :: P -> P -> P
max :: P -> P -> P
$cmin :: P -> P -> P
min :: P -> P -> P
Ord, Int -> P -> ShowS
[P] -> ShowS
P -> String
(Int -> P -> ShowS) -> (P -> String) -> ([P] -> ShowS) -> Show P
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> P -> ShowS
showsPrec :: Int -> P -> ShowS
$cshow :: P -> String
show :: P -> String
$cshowList :: [P] -> ShowS
showList :: [P] -> ShowS
Show)

mempty

-- | >>> :main
-- 2080
-- ░██░░█░░█░███░░░██░░█░░░█
-- █░░█░█░░█░█░░█░█░░█░█░░░█
-- █░░█░█░░█░█░░█░█░░░░░█░█░
-- ████░█░░█░███░░█░░░░░░█░░
-- █░░█░█░░█░█░█░░█░░█░░░█░░
-- █░░█░░██░░█░░█░░██░░░░█░░
main :: IO ()
IO ()
main =
  do [P]
inp <- [format|2019 8 @P*%n|]
     let layers :: [[[P]]]
layers = Int -> [[P]] -> [[[P]]]
forall a. Int -> [a] -> [[a]]
chunks Int
6 (Int -> [P] -> [[P]]
forall a. Int -> [a] -> [[a]]
chunks Int
25 [P]
inp)
     Int -> IO ()
forall a. Show a => a -> IO ()
print ([[[P]]] -> Int
part1 [[[P]]]
layers)
     ([P] -> IO ()) -> [[P]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn (String -> IO ()) -> ([P] -> String) -> [P] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (P -> Char) -> [P] -> String
forall a b. (a -> b) -> [a] -> [b]
map P -> Char
render) ([[[P]]] -> [[P]]
overlayLayers [[[P]]]
layers)

render :: P -> Char
render :: P -> Char
render P
P0 = Char
'\x2591'
render P
P1 = Char
'\x2588'
render P
P2 = Char
'\x2592'

overlayLayers :: [Layer] -> Layer
overlayLayers :: [[[P]]] -> [[P]]
overlayLayers = ([[P]] -> [[P]] -> [[P]]) -> [[[P]]] -> [[P]]
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (([P] -> [P] -> [P]) -> [[P]] -> [[P]] -> [[P]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((P -> P -> P) -> [P] -> [P] -> [P]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith P -> P -> P
overlay))

overlay :: P -> P -> P
overlay :: P -> P -> P
overlay P
P2 P
x = P
x
overlay P
x  P
_ = P
x

part1 :: [Layer] -> Int
part1 :: [[[P]]] -> Int
part1 [[[P]]]
layers = P -> [P] -> Int
forall (f :: * -> *) a. (Foldable f, Eq a) => a -> f a -> Int
count P
P1 [P]
layer Int -> Int -> Int
forall a. Num a => a -> a -> a
* P -> [P] -> Int
forall (f :: * -> *) a. (Foldable f, Eq a) => a -> f a -> Int
count P
P2 [P]
layer
  where
    layer :: [P]
layer = ([P] -> [P] -> Ordering) -> [[P]] -> [P]
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (([P] -> Int) -> [P] -> [P] -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (P -> [P] -> Int
forall (f :: * -> *) a. (Foldable f, Eq a) => a -> f a -> Int
count P
P0))
          ([[P]] -> [P]) -> [[P]] -> [P]
forall a b. (a -> b) -> a -> b
$ ([[P]] -> [P]) -> [[[P]]] -> [[P]]
forall a b. (a -> b) -> [a] -> [b]
map [[P]] -> [P]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[P]]]
layers