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
|
Back to HasIO, remove MonadIO
Following a fairly detailed discussion on slack, the feeling is
generally that it's better to have a single interface. While precision
is nice, it doesn't appear to buy us anything here. If that turns out to
be wrong, or limiting somehow, we can revisit it later. Also:
- it's easier for backend authors if the type of IO operations is
slightly less restrictive. For example, if it's in HasIO, that limits
alternative implementations, which might be awkward for some
alternative back ends.
- it's one less extra detail to learn. This is minor, but there needs to
be a clear advantage if there's more detail to learn.
- It is difficult to think of an underlying type that can't have a Monad
instance (I have personally never encountered one - if they turns out
to exist, again, we can revisit!)
2020-06-21 21:21:22 +03:00
|
|
|
dumpBuffer : HasIO io => Buffer -> io String
|
2020-06-13 22:20:53 +03:00
|
|
|
dumpBuffer buf = do
|
2020-06-21 17:25:40 +03:00
|
|
|
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
|
Back to HasIO, remove MonadIO
Following a fairly detailed discussion on slack, the feeling is
generally that it's better to have a single interface. While precision
is nice, it doesn't appear to buy us anything here. If that turns out to
be wrong, or limiting somehow, we can revisit it later. Also:
- it's easier for backend authors if the type of IO operations is
slightly less restrictive. For example, if it's in HasIO, that limits
alternative implementations, which might be awkward for some
alternative back ends.
- it's one less extra detail to learn. This is minor, but there needs to
be a clear advantage if there's more detail to learn.
- It is difficult to think of an underlying type that can't have a Monad
instance (I have personally never encountered one - if they turns out
to exist, again, we can revisit!)
2020-06-21 21:21:22 +03:00
|
|
|
printBuffer : HasIO io => Buffer -> io ()
|
2020-06-21 17:25:40 +03:00
|
|
|
printBuffer buf = putStrLn $ !(dumpBuffer buf)
|