Day 16, started.

advent-of-code.cabal

@@ -8,7 +8,7 @@ author:             Stuart A. Kurtz
 maintainer:         stuart@cs.uchicago.edu
 
 common aoc-common
-  build-depends       : base ^>=4.14.3.0, array, containers
+  build-depends       : base ^>=4.14.3.0, array, containers, mtl
   hs-source-dirs      : src
   default-extensions  : TypeApplications
   default-language    : Haskell2010

src/AOC-16a.hs

 module Main where
 
+import Control.Monad.State
+
+type HexString = String
+type BitString = String
+
+hex2bin :: HexString -> BitString
+hex2bin = concatMap c where
+  c '0' = "0000"
+  c '1' = "0001"
+  c '2' = "0010"
+  c '3' = "0011"
+  c '4' = "0100"
+  c '5' = "0101"
+  c '6' = "0110"
+  c '7' = "0111"
+  c '8' = "1000"
+  c '9' = "1001"
+  c 'A' = "1010"
+  c 'B' = "1011"
+  c 'C' = "1100"
+  c 'D' = "1101"
+  c 'E' = "1110"
+  c 'F' = "1111"
+  c ch  = error $ "hex2bin -- unexpected character: " ++ [ch]
+
+data PacketContents
+  = Literal Integer
+  | List [PacketContents]
+  deriving Show
+
+data Packet = Packet { version :: Integer, typeID :: Integer, contents :: PacketContents  }
+  deriving Show
+
+type BitState = State BitString
+
+bits :: Int -> BitState String
+bits n = do
+  s <- get
+  let r = take n s
+  if length r /= n
+  then error "bits -- not enough bits"
+  else do
+    put (drop n s)
+    pure r
+
+decode :: HexString -> (Packet,Int)
+decode s =  evalState process . hex2bin $ s where
+  process :: BitState (Packet,Int)
+  process = do
+    v <- bitsToInt <$> bits 3
+    t <- bitsToInt <$> bits 3
+    case t of
+      4 -> do
+        (n,nc) <- nibbles
+        pure $ (Packet v t (Literal (bitsToInt n)),nc+6)
+      _ -> do
+        lengthType <- bitsToInt <$> bits 1
+        case lengthType of
+          0 -> undefined
+          1 -> undefined
+          _ -> error "decode.process -- impossible lengthType"
+      
+nibbles :: BitState (BitString,Int)
+nibbles = iter 6 where
+  iter n = do
+    ns <- bits 5
+    case ns of
+      '0' : bs -> do
+        let npad = 4 - (n+5) `mod` 4
+        pad <- bits npad
+        if all (== '0') pad
+        then pure (bs,5+npad)
+        else error "decode -- invalid padding"
+      '1' : bs -> do
+        (rest,nrest) <- iter (n+5)
+        pure $ (bs ++ rest,nrest + 5)
+      c : _ -> error $ "nibbles.iter -- nonbinary character: " ++ [c]
+      "" -> error $ "nibbles.iter -- out of bits"
+
+bitsToInt :: BitString -> Integer
+bitsToInt = sum . zipWith (*) (iterate (*2) 1) . map bitValue . reverse
+
+bitValue :: Char -> Integer
+bitValue '0' = 0
+bitValue '1' = 1
+bitValue c = error $ "decode -- nonbinary character in bitValue: " ++ [c]
+
 main :: IO ()
-main = pure ()
+main = 
+  print . decode $ "D2FE28"