{-# LANGUAGE OverloadedStrings #-} -- for building Text strings
module Main where
import Control.Applicative (Alternative((<|>)))
import Control.Monad (guard)
import Data.Maybe (catMaybes)
import Data.Text.Lazy (Text)
import Data.Void (Void)
import Prelude
import qualified Control.Applicative.Permutations as P
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Text.Lazy.Encoding as Text
import qualified Text.Megaparsec as P
import qualified Text.Megaparsec.Char as P
-- import qualified Text.Megaparsec.Debug as P
import qualified Data.ByteString.Lazy as BSL
import Paths_AoC2020

-- | See https://adventofcode.com/2020/day/4 for the problem statements
data Day04Results = Day04Results
  { example1 :: Int
  , batch1 :: Int
  , example2 :: Int
  , batch2 :: Int
  } deriving (Show)

main :: IO ()
main = do
  putStr "Day04Inputs: " >> getDataFileName "" >>= putStrLn
  print =<< Day04Results
    <$> parsePassports parserPassport "example"
    <*> parsePassports parserPassport "batch"
    <*> parsePassports parserValidPassport "example"
    <*> parsePassports parserValidPassport "batch"

data Passport = Passport {
  pp_byr :: Text, -- Birth Year
  pp_iyr :: Text, -- Issue Year
  pp_eyr :: Text, -- Expiration Year
  pp_hgt :: Text, -- Height
  pp_hcl :: Text, -- Hair Color
  pp_ecl :: Text, -- Eye Color
  pp_pid :: Text, -- Passport ID
  pp_cid :: Maybe Text -- Country ID
} deriving (Show)

type Parser output = P.Parsec {-error-}Void {-input-}Text output

parserPassportEntry :: Text -> Parser Text
parserPassportEntry key = -- P.dbg "PassportEntry" $
  P.string key
  *> P.char ':'
  *> P.takeWhileP (Just "value") (\c -> c /= ' ' && c /= '\n')

parserPassport :: Parser Passport
parserPassport = -- P.dbg "Passport" $
  P.intercalateEffect (P.char ' ' <|> P.try (P.char '\n' <* P.notFollowedBy (P.char '\n'))) $
    Passport
      <$> P.toPermutation (parserPassportEntry "byr")
      <*> P.toPermutation (parserPassportEntry "iyr")
      <*> P.toPermutation (parserPassportEntry "eyr")
      <*> P.toPermutation (parserPassportEntry "hgt")
      <*> P.toPermutation (parserPassportEntry "hcl")
      <*> P.toPermutation (parserPassportEntry "ecl")
      <*> P.toPermutation (parserPassportEntry "pid")
      <*> P.toPermutationWithDefault Nothing (Just <$> parserPassportEntry "cid")

parserPassports :: Show passport => Parser passport -> Parser [passport]
parserPassports passportParser = (catMaybes <$>) $
  -- P.dbg "parserPassports" $
  P.sepBy (
      Just <$> P.try (passportParser <* (() <$ P.char '\n' <|> P.eof)) <|>
      Nothing <$ P.some (P.takeWhile1P (Just "line") (/= '\n') <* P.char '\n')
    ) (P.char '\n')

parsePassports :: Show passport => Parser passport -> FilePath -> IO Int
parsePassports passportParser input = do
  content <- Text.decodeUtf8 <$> (BSL.readFile =<< getDataFileName input)
  case P.parse (parserPassports passportParser <* P.eof) input content of
    Left err -> error (P.errorBundlePretty err)
    Right passports -> return $ length passports

-- byr (Birth Year) - four digits; at least 1920 and at most 2002.
-- iyr (Issue Year) - four digits; at least 2010 and at most 2020.
-- eyr (Expiration Year) - four digits; at least 2020 and at most 2030.
-- hgt (Height) - a number followed by either cm or in:
--     If cm, the number must be at least 150 and at most 193.
--     If in, the number must be at least 59 and at most 76.
-- hcl (Hair Color) - a # followed by exactly six characters 0-9 or a-f.
-- ecl (Eye Color) - exactly one of: amb blu brn gry grn hzl oth.
-- pid (Passport ID) - a nine-digit number, including leading zeroes.
-- cid (Country ID) - ignored, missing or not.
data ValidPassport = ValidPassport {
  vp_byr :: Int,
  vp_iyr :: Int,
  vp_eyr :: Int,
  vp_hgt :: Height,
  vp_hcl :: String,
  vp_ecl :: Eye,
  vp_pid :: Int,
  vp_cid :: Maybe Text
} deriving (Show)
data Height = Cm Int | In Int deriving (Show)
data Eye = Amb | Blu | Brn | Gry | Grn | Hzl | Oth deriving (Show)

parserValidPassport :: Parser ValidPassport
parserValidPassport = -- P.dbg "ValidPassport" $
  P.intercalateEffect (P.char ' ' <|> P.try (P.char '\n' <* P.notFollowedBy (P.char '\n'))) $
    ValidPassport
      <$> P.toPermutation (mkNum <$ P.string "byr:" <*> P.count 4 P.digitChar >>= \x -> do
       guard (1920 <= x && x <= 2002)
       return x)
      <*> P.toPermutation (mkNum <$ P.string "iyr:" <*> P.count 4 P.digitChar >>= \x -> do
       guard (2010 <= x && x <= 2020)
       return x)
      <*> P.toPermutation (mkNum <$ P.string "eyr:" <*> P.count 4 P.digitChar >>= \x -> do
       guard (2020 <= x && x <= 2030)
       return x)
      <*> P.toPermutation (P.string "hgt:" *> do
        x <- mkNum <$> P.some P.digitChar
        P.choice
          [ Cm <$ P.string "cm" <* guard (150 <= x && x <= 193) <*> pure x
          , In <$ P.string "in" <* guard (59 <= x && x <= 76) <*> pure x
          ]
        )
      <*> P.toPermutation (P.string "hcl:#" *> P.count 6 (P.digitChar <|> P.satisfy (\c -> 'a' <= c && c <= 'f')))
      <*> P.toPermutation (P.string "ecl:" *> P.choice
            [ Amb <$ P.string "amb"
            , Blu <$ P.string "blu"
            , Brn <$ P.string "brn"
            , Gry <$ P.string "gry"
            , Grn <$ P.string "grn"
            , Hzl <$ P.string "hzl"
            , Oth <$ P.string "oth"
            ])
      <*> P.toPermutation (mkNum <$ P.string "pid:" <*> P.count 9 P.digitChar)
      <*> P.toPermutationWithDefault Nothing (Just <$> parserPassportEntry "cid")
  where
  mkNum :: [Char] -> Int
  mkNum = List.foldl' step 0
    where step a c = a * 10 + fromIntegral (Char.digitToInt c)