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

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

>>> :{
:main +
    "[1,1,3,1,1]\n\
    \[1,1,5,1,1]\n\
    \\n\
    \[[1],[2,3,4]]\n\
    \[[1],4]\n\
    \\n\
    \[9]\n\
    \[[8,7,6]]\n\
    \\n\
    \[[4,4],4,4]\n\
    \[[4,4],4,4,4]\n\
    \\n\
    \[7,7,7,7]\n\
    \[7,7,7]\n\
    \\n\
    \[]\n\
    \[3]\n\
    \\n\
    \[[[]]]\n\
    \[[]]\n\
    \\n\
    \[1,[2,[3,[4,[5,6,7]]]],8,9]\n\
    \[1,[2,[3,[4,[5,6,0]]]],8,9]\n"
:}
13
140

-}
module Main where

import Control.Applicative ((<|>))
import Data.List (sortBy)
import Text.ParserCombinators.ReadP (ReadP, sepBy, readS_to_P)

import Advent (format)

-- | An arbitrarily nested list of lists of Int
data T = N Int | L [T] deriving (T -> T -> Bool
(T -> T -> Bool) -> (T -> T -> Bool) -> Eq T
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: T -> T -> Bool
== :: T -> T -> Bool
$c/= :: T -> T -> Bool
/= :: T -> T -> Bool
Eq, ReadPrec [T]
ReadPrec T
Int -> ReadS T
ReadS [T]
(Int -> ReadS T)
-> ReadS [T] -> ReadPrec T -> ReadPrec [T] -> Read T
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS T
readsPrec :: Int -> ReadS T
$creadList :: ReadS [T]
readList :: ReadS [T]
$creadPrec :: ReadPrec T
readPrec :: ReadPrec T
$creadListPrec :: ReadPrec [T]
readListPrec :: ReadPrec [T]
Read, Int -> T -> ShowS
[T] -> ShowS
T -> String
(Int -> T -> ShowS) -> (T -> String) -> ([T] -> ShowS) -> Show T
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> T -> ShowS
showsPrec :: Int -> T -> ShowS
$cshow :: T -> String
show :: T -> String
$cshowList :: [T] -> ShowS
showList :: [T] -> ShowS
Show)

-- | Parse a single nested lists of integer value. This parser uses
-- a single letter name to make it accessible from the format quasiquoter.
t :: ReadP T
t :: ReadP T
t = [T] -> T
L ([T] -> T) -> ReadP String -> ReadP ([T] -> T)
forall a b. a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ReadP String
"[" ReadP ([T] -> T) -> ReadP [T] -> ReadP T
forall a b. ReadP (a -> b) -> ReadP a -> ReadP b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadP T
t ReadP T -> ReadP String -> ReadP [T]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
`sepBy` ReadP String
"," ReadP T -> ReadP String -> ReadP T
forall a b. ReadP a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP String
"]" ReadP T -> ReadP T -> ReadP T
forall a. ReadP a -> ReadP a -> ReadP a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Int -> T
N (Int -> T) -> ReadP Int -> ReadP T
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadS Int -> ReadP Int
forall a. ReadS a -> ReadP a
readS_to_P ReadS Int
forall a. Read a => ReadS a
reads

-- |
-- >>> :main
-- 5340
-- 21276
main :: IO ()
IO ()
main =
 do [(T, T)]
input <- [format|2022 13 (@t%n@t%n)&%n|]

    -- part 1: sum of 1-indexes of strictly ordered tuples
    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 [Int
i | (Int
i,(T
x,T
y)) <- [Int] -> [(T, T)] -> [(Int, (T, T))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1::Int ..] [(T, T)]
input, T -> T -> Ordering
compareT T
x T
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT])

    -- part 2: product of 1-indexes of two special values in sorted inputs
    let extra :: [T]
extra = [[T] -> T
L[[T] -> T
L[Int -> T
N Int
2]], [T] -> T
L[[T] -> T
L[Int -> T
N Int
6]]]
        sorted :: [T]
sorted = (T -> T -> Ordering) -> [T] -> [T]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy T -> T -> Ordering
compareT ([T]
extra [T] -> [T] -> [T]
forall a. [a] -> [a] -> [a]
++ [T
z | (T
x,T
y) <- [(T, T)]
input, T
z <- [T
x,T
y]])
    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
product [Int
i | (Int
i,T
x) <- [Int] -> [T] -> [(Int, T)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1::Int ..] [T]
sorted, T
x T -> [T] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [T]
extra])

-- | Compare two 'T' values together using a lexicographic order on
-- lists and promoting integer nodes to singleton list nodes as needed.
compareT :: T -> T -> Ordering
compareT :: T -> T -> Ordering
compareT (N Int
x ) (N Int
y ) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
y
compareT (L [T]
xs) (L [T]
ys) = [T] -> [T] -> Ordering
compareTs [T]
xs [T]
ys
compareT (N Int
x ) (L [T]
ys) = [T] -> [T] -> Ordering
compareTs [Int -> T
N Int
x] [T]
ys
compareT (L [T]
xs) (N Int
y ) = [T] -> [T] -> Ordering
compareTs [T]
xs [Int -> T
N Int
y]

-- | Lexicographic ordering of lists of 'T' values.
compareTs :: [T] -> [T] -> Ordering
compareTs :: [T] -> [T] -> Ordering
compareTs (T
x:[T]
xs) (T
y:[T]
ys) = T -> T -> Ordering
compareT T
x T
y Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> [T] -> [T] -> Ordering
compareTs [T]
xs [T]
ys
compareTs []     []     = Ordering
EQ
compareTs []     [T]
_      = Ordering
LT
compareTs [T]
_      [T]
_      = Ordering
GT