# Advent of Code 2021 day 16

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.

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 Transmission. hexPack combines two hex digits into one Word.

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 Integer.

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


## Code

You can get the code from my locally-hosed Git repo, or from Gitlab.