0 | module Debug.Buffer
 1 |
 2 | import Data.Buffer
 3 | import Data.List
 4 | import Data.String
 5 |
 6 | toHex : Int -> Int -> String
 7 | toHex d n = pack $ reverse $ foldl toHexDigit [] (slice d n [])
 8 |     where
 9 |         toHexDigit : List Char -> Int -> List Char
10 |         toHexDigit acc i = chr (if i < 10 then i + ord '0' else (i-10) + ord 'A')::acc
11 |
12 |         slice : Int -> Int -> List Int -> List Int
13 |         slice 0 _ acc = acc
14 |         slice d n acc = slice (d-1) (n `div` 16) ((n `mod` 16)::acc)
15 |
16 | showSep : String -> Nat -> List String -> String
17 | showSep sep _ [] = ""
18 | showSep sep n [x] = x ++ replicate (3*n) ' '
19 | showSep sep Z (x :: xs) = x ++ sep ++ showSep sep Z xs
20 | showSep sep (S n) (x :: xs) = x ++ sep ++ showSep sep n xs
21 |
22 | renderRow : List Bits8 -> String
23 | renderRow dat = showSep " " 16 (map (toHex 2 . cast) dat) ++
24 |                 "      " ++ pack (map (\i => if i > 0x1f && i < 0x80 then chr (cast i) else '.') dat)
25 |
26 | group : Nat -> List a -> List (List a)
27 | group n xs = worker [] xs
28 |     where
29 |         worker : List (List a) -> List a -> List (List a)
30 |         worker acc [] = reverse acc
31 |         worker acc ys = worker ((take n ys)::acc) (drop n ys)
32 |
33 | export
34 | dumpBuffer : HasIO io => Buffer -> io String
35 | dumpBuffer buf = do
36 |     size <- liftIO $ rawSize buf
37 |     dat <- liftIO $ bufferData' buf
38 |     let rows = group 16 dat
39 |     let hex = showSep "\n" 0 (map renderRow rows)
40 |     pure $ hex ++ "\n\ntotal size = " ++ show size
41 |
42 | export
43 | printBuffer : HasIO io => Buffer -> io ()
44 | printBuffer buf = putStrLn $ !(dumpBuffer buf)
45 |