1module Network.PublicSuffixList.Serialize (getDataStructure, putDataStructure) where
2
3import           Blaze.ByteString.Builder           (Builder, fromWord8,
4                                                     toByteString)
5import           Blaze.ByteString.Builder.Char.Utf8 (fromText)
6import qualified Data.ByteString                    as BS
7import           Data.Foldable                      (foldMap)
8import           Data.Map                           (Map)
9import qualified Data.Map                           as Map
10import           Data.Monoid                        (mappend)
11import qualified Data.Text                          as T
12import qualified Data.Text.Encoding                 as TE
13
14import           Network.PublicSuffixList.Types
15
16getTree :: BS.ByteString -> (Tree T.Text, BS.ByteString)
17getTree =
18    loop Map.empty
19  where
20    loop m bs
21        | BS.null bs = (Node m, bs)
22        | BS.head bs == 0 = (Node m, BS.drop 1 bs)
23        | otherwise =
24            let (k, v, bs') = getPair bs
25             in loop (Map.insert k v m) bs'
26
27getPair :: BS.ByteString -> (T.Text, Tree T.Text, BS.ByteString)
28getPair bs0 =
29    (k, v, bs2)
30  where
31    (k, bs1) = getText bs0
32    (v, bs2) = getTree bs1
33
34getText :: BS.ByteString -> (T.Text, BS.ByteString)
35getText bs0 =
36    (TE.decodeUtf8 v, BS.drop 1 bs1)
37  where
38    (v, bs1) = BS.break (== 0) bs0
39
40getDataStructure :: BS.ByteString -> DataStructure
41getDataStructure bs0 =
42    (x, y)
43  where
44    (x, bs1) = getTree bs0
45    (y, _) = getTree bs1
46
47putTree :: Tree T.Text -> Builder
48putTree = putMap . children
49
50putMap :: Map T.Text (Tree T.Text) -> Builder
51putMap m = Data.Foldable.foldMap putPair (Map.toList m) `mappend` fromWord8 0
52
53putPair :: (T.Text, Tree T.Text) -> Builder
54putPair (x, y) = putText x `mappend` putTree y
55
56putText :: T.Text -> Builder
57putText t = fromText t `Data.Monoid.mappend` fromWord8 0
58
59putDataStructure :: DataStructure -> BS.ByteString
60putDataStructure (x, y) = toByteString $ putTree x `mappend` putTree y
61
62