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