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 Network.PublicSuffixList.Serialize (getDataStructure, putDataStructure) where
import Blaze.ByteString.Builder (Builder, fromWord8,
toByteString)
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
import qualified Data.ByteString as BS
import Data.Foldable (foldMap)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid (mappend)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Network.PublicSuffixList.Types
getTree :: BS.ByteString -> (Tree T.Text, BS.ByteString)
getTree =
loop Map.empty
where
loop m bs
| BS.null bs = (Node m, bs)
| BS.head bs == 0 = (Node m, BS.drop 1 bs)
| otherwise =
let (k, v, bs') = getPair bs
in loop (Map.insert k v m) bs'
getPair :: BS.ByteString -> (T.Text, Tree T.Text, BS.ByteString)
getPair bs0 =
(k, v, bs2)
where
(k, bs1) = getText bs0
(v, bs2) = getTree bs1
getText :: BS.ByteString -> (T.Text, BS.ByteString)
getText bs0 =
(TE.decodeUtf8 v, BS.drop 1 bs1)
where
(v, bs1) = BS.break (== 0) bs0
getDataStructure :: BS.ByteString -> DataStructure
getDataStructure bs0 =
(x, y)
where
(x, bs1) = getTree bs0
(y, _) = getTree bs1
putTree :: Tree T.Text -> Builder
putTree = putMap . children
putMap :: Map T.Text (Tree T.Text) -> Builder
putMap m = Data.Foldable.foldMap putPair (Map.toList m) `mappend` fromWord8 0
putPair :: (T.Text, Tree T.Text) -> Builder
putPair (x, y) = putText x `mappend` putTree y
putText :: T.Text -> Builder
putText t = fromText t `Data.Monoid.mappend` fromWord8 0
putDataStructure :: DataStructure -> BS.ByteString
putDataStructure (x, y) = toByteString $ putTree x `mappend` putTree y
|
