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

<https://adventofcode.com/2017/day/24>

Build long bridges out of pieces with a pin count on each
end. Pieces can be flipped over and to be connected the pin
counts of two pieces must match.

-}
module Main where

import Advent (format)
import Data.List (delete)

-- | Print solutions to both parts of the task.
main :: IO ()
IO ()
main =
  do [(Int, Int)]
input <- [format|2017 24 (%d/%d%n)*|]

     let bridges :: [(Int, Int)]
bridges = Int -> Int -> Int -> [(Int, Int)] -> [(Int, Int)]
search Int
0 Int
0 Int
0 [(Int, Int)]
input

     Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
bridges)) -- part 1: weights
     Int -> IO ()
forall a. Show a => a -> IO ()
print ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ([(Int, Int)] -> (Int, Int)
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [(Int, Int)]
bridges))     -- part 2: lengths *then* weights

-- | Given a required number of ports and a piece, return the possible
-- unique orientations of that piece.
orient ::
  Int         {- ^ target left pin count               -} ->
  (Int,Int)   {- ^ current piece                       -} ->
  [(Int,Int)] {- ^ possible orientations of this piece -}
orient :: Int -> (Int, Int) -> [(Int, Int)]
orient Int
a (Int
b,Int
c)
  | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b    = [(Int
b,Int
c)]
  | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c    = [(Int
c,Int
b)]
  | Bool
otherwise = []

-- | Generate statistics for all of the possible bridges given some pieces.
search ::
  Int         {- ^ current bridge length                 -} ->
  Int         {- ^ current bridge weight                 -} ->
  Int         {- ^ required port pins                    -} ->
  [(Int,Int)] {- ^ available pieces                      -} ->
  [(Int,Int)] {- ^ length and weight of possible bridges -}
search :: Int -> Int -> Int -> [(Int, Int)] -> [(Int, Int)]
search !Int
len !Int
weight !Int
match [(Int, Int)]
pieces =
  (Int
len,Int
weight) (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: -- values if we stopped here
  do (Int, Int)
piece <- [(Int, Int)]
pieces
     (Int
a,Int
b) <- Int -> (Int, Int) -> [(Int, Int)]
orient Int
match (Int, Int)
piece
     Int -> Int -> Int -> [(Int, Int)] -> [(Int, Int)]
search (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
weightInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b) Int
b ((Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => a -> [a] -> [a]
delete (Int, Int)
piece [(Int, Int)]
pieces)