module Day2 where

import AoC

import Data.Char
import Data.Maybe
import Text.ParserCombinators.ReadP
import Text.Read.Lex

data Line = Line
    { num1 :: Int
    , num2 :: Int
    , letter :: Char
    , password :: String
    }

instance Show Line where
    show (Line num1 num2 letter password) = show num1 ++ "-" ++ show num2 ++ " " ++ [letter] ++ ": " ++ password

parseLine :: ReadP Line
parseLine = do
    num1 <- readDecP
    string "-"
    num2 <- readDecP
    string " "
    letter <- get
    string ": "
    password <- munch1 $ const True
    eof
    return (Line num1 num2 letter password)

valid_1 :: Line -> Bool
valid_1 (Line min max letter password) = within min max $ length $ filter (== letter) password
    where within x y z = x <= z && z <= y

valid_2 :: Line -> Bool
valid_2 (Line pos1 pos2 letter password) = (matchesAt pos1) /= (matchesAt pos2)
    where matchesAt pos = password !! (pos-1) == letter

main = runAoC (map (fromJust . oneCompleteResult parseLine) . lines) (length . filter valid_1) (length . filter valid_2)