module Hexdump
( prettyHexCfg, prettyHex, simpleHex
, Cfg(..), defaultCfg, wrapRange
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString as B (length, unpack)
import qualified Data.ByteString.Char8 as B8 (unpack)
import Data.Char (isAscii, isControl)
import Data.List (intercalate, transpose, unfoldr)
import Numeric (showHex)
byteWidth = 2 -- Width of an padded 'Word8'
numWordBytes = 4 -- Number of bytes to group into a 32-bit word
data Cfg = Cfg
{ startByte :: Int
, transformByte :: Int -> String -> String
}
defaultCfg :: Cfg
defaultCfg = Cfg
{ startByte = 0
, transformByte = \_ x -> x
}
wrapRange :: String -> String -> Int -> Int -> Int -> String -> String
wrapRange start end x y = \z txt -> if x <= z && z <= y
then start ++ txt ++ end
else txt
prettyHex :: ByteString -> String
prettyHex = prettyHexCfg defaultCfg
-- |'prettyHex' renders a 'ByteString' as a multi-line 'String' complete with
-- addressing, hex digits, and ASCII representation.
--
-- Sample output
--
-- @Length: 100 (0x64) bytes
--0000: 4b c1 ad 8a 5b 47 d7 57 48 64 e7 cc 5e b5 2f 6e K...[G.WHd..^./n
--0010: c5 b3 a4 73 44 3b 97 53 99 2d 54 e7 1b 2f 91 12 ...sD;.S.-T../..
--0020: c8 1a ff c4 3b 2b 72 ea 97 e2 9f e2 93 ad 23 79 ....;+r.......#y
--0030: e8 0f 08 54 02 14 fa 09 f0 2d 34 c9 08 6b e1 64 ...T.....-4..k.d
--0040: d1 c5 98 7e d6 a1 98 e2 97 da 46 68 4e 60 11 15 ...~......FhN`..
--0050: d8 32 c6 0b 70 f5 2e 76 7f 8d f2 3b ed de 90 c6 .2..p..v...;....
--0060: 93 12 9c e1 ....@
prettyHexCfg :: Cfg -> ByteString -> String
prettyHexCfg cfg bs = unlines (header : body)
where
hexDisplayWidth = 50 -- Calculated width of the hex display panel
numLineWords = 4 -- Number of words to group onto a line
addressWidth = 4 -- Minimum width of a padded address
numLineBytes = numLineWords * numWordBytes -- Number of bytes on a line
replacementChar = '.' -- 'Char' to use for non-printable characters
header = "Length: " ++ show (B.length bs)
++ " (0x" ++ showHex (B.length bs) ") bytes"
body = map (intercalate " ")
$ transpose [mkLineNumbers bs, mkHexDisplay bs, mkAsciiDump bs]
(startAddr',missingBytes) = startByte cfg `divMod` numLineBytes
startAddr = numLineBytes * startAddr'
blankByte = replicate byteWidth ' '
mkHexDisplay
= padLast hexDisplayWidth
. map (intercalate " ") . group numLineWords
. map (intercalate " ") . group numWordBytes
. (replicate missingBytes blankByte ++)
. highlight
. map (paddedShowHex byteWidth)
. B.unpack
highlight :: [String] -> [String]
highlight = zipWith (transformByte cfg) [ startByte cfg .. ]
mkAsciiDump = map concat
. group numLineBytes
. (replicate missingBytes [' '] ++)
. highlight
. cleanString . B8.unpack
cleanString = map go
where
go x | isWorthPrinting x = [x]
| otherwise = [replacementChar]
mkLineNumbers bs = [paddedShowHex addressWidth
(startAddr + x * numLineBytes) ++ ":"
| x <- [0 .. (missingBytes + B.length bs - 1)
`div` numLineBytes] ]
padLast w [x] = [x ++ replicate (w - length x) ' ']
padLast w (x:xs) = x : padLast w xs
padLast _ [] = []
-- |'paddedShowHex' displays a number in hexidecimal and pads the number
-- with 0 so that it has a minimum length of @w@.
paddedShowHex :: (Show a, Integral a) => Int -> a -> String
paddedShowHex w n = pad ++ str
where
str = showHex n ""
pad = replicate (w - length str) '0'
-- |'simpleHex' converts a 'ByteString' to a 'String' showing the octets
-- grouped in 32-bit words.
--
-- Sample output
--
-- @4b c1 ad 8a 5b 47 d7 57@
simpleHex :: ByteString -> String
simpleHex = intercalate " "
. map (intercalate " ") . group numWordBytes
. map (paddedShowHex byteWidth)
. B.unpack
-- |'isWorthPrinting' returns 'True' for non-control ascii characters.
-- These characters will all fit in a single character when rendered.
isWorthPrinting :: Char -> Bool
isWorthPrinting x = isAscii x && not (isControl x)
-- |'group' breaks up a list into sublists of size @n@. The last group
-- may be smaller than @n@ elements. When @n@ less not positive the
-- list is returned as one sublist.
group :: Int -> [a] -> [[a]]
group n
| n <= 0 = (:[])
| otherwise = unfoldr go
where
go [] = Nothing
go xs = Just (splitAt n xs)