-
Notifications
You must be signed in to change notification settings - Fork 0
/
Part1.hs
61 lines (53 loc) · 2.09 KB
/
Part1.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
module Main where
import Data.List (sort, intercalate)
main = do
txt <- getContents
let inp = concatMap hex2bin txt
print $ solve inp Nothing
solve [] _ = (0,[])
solve (v1:v2:v3:t1:t2:t3:xs) totalBytes =
case totalBytes of
Nothing -> (version + solvedInner, xs')
Just k | k > bitsParsed -> let (recSolve, recXs) = solve xs' (Just $ k - bitsParsed)
in (version + solvedInner + recSolve, recXs)
where version = bin2dec [v1,v2,v3]
typeId = bin2dec [t1,t2,t3]
(solvedInner,xs') = solve' typeId xs (fmap (\bc -> bc - 6) totalBytes)
bitsParsed = length xs' - (6 + length xs) -- yes it sucks
solve xs _ = (0,xs)
solve' _ [] _ = (0,[])
solve' typeId (lengthType:xs) totalBytes
| typeId == 4 = parseLiteral (lengthType:xs) 0
| lengthType == '0' = solveBits (drop 15 xs) (Just bitLength)
| otherwise = foldr (\_ (acc,bs) -> let (v,bs') = solve bs Nothing
in (acc+v,bs')) (0,drop 11 xs) [0..packetsToParse]
where
bitLength = bin2dec $ take 15 xs
packetsToParse = bin2dec $ take 11 xs
solveBits :: [Char] -> Maybe Int -> (Int, [Char])
solveBits xs bitLength = solve xs bitLength
parseLiteral :: [Char] -> Int -> (Int,[Char])
parseLiteral (a:b:c:d:e:xs) acc | a == '1' = parseLiteral xs acc'
| otherwise = (acc',xs)
where acc' = 0 -- oops... acc*16 + bin2dec [b,c,d,e]
parseLiteral xs acc = (acc,xs)
bin2dec = foldl (\acc d -> acc*2 + if d == '1' then 1 else 0) 0
hex2bin c = case c of
'0' -> "0000"
'1' -> "0001"
'2' -> "0010"
'3' -> "0011"
'4' -> "0100"
'5' -> "0101"
'6' -> "0110"
'7' -> "0111"
'8' -> "1000"
'9' -> "1001"
'A' -> "1010"
'B' -> "1011"
'C' -> "1100"
'D' -> "1101"
'E' -> "1110"
'F' -> "1111"
'\n' -> ""
_ -> error "Not hex input: " ++ [c]