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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
module Main where
import Control.Monad (foldM)
import Data.Bifunctor (bimap, first, second)
import Data.Char (digitToInt)
import Data.Function (on)
import qualified Data.List as L
import Data.Map.Strict (Map, (!))
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Debug.Trace (traceShow, traceShowId)
import Utils
convertHex '0' = "0000"
convertHex '1' = "0001"
convertHex '2' = "0010"
convertHex '3' = "0011"
convertHex '4' = "0100"
convertHex '5' = "0101"
convertHex '6' = "0110"
convertHex '7' = "0111"
convertHex '8' = "1000"
convertHex '9' = "1001"
convertHex 'A' = "1010"
convertHex 'B' = "1011"
convertHex 'C' = "1100"
convertHex 'D' = "1101"
convertHex 'E' = "1110"
convertHex 'F' = "1111"
convertHex other = error $ "invalid hex: " ++ [other]
hexToBinaryString "" = ""
hexToBinaryString (hex : rest) = convertHex hex ++ hexToBinaryString rest
applyOperator opTypeId subValues = case opTypeId of
0 -> sum subValues
1 -> product subValues
2 -> minimum subValues
3 -> maximum subValues
5 ->
let [a, b] = subValues
in if a > b then 1 else 0
6 ->
let [a, b] = subValues
in if a < b then 1 else 0
7 ->
let [a, b] = subValues
in if a == b then 1 else 0
other -> error $ "invalid operator type id " ++ show opTypeId
parseTypeOperator :: Int -> String -> (Int, Int, String)
parseTypeOperator opTypeId binary =
let (lengthTypeID, binary') = splitAt 1 binary $> first binaryToInt
(versionSum, subValues, rest) = case lengthTypeID of
0 -> parseOpLengthId0 binary'
1 -> parseOpLengthId1 binary'
other -> error $ "invalid length type id " ++ show other
computedResult = applyOperator opTypeId subValues
in (versionSum, computedResult, rest)
parseOpLengthId0 :: String -> (Int, [Int], String)
parseOpLengthId0 binary =
let (subPacketsLength, binary') = splitAt 15 binary $> first binaryToInt
(subPackets, binary'') = splitAt subPacketsLength binary'
iter = iterate (\(_, _, sub) -> parse sub) (minBound, minBound, subPackets) $> tail .> takeUntil (\(_, _, rest) -> (not . null) rest)
(subVersions, results, rests) = iter $> unzip3
in (sum subVersions, results, binary'')
parseOpLengthId1 :: String -> (Int, [Int], String)
parseOpLengthId1 binary =
let (subPacketsCount, binary') = splitAt 11 binary $> first binaryToInt
iter = iterate (\(_, _, sub) -> parse sub) (minBound, minBound, binary') $> tail .> take subPacketsCount
(subVersions, results, rests) = iter $> unzip3
in (sum subVersions, results, last rests)
parseType4 :: [Char] -> (Int, String)
parseType4 binary =
let (result, rest) = parseType4' binary
in (binaryToInt result, rest)
parseType4' :: String -> (String, String)
parseType4' ('0' : rest) = splitAt 4 rest
parseType4' ('1' : rest) =
let (binary, rest') = splitAt 4 rest
(result, rest'') = parseType4' rest'
in (binary ++ result, rest'')
parseType4' other = error $ "invalid type 4: " ++ other
parse :: String -> (Int, Int, String)
parse "" = (0, minBound, "")
parse binary =
let (packetVersion, binary') = splitAt 3 binary $> first binaryToInt
(packetTypeID, binary'') = splitAt 3 binary' $> first binaryToInt
in case packetTypeID of
4 ->
let (result, rest) = parseType4 binary''
in (packetVersion, result, rest)
opTypeId ->
let (typeOpVersionSum, result, rest) = parseTypeOperator opTypeId binary''
in (packetVersion + typeOpVersionSum, result, rest)
main :: IO ()
main =
do
contents <- getContents
let binary = contents $> T.pack .> T.strip .> T.unpack .> hexToBinaryString
parse binary $> print
|
