blob: 04c458a71a8feb5369c62280d51e1a8155b3eee6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
{-# LANGUAGE ScopedTypeVariables #-}
module Text.XXD where
import qualified Data.ByteString.Base16 as Base16
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.ByteArray (ByteArrayAccess,ByteArray)
import qualified Data.ByteArray as BA
import Data.Word
import Data.Bits
import Data.Char
import Data.List
import Text.Printf
nibble :: Word8 -> Char
nibble b = intToDigit (fromIntegral (b .&. 0x0F))
xxd :: (ByteArrayAccess ba) => Int -> ba -> [String]
xxd offset bs | BA.null bs = []
xxd offset bs = printf "%03x: %s" offset ds : xxd (offset + BA.length xs) bs'
where
ds = unwords $ map (\byte -> [nibble (byte `shiftR` 4), nibble byte])
$ BA.unpack xs
(xs,bs') = splitAtView 16 bs
splitAtView :: (ByteArrayAccess ba) => Int -> ba -> (BA.View ba, BA.View ba)
splitAtView n bs = (BA.takeView bs n, BA.dropView bs n)
-- | like xxd, but also shows ascii
xxd2 :: forall a. ByteArrayAccess a => Int -> a -> String
xxd2 offset bs | BA.null bs = []
xxd2 offset bs
= let xs = xxd offset bs
as = map myunpack $ every16Bytes bs -- (BA.view bs 0 (BA.length bs))
cs = zipWith (\x y -> [x,y]) xs as
in showColumns cs
where
myunpack s = map word8tochar (BA.unpack s)
where word8tochar w = let c = chr (fromIntegral w)
in if isPrint c then c else '.'
every16Bytes :: a -> [BA.View a]
every16Bytes bs = let l = BA.length bs
(ld,lm) = l `divMod` 16
offsets = [0 .. ld ]
lens = replicate (ld ) 16 ++ [lm]
in zipWith (\o l -> BA.view bs (o*16) l) offsets lens
showColumns :: [[String]] -> String
showColumns rows = do
let cols = transpose rows
ws = map (maximum . map (succ . length)) cols
fs <- rows
_ <- take 1 fs -- Guard against empty rows so that 'last' is safe.
" " ++ concat (zipWith (printf "%-*s") (init ws) (init fs)) ++ last fs ++ "\n"
{-
main = do
bs <- B.getContents
mapM_ putStrLn $ xxd 0 bs
-}
|
