{-# 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