Merge pull request #299 from melted/debug_buf

Debug printing for buffers

libs/contrib/Debug/Buffer.idr

@@ -0,0 +1,44 @@
+module Debug.Buffer
+
+import Data.Buffer
+import Data.List
+import Data.String.Extra
+
+toHex : Int -> Int -> String
+toHex d n = pack $ reverse $ foldl toHexDigit [] (slice d n [])
+    where
+        toHexDigit : List Char ->Int -> List Char
+        toHexDigit acc i = chr (if i < 10 then i + ord '0' else (i-10) + ord 'A')::acc
+        slice : Int -> Int -> List Int -> List Int
+        slice 0 _ acc = acc
+        slice d n acc = slice (d-1) (n `div` 16) ((n `mod` 16)::acc)
+
+showSep : String -> Nat -> List String -> String
+showSep sep _ [] = ""
+showSep sep n [x] = x ++ replicate (3*n) ' '
+showSep sep Z (x :: xs) = x ++ sep ++ showSep sep Z xs
+showSep sep (S n) (x :: xs) = x ++ sep ++ showSep sep n xs
+
+renderRow : List Int -> String
+renderRow dat =  showSep " " 16 (map (toHex 2) dat) ++
+                "      " ++ pack (map (\i => if i > 0x1f && i < 0x80 then chr i else '.') dat)
+
+group : Nat -> List a -> List (List a)
+group n xs = worker [] xs
+    where
+        worker : List (List a) -> List a -> List (List a)
+        worker acc [] = reverse acc
+        worker acc ys = worker ((take n ys)::acc) (drop n ys)
+
+export
+dumpBuffer : Buffer -> IO String
+dumpBuffer buf = do
+    size <- rawSize buf
+    dat <- bufferData buf
+    let rows = group 16 dat
+    let hex = showSep "\n" 0 (map renderRow rows)
+    pure $ hex ++ "\n\ntotal size = " ++ show size
+
+export
+printBuffer : Buffer -> IO ()
+printBuffer buf = putStrLn $ !(dumpBuffer buf)

libs/contrib/contrib.ipkg

@@ -18,6 +18,8 @@ modules = Control.Delayed,
           Data.SortedSet,
           Data.String.Extra,
 
+          Debug.Buffer,
+
           Language.JSON,
           Language.JSON.Data,
           Language.JSON.Lexer,