Idris2/libs/contrib/Debug/Buffer.idr

45 lines
1.4 KiB
Idris
Raw Normal View History

2020-06-13 22:20:53 +03:00
module Debug.Buffer
import Data.Buffer
import Data.List
2020-06-14 01:57:53 +03:00
import Data.String.Extra
2020-06-13 22:20:53 +03:00
2020-06-13 22:53:06 +03:00
toHex : Int -> Int -> String
toHex d n = pack $ reverse $ foldl toHexDigit [] (slice d n [])
2020-06-13 22:20:53 +03:00
where
toHexDigit : List Char ->Int -> List Char
2020-06-13 22:53:06 +03:00
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)
2020-06-13 22:20:53 +03:00
2020-06-14 01:57:53 +03:00
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
2020-06-13 22:20:53 +03:00
renderRow : List Int -> String
2020-06-14 01:57:53 +03:00
renderRow dat = showSep " " 16 (map (toHex 2) dat) ++
" " ++ pack (map (\i => if i > 0x1f && i < 0x80 then chr i else '.') dat)
2020-06-13 22:20:53 +03:00
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 : HasIO io => Buffer -> io String
2020-06-13 22:20:53 +03:00
dumpBuffer buf = do
size <- liftIO $ rawSize buf
dat <- liftIO $ bufferData buf
2020-06-13 22:20:53 +03:00
let rows = group 16 dat
2020-06-14 01:57:53 +03:00
let hex = showSep "\n" 0 (map renderRow rows)
2020-06-13 22:20:53 +03:00
pure $ hex ++ "\n\ntotal size = " ++ show size
export
printBuffer : HasIO io => Buffer -> io ()
printBuffer buf = putStrLn $ !(dumpBuffer buf)