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  -- Width of an padded 'Word8'
numWordBytes :: Int
numWordBytes = 4  -- Number of bytes to group into a 32-bit word


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

-- |'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 -> 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 -- Calculated width of the hex display panel
  numLineWords :: Int
numLineWords    = 4  -- Number of words to group onto a line
  addressWidth :: Int
addressWidth    = 4  -- Minimum width of a padded address

  numLineBytes :: Int
numLineBytes    = Int
numLineWords Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numWordBytes -- Number of bytes on a line
  replacementChar :: Char
replacementChar = '.' -- 'Char' to use for non-printable characters

  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' 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 :: 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' 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 :: 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' returns 'True' for non-control ascii characters.
-- These characters will all fit in a single character when rendered.
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' 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 :: 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)