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

<https://adventofcode.com/2015/day/16>

We're given facts about a bunch of different /Sues/ and asked to
check which one matches what we know about the one true /Sue/.

-}
module Main where

import Advent.Format (format)

main :: IO ()
IO ()
main =
 do [(Int, [([Char], Int)])]
input <- [format|2015 16 (Sue %d: (%s: %d)&(, )%n)*|]
    [Int] -> IO ()
forall a. Show a => a -> IO ()
print [Int
i | (Int
i, [([Char], Int)]
props) <- [(Int, [([Char], Int)])]
input, [([Char], Int)] -> Bool
matchesClues1 [([Char], Int)]
props]
    [Int] -> IO ()
forall a. Show a => a -> IO ()
print [Int
i | (Int
i, [([Char], Int)]
props) <- [(Int, [([Char], Int)])]
input, [([Char], Int)] -> Bool
matchesClues2 [([Char], Int)]
props]

-- | Predicate for properties that match exactly.
matchesClues1 :: [(String,Int)] -> Bool
matchesClues1 :: [([Char], Int)] -> Bool
matchesClues1 = ([Char] -> Int -> Int -> Bool) -> [([Char], Int)] -> Bool
matcher ((Int -> Int -> Bool) -> [Char] -> Int -> Int -> Bool
forall a b. a -> b -> a
const Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==))

-- | Predicate like 'matchesClues1' but with special cases for
-- /cats/, /trees/, /pomeranians/, and /goldfish/.
matchesClues2 :: [(String,Int)] -> Bool
matchesClues2 :: [([Char], Int)] -> Bool
matchesClues2 =
  ([Char] -> Int -> Int -> Bool) -> [([Char], Int)] -> Bool
matcher \case
    [Char]
"cats"        -> Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<)
    [Char]
"trees"       -> Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<)
    [Char]
"pomeranians" -> Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>)
    [Char]
"goldfish"    -> Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>)
    [Char]
_             -> Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Match a list of properties against the known hints.
matcher ::
  (String -> Int -> Int -> Bool) {- ^ comparison selector -} ->
  [(String,Int)] {- ^ list of properties -} ->
  Bool {- ^ properties match clues -}
matcher :: ([Char] -> Int -> Int -> Bool) -> [([Char], Int)] -> Bool
matcher [Char] -> Int -> Int -> Bool
match = (([Char], Int) -> Bool) -> [([Char], Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all \([Char]
prop, Int
memory) ->
  [Char] -> Int -> Int -> Bool
match [Char]
prop ([Char] -> Int
clues [Char]
prop) Int
memory

-- | Returns the given hint value for each property.
clues :: String -> Int
clues :: [Char] -> Int
clues [Char]
"children"    = Int
3
clues [Char]
"cats"        = Int
7
clues [Char]
"samoyeds"    = Int
2
clues [Char]
"pomeranians" = Int
3
clues [Char]
"akitas"      = Int
0
clues [Char]
"vizslas"     = Int
0
clues [Char]
"goldfish"    = Int
5
clues [Char]
"trees"       = Int
3
clues [Char]
"cars"        = Int
2
clues [Char]
"perfumes"    = Int
1