Drop the cereal dependency

Create.hs

@@ -10,7 +10,6 @@ without doing anything at runtime.
 import qualified Data.ByteString        as BS
 import qualified Data.ByteString.UTF8   as U8
 import qualified Data.Conduit           as C
-import           Data.Serialize.Put
 import qualified Data.Text              as T
 import           Data.Time.Clock
 import qualified Network.HTTP.Conduit   as HC
@@ -48,7 +47,6 @@ main = do
     hPutStrLn h "import Network.PublicSuffixList.Types"
     hPutStrLn h "#if !defined(RUNTIMELIST)"
     hPutStrLn h "import qualified Data.ByteString      as BS"
-    hPutStrLn h "import           Data.Serialize.Get hiding (getTreeOf)"
     hPutStrLn h "import Network.PublicSuffixList.Serialize"
     hPutStrLn h "#else"
     hPutStrLn h "import qualified Network.PublicSuffixList.Create as PSLC"
@@ -69,9 +67,9 @@ main = do
     hPutStrLn h "{-# NOINLINE dataStructure #-}"
     hPutStrLn h "dataStructure = unsafePerformIO $ C.runResourceT $ sourceFile RUNTIMELIST C.$$ PSLC.sink"
     hPutStrLn h "#else"
-    hPutStrLn h "dataStructure = let Right ds = runGet getDataStructure serializedDataStructure in ds"
+    hPutStrLn h "dataStructure = getDataStructure serializedDataStructure"
     hPutStrLn h ""
     hPutStrLn h "serializedDataStructure :: BS.ByteString"
-    hPutStrLn h $ "serializedDataStructure = " ++ (show $ runPut $ putDataStructure ds)
+    hPutStrLn h $ "serializedDataStructure = " ++ (show $ putDataStructure ds)
     hPutStrLn h ""
     hPutStrLn h "#endif"

CreateTest.hs

@@ -20,8 +20,6 @@ header = [ "{-# LANGUAGE OverloadedStrings #-}"
          , ""
          , "import           Data.Char"
          , "import           Data.Maybe"
-         , "import           Data.Serialize.Get hiding (getTreeOf)"
-         , "import           Data.Serialize.Put"
          , "import qualified Data.Text                              as T"
          , "import           Debug.Trace"
          , "import           Network.PublicSuffixList.DataStructure"
@@ -45,8 +43,8 @@ footer :: [String]
 footer = [ "  ]"
          , ""
          , "testSerializationRoundTrip = TestCase $ assertEqual \"Round Trip\" dataStructure ds"
-         , "  where Right ds = runGet getDataStructure serializedDataStructure"
-         , "        serializedDataStructure = runPut $ putDataStructure dataStructure"
+         , "  where ds = getDataStructure serializedDataStructure"
+         , "        serializedDataStructure = putDataStructure dataStructure"
          , ""
          , "main = do"
          , "  counts <- runTestTT $ TestList [TestLabel \"Mozilla Tests\" hunittests, TestLabel \"Round Trip\" testSerializationRoundTrip]"

Network/PublicSuffixList/Serialize.hs

@@ -1,30 +1,61 @@
 module Network.PublicSuffixList.Serialize (getDataStructure, putDataStructure) where
 
-import qualified Data.ByteString          as BS
-import           Data.Functor
-import           Data.Serialize.Get       hiding (getTreeOf)
-import           Data.Serialize.Put
-import qualified Data.Text                as T
-import qualified Data.Text.Encoding       as TE
-import qualified Data.Text.Encoding.Error as TEE
-
-import Network.PublicSuffixList.Types
-
-getTreeOf :: Ord k => Get k -> Get (Tree k)
-getTreeOf p = Node <$> getMapOf p (getTreeOf p)
-
-getText :: Get T.Text
-getText = (TE.decodeUtf8With TEE.lenientDecode . BS.pack) <$> getListOf getWord8
-
-getDataStructure :: Get DataStructure
-getDataStructure = getTwoOf (getTreeOf getText) (getTreeOf getText)
-
-putTree :: Ord k => Putter k -> Putter (Tree k)
-putTree p = putMapOf p (putTree p) . children
-
-putText :: Putter T.Text
-putText = putListOf putWord8 . BS.unpack . TE.encodeUtf8
-
-putDataStructure :: Putter DataStructure
-putDataStructure = putTwoOf (putTree putText) (putTree putText)
+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.breakByte 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 = 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 `mappend` fromWord8 0
+
+putDataStructure :: DataStructure -> BS.ByteString
+putDataStructure (x, y) = toByteString $ putTree x `mappend` putTree y
 

Test/PublicSuffixList.hs

@@ -2,8 +2,6 @@
 
 import           Data.Char
 import           Data.Maybe
-import           Data.Serialize.Get hiding (getTreeOf)
-import           Data.Serialize.Put
 import qualified Data.Text                              as T
 import           Debug.Trace
 import           Network.PublicSuffixList.DataStructure
@@ -16,7 +14,7 @@ import           Text.IDNA
 
 effectiveTLDPlusOne' :: T.Text -> Maybe T.Text
 effectiveTLDPlusOne' = L.effectiveTLDPlusOne . T.intercalate "." . map (fromJust . toASCII False True . T.map toLower) . T.split (== '.')
--- DO NOT MODIFY! This file has been automatically generated from the CreateTest.hs script at 2015-04-29 04:36:37.485657 UTC
+-- DO NOT MODIFY! This file has been automatically generated from the CreateTest.hs script at 2015-04-29 05:00:07.582598 UTC
 hunittests :: Test
 hunittests = TestList [
   TestCase $ assertEqual "0" (Nothing) $ effectiveTLDPlusOne' "COM",
@@ -94,8 +92,8 @@ hunittests = TestList [
   TestCase $ assertEqual "72" (Nothing) $ effectiveTLDPlusOne' "xn--fiqs8s"  ]
 
 testSerializationRoundTrip = TestCase $ assertEqual "Round Trip" dataStructure ds
-  where Right ds = runGet getDataStructure serializedDataStructure
-        serializedDataStructure = runPut $ putDataStructure dataStructure
+  where ds = getDataStructure serializedDataStructure
+        serializedDataStructure = putDataStructure dataStructure
 
 main = do
   counts <- runTestTT $ TestList [TestLabel "Mozilla Tests" hunittests, TestLabel "Round Trip" testSerializationRoundTrip]

publicsuffixlist.cabal

@@ -23,7 +23,7 @@ library
                  , containers
                  , bytestring >= 0.9
                  , text       >= 0.11
-                 , cereal
+                 , blaze-builder
     if flag(create)
         build-depends: idna             >= 0.1.2 && < 1.0
                      , conduit          >= 1.0.0 && < 2.0.0
@@ -47,9 +47,8 @@ Test-Suite test-public-suffix-list
                  , text     >= 0.11
                  , HUnit
                  , idna     >= 0.1.1   && < 1.0
-                 , utf8-string
-                 , cereal
                  , bytestring
+                 , blaze-builder
 
 source-repository head
   type:     git