Make haddockRender report file size and CRC32 (instead of filename)

Author: quchen

package.yaml

@@ -18,6 +18,7 @@ dependencies:
     - base >= 4.7 && < 5
 
     - alfred-margaret
+    - bytestring
     - cairo
     - colour
     - containers

src/Data/Crc32.hs

@@ -0,0 +1,61 @@
+module Data.Crc32 (
+      crc32
+    , Crc32(..)
+) where
+
+
+
+import           Data.Bits
+import           Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as BSL
+import           Data.Vector          (Vector, (!))
+import qualified Data.Vector          as V
+import           Data.Word
+import           Text.Printf
+
+
+
+table :: Vector Word32
+table = createCrc32Table 0xedb88320
+
+createCrc32Table :: Word32 -> Vector Word32
+createCrc32Table poly = V.generate 256 $ \n -> V.foldl'
+    (\acc _ -> if odd acc
+        then poly `xor` shiftR acc 1
+        else shiftR acc 1
+        )
+    (fromIntegral n)
+    (V.enumFromN 0 8)
+
+-- fn crc32_compute_table() -> [u32; 256] {
+--     let mut crc32_table = [0; 256];
+--
+--     for n in 0..256 {
+--         crc32_table[n as usize] = (0..8).fold(n as u32, |acc, _| {
+--             match acc & 1 {
+--                 1 => 0xedb88320 ^ (acc >> 1),
+--                 _ => acc >> 1,
+--             }
+--         });
+--     }
+--
+--     crc32_table
+-- }
+
+newtype Crc32 = Crc32 Word32
+    deriving (Eq, Ord)
+
+instance Show Crc32 where show (Crc32 crc) = printf "%#08x" crc
+
+-- | CRC32 checksum.
+--
+-- >>> import Data.ByteString.Lazy.Char8
+-- >>> crc32 (pack "The quick brown fox jumps over the lazy dog")
+-- 0x414fa339
+--
+-- >>> crc32 (pack "123456789")
+-- 0xcbf43926
+crc32 :: ByteString -> Crc32
+crc32 bs =
+    let Crc32 crcResult = BSL.foldl' (\(Crc32 crc) byte -> Crc32 (xor (crc `shiftR` 8) (table ! fromIntegral (fromIntegral (crc .&. 0xff) `xor` byte)))) (Crc32 0xffffffff) bs
+    in Crc32 (complement crcResult)

src/Draw.hs

@@ -60,15 +60,19 @@ module Draw (
 
 
 
-import Control.Monad
-import Data.Default.Class
-import Data.Foldable
-import Data.List
-import Graphics.Rendering.Cairo        as C hiding (x, y)
-import Graphics.Rendering.Cairo.Matrix (Matrix (..))
-import System.Directory
-import System.FilePath
-
+import           Control.Monad
+import qualified Data.ByteString.Lazy            as BSL
+import           Data.Default.Class
+import           Data.Foldable
+import           Data.Int
+import           Data.List
+import           Graphics.Rendering.Cairo        as C hiding (x, y)
+import           Graphics.Rendering.Cairo.Matrix (Matrix (..))
+import           System.Directory
+import           System.FilePath
+import           Text.Printf
+
+import Data.Crc32
 import Draw.Color
 import Draw.Color.Schemes.Continuous
 import Draw.Color.Schemes.Discrete
@@ -217,6 +221,10 @@ coordinateSystem cosy = do
 
 -- | Render pictures for Haddock with doctests. Nomenclature: the 'FilePath' for
 -- /Foo.Bar.Baz/ is /Foo\/Bar\/Baz\/pic_name.svg/.
+--
+-- Prints status information about the generated file so that doctests fail when
+-- the file contents change. Inspect the new output and update the output if the
+-- result is OK.
 haddockRender :: FilePath -> Int -> Int -> Render () -> IO ()
 haddockRender filename w h actions = do
     let filepath = "docs/haddock/" ++ filename
@@ -244,7 +252,7 @@ haddockRender filename w h actions = do
             haddockAxes (Vec2 5 5) 15
 
     normalizeSvgFile filepath
-    putStrLn filepath
+    haddockPrintInfo filepath
 
 haddockGrid :: Int -> Int -> Render ()
 haddockGrid w h = grouped (paintWithAlpha 0.1) $ do
@@ -296,6 +304,20 @@ haddockAxes start len = grouped (paintWithAlpha 0.5) $ do
                           | otherwise      = mirrorYCoords
         in G.transform (G.translate (start +. Vec2 0 (len+5)) <> G.scale 2 <> directionFlip) y'
 
+haddockPrintInfo :: FilePath -> IO ()
+haddockPrintInfo filepath = do
+    contents <- BSL.readFile filepath
+    printf "Generated file: size %s, crc32: %s" (humanFilesize (BSL.length contents)) (show (crc32 contents))
+
+humanFilesize :: Int64 -> String
+humanFilesize = go suffixes
+  where
+    go [] size = printf "Oh wow this file is %d byte large I ran out of suffixes" size
+    go (suffix:rest) size
+        | size < 1000 = show size ++ suffix
+        | otherwise = go rest (size `div` 1000)
+    suffixes = ["B", "KB", "MB", "GB", "TB", "PB"] -- That should suffice.
+
 -- | 'Vec2'-friendly version of Cairo’s 'moveTo'.
 moveToVec :: Vec2 -> Render ()
 moveToVec (Vec2 x y) = moveTo x y