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 :: Int
byteWidth = Int
2
numWordBytes :: Int
numWordBytes = Int
4
data Cfg = Cfg
{ Cfg -> Int
startByte :: Int
, Cfg -> Int -> String -> String
transformByte :: Int -> String -> String
}
defaultCfg :: Cfg
defaultCfg :: Cfg
defaultCfg = Cfg
{ startByte :: Int
startByte = Int
0
, transformByte :: Int -> String -> String
transformByte = \Int
_ String
x -> String
x
}
wrapRange :: String -> String -> Int -> Int -> Int -> String -> String
wrapRange :: String -> String -> Int -> Int -> Int -> String -> String
wrapRange String
start String
end Int
x Int
y = \Int
z String
txt -> if Int
x forall a. Ord a => a -> a -> Bool
<= Int
z Bool -> Bool -> Bool
&& Int
z forall a. Ord a => a -> a -> Bool
<= Int
y
then String
start forall a. [a] -> [a] -> [a]
++ String
txt forall a. [a] -> [a] -> [a]
++ String
end
else String
txt
prettyHex :: ByteString -> String
prettyHex :: ByteString -> String
prettyHex = Cfg -> ByteString -> String
prettyHexCfg Cfg
defaultCfg
prettyHexCfg :: Cfg -> ByteString -> String
prettyHexCfg :: Cfg -> ByteString -> String
prettyHexCfg Cfg
cfg ByteString
bs = [String] -> String
unlines (String
header forall a. a -> [a] -> [a]
: [String]
body)
where
hexDisplayWidth :: Int
hexDisplayWidth = Int
50
numLineWords :: Int
numLineWords = Int
4
addressWidth :: Int
addressWidth = Int
4
numLineBytes :: Int
numLineBytes = Int
numLineWords forall a. Num a => a -> a -> a
* Int
numWordBytes
replacementChar :: Char
replacementChar = Char
'.'
header :: String
header = String
"Length: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteString -> Int
B.length ByteString
bs)
forall a. [a] -> [a] -> [a]
++ String
" (0x" forall a. [a] -> [a] -> [a]
++ forall a. (Integral a, Show a) => a -> String -> String
showHex (ByteString -> Int
B.length ByteString
bs) String
") bytes"
body :: [String]
body = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [[a]] -> [a]
intercalate String
" ")
forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [[a]]
transpose [ByteString -> [String]
mkLineNumbers ByteString
bs, ByteString -> [String]
mkHexDisplay ByteString
bs, ByteString -> [String]
mkAsciiDump ByteString
bs]
(Int
startAddr',Int
missingBytes) = Cfg -> Int
startByte Cfg
cfg forall a. Integral a => a -> a -> (a, a)
`divMod` Int
numLineBytes
startAddr :: Int
startAddr = Int
numLineBytes forall a. Num a => a -> a -> a
* Int
startAddr'
blankByte :: String
blankByte = forall a. Int -> a -> [a]
replicate Int
byteWidth Char
' '
mkHexDisplay :: ByteString -> [String]
mkHexDisplay
= Int -> [String] -> [String]
padLast Int
hexDisplayWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [[a]] -> [a]
intercalate String
" ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [[a]]
group Int
numLineWords
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [[a]] -> [a]
intercalate String
" ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [[a]]
group Int
numWordBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Int -> a -> [a]
replicate Int
missingBytes String
blankByte forall a. [a] -> [a] -> [a]
++)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
highlight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Show a, Integral a) => Int -> a -> String
paddedShowHex Int
byteWidth)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack
highlight :: [String] -> [String]
highlight :: [String] -> [String]
highlight = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Cfg -> Int -> String -> String
transformByte Cfg
cfg) [ Cfg -> Int
startByte Cfg
cfg .. ]
mkAsciiDump :: ByteString -> [String]
mkAsciiDump = forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [[a]]
group Int
numLineBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Int -> a -> [a]
replicate Int
missingBytes [Char
' '] forall a. [a] -> [a] -> [a]
++)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
highlight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
cleanString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B8.unpack
cleanString :: String -> [String]
cleanString = forall a b. (a -> b) -> [a] -> [b]
map Char -> String
go
where
go :: Char -> String
go Char
x | Char -> Bool
isWorthPrinting Char
x = [Char
x]
| Bool
otherwise = [Char
replacementChar]
mkLineNumbers :: ByteString -> [String]
mkLineNumbers ByteString
bs = [forall a. (Show a, Integral a) => Int -> a -> String
paddedShowHex Int
addressWidth
(Int
startAddr forall a. Num a => a -> a -> a
+ Int
x forall a. Num a => a -> a -> a
* Int
numLineBytes) forall a. [a] -> [a] -> [a]
++ String
":"
| Int
x <- [Int
0 .. (Int
missingBytes forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
bs forall a. Num a => a -> a -> a
- Int
1)
forall a. Integral a => a -> a -> a
`div` Int
numLineBytes] ]
padLast :: Int -> [String] -> [String]
padLast Int
w [String
x] = [String
x forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
w forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x) Char
' ']
padLast Int
w (String
x:[String]
xs) = String
x forall a. a -> [a] -> [a]
: Int -> [String] -> [String]
padLast Int
w [String]
xs
padLast Int
_ [] = []
paddedShowHex :: (Show a, Integral a) => Int -> a -> String
paddedShowHex :: forall a. (Show a, Integral a) => Int -> a -> String
paddedShowHex Int
w a
n = String
pad forall a. [a] -> [a] -> [a]
++ String
str
where
str :: String
str = forall a. (Integral a, Show a) => a -> String -> String
showHex a
n String
""
pad :: String
pad = forall a. Int -> a -> [a]
replicate (Int
w forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str) Char
'0'
simpleHex :: ByteString -> String
simpleHex :: ByteString -> String
simpleHex = forall a. [a] -> [[a]] -> [a]
intercalate String
" "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [[a]] -> [a]
intercalate String
" ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [[a]]
group Int
numWordBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Show a, Integral a) => Int -> a -> String
paddedShowHex Int
byteWidth)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack
isWorthPrinting :: Char -> Bool
isWorthPrinting :: Char -> Bool
isWorthPrinting Char
x = Char -> Bool
isAscii Char
x Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isControl Char
x)
group :: Int -> [a] -> [[a]]
group :: forall a. Int -> [a] -> [[a]]
group Int
n
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = (forall a. a -> [a] -> [a]
:[])
| Bool
otherwise = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall {a}. [a] -> Maybe ([a], [a])
go
where
go :: [a] -> Maybe ([a], [a])
go [] = forall a. Maybe a
Nothing
go [a]
xs = forall a. a -> Maybe a
Just (forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs)