46 lines
1.5 KiB
Haskell
46 lines
1.5 KiB
Haskell
{-# LANGUAGE OverloadedStrings, RecursiveDo #-}
|
|
import Aoc
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import Data.Char
|
|
import Text.Earley
|
|
import Data.List
|
|
|
|
data Packet a = L [ Packet a ] | I a deriving Eq
|
|
|
|
instance Show a => Show (Packet a) where
|
|
show (I a) = show a
|
|
show (L xs) = show xs
|
|
|
|
instance Ord (Packet Int) where
|
|
compare (I a) (I b) = compare a b
|
|
compare (L (x:xs)) (L (b:bs)) = case compare x b of
|
|
LT -> LT
|
|
EQ -> compare xs bs
|
|
GT -> GT
|
|
compare (L a) (L b) = compare (length a) (length b)
|
|
compare (L a) (I b) = compare (L a) (L [I b])
|
|
compare (I a) (L b) = compare (L [I a]) (L b)
|
|
|
|
-- packet = nat | "[" innerPacket "]"
|
|
-- innerPacket = packet "," innerPacket | packet | epsilon
|
|
packetGrammar :: Grammar r (Prod r String Char (Packet Int))
|
|
packetGrammar = mdo
|
|
packet <- rule $ (I . read <$> number) <|> (L <$ token '[' <*> innerPacket <* token ']')
|
|
innerPacket <- rule $ (:) <$> packet <* token ',' <*> innerPacket <|> pure <$> packet <|> pure []
|
|
return packet
|
|
where number = some (satisfy isDigit)
|
|
|
|
parseLine :: String -> Packet Int
|
|
parseLine = head.fst.fullParses (parser packetGrammar)
|
|
|
|
p1 = sum.map fst.filter(snd).zip[1..].map((\[a,b] -> a < b).map parseLine).splitOn [].lines
|
|
l2 = L[L[I 2]]
|
|
l6 = L[L[I 6]]
|
|
p2 = (liftM2 (*).elemIndex l2<*>elemIndex l6).(I 1:).sort.(++[l2, l6]).map parseLine.filter(/=[]).lines
|
|
|
|
main = do
|
|
input <- getContents
|
|
print $ p1 input
|
|
let Just r2 = p2 input
|
|
print r2
|