{-|
Module      : Main
Description : Day 13 solution
Copyright   : (c) Eric Mertens, 2015
License     : ISC
Maintainer  : emertens@gmail.com

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

-}
module Main where

import Advent.Input (getInputLines)
import Data.List (tails)

main :: IO ()
IO ()
main =
  do [String
key] <- Int -> Int -> IO [String]
getInputLines Int
2015 Int
11
     (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
2 (String -> [String]
solutions String
key))

-- | Compute the list of valid passwords starting from a given one.
-- Note: This process works on reversed passwords with the rules
-- updated to work on reversed strings. This is to make 'nextPassword'
-- easier to write.
solutions :: String -> [String]
solutions :: String -> [String]
solutions = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. [a] -> [a]
reverse ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isGoodPassword ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> String -> [String]
forall a. (a -> a) -> a -> [a]
iterate String -> String
nextPassword (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
          (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
startOnGood

-- | Check that a string satisfies the descending and duplicate letter rules.
isGoodPassword :: String -> Bool
isGoodPassword :: String -> Bool
isGoodPassword String
p = String -> Int -> String -> Bool
hasPairs [] Int
2 String
p Bool -> Bool -> Bool
&& String -> Bool
hasDesc String
p

-- | Test that a string has at least @count@ non-overlapping double, adjacent
-- letters.
hasPairs :: [Char] {- ^ pairs seen so far -} -> Int {- ^ count -} -> String -> Bool
hasPairs :: String -> Int -> String -> Bool
hasPairs String
_ Int
0 String
_  = Bool
True
hasPairs String
seen Int
n (Char
x:Char
y:String
z)
  | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
y Bool -> Bool -> Bool
&& Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
seen = String -> Int -> String -> Bool
hasPairs (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
seen) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String
z
  | Bool
otherwise = String -> Int -> String -> Bool
hasPairs String
seen Int
n (Char
yChar -> String -> String
forall a. a -> [a] -> [a]
:String
z)
hasPairs String
_ Int
_ String
_  = Bool
False

-- | Test that a string has a 3-length descending sequence.
hasDesc :: String -> Bool
hasDesc :: String -> Bool
hasDesc = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
forall {a}. (Eq a, Enum a) => [a] -> Bool
aux ([String] -> Bool) -> (String -> [String]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. [a] -> [[a]]
tails
  where
  aux :: [a] -> Bool
aux (a
x:a
y:a
z:[a]
_) = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a
forall a. Enum a => a -> a
succ a
y Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a
forall a. Enum a => a -> a
succ a
z
  aux [a]
_         = Bool
False

-- | Test that a character is not in the set of @"iol"@
isGoodLetter :: Char -> Bool
isGoodLetter :: Char -> Bool
isGoodLetter Char
c = Char
'i' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c Bool -> Bool -> Bool
&& Char
'o' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c Bool -> Bool -> Bool
&& Char
'l' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c

-- | Clean out the starting prohibited letters
startOnGood :: String -> String
startOnGood :: String -> String
startOnGood [] = []
startOnGood (Char
x:String
xs)
  | Char -> Bool
isGoodLetter Char
x = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
startOnGood String
xs
  | Bool
otherwise = Char -> Char
forall a. Enum a => a -> a
succ Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Char -> Char
forall a b. a -> b -> a
const Char
'a') String
xs

-- | Increment a string from left to right while skipping
-- the prohibited characters.
nextPassword :: String -> String
nextPassword :: String -> String
nextPassword []     = String
"a"
nextPassword (Char
x:String
xs) =
  case Char
x of
    Char
'z' -> Char
'a' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
nextPassword String
xs
    Char
_ | Char -> Bool
isGoodLetter Char
x' -> Char
x' Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
      | Bool
otherwise       -> String -> String
nextPassword (Char
x'Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
  where
  x' :: Char
x' = Char -> Char
forall a. Enum a => a -> a
succ Char
x