never executed always true always false

    1 {-|
    2 Module:      Y2021.D16
    3 Description: Advent of Code 2021 Day 16 Solutions.
    4 License:     MIT
    5 Maintainer:  @tylerjl
    6 
    7 Solutions to the 2021 day 16 set of problems for <adventofcode.com>.
    8 -}
    9 module Y2021.D16
   10   ( parse16
   11   , part16A
   12   , part16B
   13   ) where
   14 
   15 import Control.Applicative
   16 import Data.Attoparsec.Text as P
   17 import Data.Either.Utils       (fromRight)
   18 import Data.Foldable
   19 import Data.Monoid
   20 import Data.Text               (Text)
   21 
   22 import qualified Data.Text as T
   23 import qualified GHC.Exts  as L
   24 
   25 -- |Solution to part A
   26 part16A :: Text -> Int
   27 part16A = sumVersion . parse16
   28 
   29 sumVersion :: Packet -> Int
   30 sumVersion (PacketLit v _) = v
   31 sumVersion (PacketOp v _ ps) = v + getSum (foldMap (Sum . sumVersion) ps)
   32 
   33 -- |Solution to part B
   34 part16B :: Text -> Int
   35 part16B = decodePacket . parse16
   36 
   37 decodePacket :: Packet -> Int
   38 decodePacket (PacketLit _ n) = n
   39 decodePacket (PacketOp _ 0 ps) = foldl' (\acc -> (+) acc . decodePacket) 0 ps
   40 decodePacket (PacketOp _ 1 ps) = foldl' (\acc -> (*) acc . decodePacket) 1 ps
   41 decodePacket (PacketOp _ 2 ps) = minimum (map decodePacket ps)
   42 decodePacket (PacketOp _ 3 ps) = maximum (map decodePacket ps)
   43 decodePacket (PacketOp _ 5 [p1, p2])
   44   | decodePacket p1 > decodePacket p2 = 1
   45   | otherwise = 0
   46 decodePacket (PacketOp _ 6 [p1, p2])
   47   | decodePacket p1 < decodePacket p2 = 1
   48   | otherwise = 0
   49 decodePacket (PacketOp _ 7 [p1, p2])
   50   | decodePacket p1 == decodePacket p2 = 1
   51   | otherwise = 0
   52 decodePacket PacketOp {} = error "unknown operator packet"
   53 
   54 type Version = Int
   55 type PType = Int
   56 data Packet
   57   = PacketLit Version Int
   58   | PacketOp Version PType [Packet]
   59   deriving Show
   60 
   61 -- |Parse.
   62 parse16 :: Text -> Packet
   63 parse16 = fromRight . parseOnly parser . hexToBin
   64   where
   65     parser = packet <* atEnd
   66     packet = packetLit <|> packetOp
   67 
   68     packetLit = PacketLit <$> bitN 3 <* string "100" <*> (asInt . concat <$> litNumber)
   69     litNumber = litQuad
   70     litQuad = mappend <$> many litInit <*> ((: []) <$> litTail)
   71     litInit = char '1' *> count 4 bit
   72     litTail = char '0' *> count 4 bit
   73 
   74     packetOp = PacketOp <$> bitN 3 <*> bitN 3 <*> (lenPacket <|> numPacket)
   75     lenPacket = do
   76       _ <- char '0'
   77       len <- bitN 15
   78       parseOf (P.take len) (many1 packet)
   79     numPacket = do
   80       _ <- char '1'
   81       packets <- bitN 11
   82       count packets packet
   83 
   84     bitN n = asInt <$> count n bit
   85     asInt = convert . reverse
   86     bit = read . (: []) <$> binary
   87     binary = char '0' <|> char '1'
   88 
   89 constP :: Parser a -> Text -> Parser a
   90 constP p t = case parseOnly p t of
   91   Left _ -> empty
   92   Right a -> return a
   93 
   94 parseOf :: Parser Text -> Parser a -> Parser a
   95 parseOf ptxt pa = bothParse
   96   where
   97     bothParse = ptxt >>= constP pa
   98 
   99 hexToBin :: Text -> Text
  100 hexToBin = T.concat . map hexToBits  . L.toList
  101 
  102 convert :: [Int] -> Int
  103 convert [] = 0
  104 convert (x : xs) = x + 2 * convert xs
  105 
  106 hexToBits :: Char -> Text
  107 hexToBits '0' = "0000"
  108 hexToBits '1' = "0001"
  109 hexToBits '2' = "0010"
  110 hexToBits '3' = "0011"
  111 hexToBits '4' = "0100"
  112 hexToBits '5' = "0101"
  113 hexToBits '6' = "0110"
  114 hexToBits '7' = "0111"
  115 hexToBits '8' = "1000"
  116 hexToBits '9' = "1001"
  117 hexToBits 'A' = "1010"
  118 hexToBits 'B' = "1011"
  119 hexToBits 'C' = "1100"
  120 hexToBits 'D' = "1101"
  121 hexToBits 'E' = "1110"
  122 hexToBits 'F' = "1111"
  123 hexToBits _ = ""