Day 16 was building a parser, but it was one defined on a bit stream. While attoparsec has a binary-type instantiation, it doesn't seem to like it when fields span byte boundaries, as in this case.
The documentation for how to parse bitstreams uses libraries like Data.Binary.Bits.Get and Data.BitString, which no longer work with recent versions of GHC. It took a while to work out I should be using the Data.Bitstream library instead.
(An alternative is to use the
Stream interface to megaparsec, but dealing with bitstreams was enough learning for one day!)
As parsing the data was entirely deterministic (no backtracking or alternatives were neeed), I decided that a
State monad was the best way to handle plugging together the various parts of the parser.
Let's start with some data types.
type Transmission = BS.Bitstream BS.Right type ParseTrans = State Transmission data Packet = Packet Integer PacketContents deriving (Show, Eq) data PacketContents = Literal Integer | Sum [Packet] | Product [Packet] | Minimum [Packet] | Maximum [Packet] | GreaterThan Packet Packet | LessThan Packet Packet | EqualTo Packet Packet deriving (Show, Eq)
The first step is to get the sequence of hex digits into a
hexPack combines two hex digits into one
bitify :: String -> Transmission bitify = BS.fromByteString . BYS.pack . hexPack . map (fromIntegral . digitToInt) hexPack :: [Word8] -> [Word8] hexPack  =  hexPack (x:) = hexPack [x, 0] hexPack (x:y:xs) = ((x `shift` 4) .|. y) : hexPack xs
Then we have a few utility functions to pull a few bits out of the
Transmission. Note that these all happen in context of the
State monad. Note the use of
toBits to convert a few bits into an
getBool :: ParseTrans Bool getBool = do bs <- get let value = head $ BS.unpack $ BS.take 1 bs put $ BS.drop 1 bs return value getInt :: Int64 -> ParseTrans Integer getInt n = do bs <- get let value = BS.toBits $ BS.take n bs put $ BS.drop n bs return value getBits :: Int64 -> ParseTrans Transmission getBits n = do bs <- get let bits = BS.take n bs put $ BS.drop n bs return bits
And now to parsing a packet! I read the version and type tag then, depending on the type of packet, read either literal value or an operator.
Reading a literal uses an accumulator to keep track of the number so far, then the next four bits are added on. Depending on the
continues flag, reading may continue.
getPacket :: ParseTrans Packet getPacket = do version <- getInt 3 pType <- getInt 3 payload <- if pType == 4 then do val <- getLiteral return $ Literal val else do contents <- getOperatorContents return $ mkOperator pType contents return $ Packet version payload getLiteral :: ParseTrans Integer getLiteral = getLiteralAcc 0 getLiteralAcc :: Integer -> ParseTrans Integer getLiteralAcc acc = do continues <- getBool nybble <- getInt 4 let acc' = acc * 16 + nybble if continues then do getLiteralAcc acc' else return acc'
Parsing an operation takes more effort.
getOperatorContents handles reading the contained packets and
mkOperator combines the packets and the operator type.
getOperatorContents :: ParseTrans [Packet] getOperatorContents = do isNumPackets <- getBool if isNumPackets then do numPackets <- getInt 11 getPacketsByCount numPackets else do numBits <- getInt 15 subString <- getBits (fromIntegral numBits) return $ getPacketsByLength subString getPacketsByLength :: Transmission -> [Packet] getPacketsByLength bits | BS.null bits =  | otherwise = p : (getPacketsByLength remaining) where (p, remaining) = runState getPacket bits getPacketsByCount :: Integer -> ParseTrans [Packet] getPacketsByCount 0 = return  getPacketsByCount n = do p <- getPacket ps <- getPacketsByCount (n - 1) return (p : ps)
getOperatorContents reads the flag to determine the pattern for finding the next packets, uses that to find the correct count, then calls the right function for the required method of reading packets. The interesting wrinkle here is that
getPacketsByLength is given the required number of bits then sets off another parsing monad to handle them.
After that, the evaluation of the final results is simple. It would be a fold, but the implementation is complicated by the use of two mutually-recursive data types.
packetVersionSum :: Packet -> Integer packetVersionSum (Packet version contents) = version + (contentsVersionSum contents) contentsVersionSum :: PacketContents -> Integer contentsVersionSum (Sum packets) = sum $ map packetVersionSum packets contentsVersionSum (Product packets) = sum $ map packetVersionSum packets contentsVersionSum (Minimum packets) = sum $ map packetVersionSum packets contentsVersionSum (Maximum packets) = sum $ map packetVersionSum packets contentsVersionSum (Literal _) = 0 contentsVersionSum (GreaterThan packet1 packet2) = (packetVersionSum packet1) + (packetVersionSum packet2) contentsVersionSum (LessThan packet1 packet2) = (packetVersionSum packet1) + (packetVersionSum packet2) contentsVersionSum (EqualTo packet1 packet2) = (packetVersionSum packet1) + (packetVersionSum packet2) evaluatePacket :: Packet -> Integer evaluatePacket (Packet _version contents) = evaluateContents contents evaluateContents :: PacketContents -> Integer evaluateContents (Sum packets) = sum $ map evaluatePacket packets evaluateContents (Product packets) = product $ map evaluatePacket packets evaluateContents (Minimum packets) = minimum $ map evaluatePacket packets evaluateContents (Maximum packets) = maximum $ map evaluatePacket packets evaluateContents (Literal n) = n evaluateContents (GreaterThan packet1 packet2) = if (evaluatePacket packet1) > (evaluatePacket packet2) then 1 else 0 evaluateContents (LessThan packet1 packet2) = if (evaluatePacket packet1) < (evaluatePacket packet2) then 1 else 0 evaluateContents (EqualTo packet1 packet2) = if (evaluatePacket packet1) == (evaluatePacket packet2) then 1 else 0