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