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