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
numWordBytes = 4
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
prettyHexCfg :: Cfg -> ByteString -> String
prettyHexCfg cfg bs = unlines (header : body)
where
hexDisplayWidth = 50
numLineWords = 4
addressWidth = 4
numLineBytes = numLineWords * numWordBytes
replacementChar = '.'
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 :: (Show a, Integral a) => Int -> a -> String
paddedShowHex w n = pad ++ str
where
str = showHex n ""
pad = replicate (w - length str) '0'
simpleHex :: ByteString -> String
simpleHex = intercalate " "
. map (intercalate " ") . group numWordBytes
. map (paddedShowHex byteWidth)
. B.unpack
isWorthPrinting :: Char -> Bool
isWorthPrinting x = isAscii x && not (isControl x)
group :: Int -> [a] -> [[a]]
group n
| n <= 0 = (:[])
| otherwise = unfoldr go
where
go [] = Nothing
go xs = Just (splitAt n xs)