@@ -0,0 +1,133 @@
1+module BitParser exposing
2+ ( BitParser
3+ , andThen
4+ , bit
5+ , bits
6+ , bitsToInt
7+ , fail
8+ , intBits
9+ , map
10+ , rawBits
11+ , run
12+ , succeed
13+ )
14+
15+import Bitwise
16+import Bytes exposing (Bytes)
17+import Bytes.Decode as BD
18+import Bytes.Encode as BE
19+
20+
21+run : BitParser a -> Bytes -> Maybe a
22+run (BitParser f) bytes =
23+ BD.decode (f { running = Nothing }) bytes |> Maybe.map Tuple.second
24+
25+
26+type alias BitParserState =
27+ { running : Maybe { byte : Int, length : Int }
28+ }
29+
30+
31+type BitParser a
32+ = BitParser (BitParserState -> BD.Decoder ( BitParserState, a ))
33+
34+
35+bit : BitParser Int
36+bit =
37+ BitParser
38+ (\{ running } ->
39+ case running of
40+ Nothing ->
41+ BD.unsignedInt8
42+ |> BD.map
43+ (\i ->
44+ ( { running = Just { byte = Bitwise.shiftRightBy 1 i, length = 7 } }
45+ , Bitwise.and 1 i
46+ )
47+ )
48+
49+ Just { byte, length } ->
50+ BD.succeed
51+ (if length == 1 then
52+ ( { running = Nothing }, byte )
53+
54+ else
55+ ( { running = Just { byte = Bitwise.shiftRightBy 1 byte, length = length - 1 } }
56+ , Bitwise.and 1 byte
57+ )
58+ )
59+ )
60+
61+
62+rawBits : Int -> BitParser (List Int)
63+rawBits n =
64+ let
65+ go i =
66+ if i <= 0 then
67+ succeed []
68+
69+ else
70+ bit |> andThen (\b -> map (\x -> b :: x) (go (i - 1)))
71+ in
72+ go n
73+
74+
75+
76+-- PERF: use `bytes` on byte boundaries
77+
78+
79+bits : Int -> BitParser Bytes
80+bits n =
81+ rawBits n |> map bitsToBytes
82+
83+
84+intBits : Int -> BitParser Int
85+intBits n =
86+ rawBits n |> map bitsToInt
87+
88+
89+bitsToInt : List Int -> Int
90+bitsToInt =
91+ List.foldr (\b acc -> Bitwise.shiftLeftBy 1 acc |> Bitwise.or b) 0
92+
93+
94+bitsToBytes : List Int -> Bytes
95+bitsToBytes bs =
96+ if bs == [] then
97+ emptyBytes
98+
99+ else
100+ let
101+ go bb =
102+ if List.length bb > 8 then
103+ BE.unsignedInt8 (List.take 8 bb |> bitsToInt) :: go (List.drop 8 bb)
104+
105+ else
106+ [ BE.unsignedInt8 (bb |> bitsToInt) ]
107+ in
108+ go bs |> BE.sequence |> BE.encode
109+
110+
111+emptyBytes : Bytes
112+emptyBytes =
113+ BE.encode (BE.sequence [])
114+
115+
116+andThen : (a -> BitParser b) -> BitParser a -> BitParser b
117+andThen f (BitParser g) =
118+ BitParser (\s -> g s |> BD.andThen (\( s1, a ) -> f a |> (\(BitParser h) -> h s1)))
119+
120+
121+map : (a -> b) -> BitParser a -> BitParser b
122+map f (BitParser g) =
123+ BitParser (\s -> g s |> BD.map (Tuple.mapSecond f))
124+
125+
126+succeed : a -> BitParser a
127+succeed a =
128+ BitParser (\state -> BD.succeed ( state, a ))
129+
130+
131+fail : BitParser a
132+fail =
133+ BitParser (always BD.fail)