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

<https://adventofcode.com/2023/day/1>

For each line in the input, create a two digit number from the first and
last digits on the line, then sum up all of these numbers.

>>> decode part1 <$> ["1abc2","pqr3stu8vwx","a1b2c3d4e5f","treb7uchet"]
[12,38,15,77]

>>> decode part2 <$> ["two1nine","eightwothree","abcone2threexyz","xtwone3four","4nineeightseven2","zoneight234","7pqrstsixteen"]
[29,83,13,24,42,14,76]

-}
module Main (main) where

import Advent (fromDigits, format)
import Text.ParserCombinators.ReadP (readP_to_S, string, (<++), choice, get)

-- | Parse the input and print answers to both parts.
--
-- >>> :main
-- 55123
-- 55260
main :: IO ()
IO ()
main =
 do [[Char]]
input <- [format|2023 1 (%s%n)*|]
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([([Char], Int)] -> [Char] -> Int
decode [([Char], Int)]
part1) [[Char]]
input))
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([([Char], Int)] -> [Char] -> Int
decode [([Char], Int)]
part2) [[Char]]
input))

part1, part2 :: [(String, Int)]
part1 :: [([Char], Int)]
part1 = [(Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i, Int
i) | Int
i <- [Int
0..Int
9]]
part2 :: [([Char], Int)]
part2 = [([Char], Int)]
part1 [([Char], Int)] -> [([Char], Int)] -> [([Char], Int)]
forall a. [a] -> [a] -> [a]
++
   [([Char]
"one"  ,Int
1),([Char]
"two"  ,Int
2),([Char]
"three",Int
3),
    ([Char]
"four" ,Int
4),([Char]
"five" ,Int
5),([Char]
"six"  ,Int
6),
    ([Char]
"seven",Int
7),([Char]
"eight",Int
8),([Char]
"nine" ,Int
9)]

-- | Lookup the earliest infix match from the key-value table in the input
-- string.
earliest :: [(String, a)] -> String -> a
earliest :: forall a. [([Char], a)] -> [Char] -> a
earliest [([Char], a)]
mapping [Char]
str =
  case ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
readP_to_S ReadP a
p [Char]
str of
    (a, [Char])
x:[(a, [Char])]
_ -> (a, [Char]) -> a
forall a b. (a, b) -> a
fst (a, [Char])
x
    []  -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char]
"no match for: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str)
  where
    p :: ReadP a
p = [ReadP a] -> ReadP a
forall a. [ReadP a] -> ReadP a
choice [a
v a -> ReadP [Char] -> ReadP a
forall a b. a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ReadP [Char]
string [Char]
k | ([Char]
k,a
v) <- [([Char], a)]
mapping] ReadP a -> ReadP a -> ReadP a
forall a. ReadP a -> ReadP a -> ReadP a
<++ (ReadP Char
get ReadP Char -> ReadP a -> ReadP a
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP a
p)

-- | Compute the calibration value for an input string using the
-- part-specific digit assignments.
decode :: [(String, Int)] -> String -> Int
decode :: [([Char], Int)] -> [Char] -> Int
decode [([Char], Int)]
mapping [Char]
str = Int -> [Int] -> Int
forall a. (HasCallStack, Integral a) => a -> [a] -> a
fromDigits Int
10 [Int
d1,Int
d2]
  where
    d1 :: Int
d1 = [([Char], Int)] -> [Char] -> Int
forall a. [([Char], a)] -> [Char] -> a
earliest [([Char], Int)]
mapping [Char]
str
    d2 :: Int
d2 = [([Char], Int)] -> [Char] -> Int
forall a. [([Char], a)] -> [Char] -> a
earliest [([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
k, Int
v) | ([Char]
k,Int
v) <- [([Char], Int)]
mapping] ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
str)