summaryrefslogtreecommitdiff
path: root/src/Text/XXD.hs
blob: b73a1ea231874e3d57fb7e4e34c32eb6dfc986d9 (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
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.XXD (xxd, xxd2) 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))

nibbles :: ByteArrayAccess ba => ba -> String
nibbles xs = unwords $ map (\byte -> [nibble (byte `shiftR` 4), nibble byte])
                     $ BA.unpack xs

xxd0 :: (ByteArrayAccess ba) => (forall b. ByteArrayAccess b => b -> String) -> Int -> ba -> [String]
xxd0 tr offset bs | BA.null bs = []
xxd0 tr offset bs              = printf "%03x: %s%s" offset (nibbles xs) (tr xs)
                                 : xxd0 tr (offset + BA.length xs) bs'
 where
    (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)

xxd :: ByteArrayAccess a => Int -> a -> [String]
xxd = xxd0 (const "")

-- | like xxd, but also shows ascii
xxd2 :: ByteArrayAccess a => Int -> a -> [String]
xxd2 = xxd0 withAscii

withAscii :: ByteArrayAccess a => a -> [Char]
withAscii row = replicate (50 - 3 * BA.length row) ' ' ++ myunpack row
    where
        myunpack s = map word8tochar (BA.unpack s)
            where word8tochar w | (w .&. 0x80 /= 0) = '.'
                  word8tochar w = let c = chr (fromIntegral w)
                                      in if isPrint c then c else '.'

{-
main = do
    bs <- B.getContents
    mapM_ putStrLn $ xxd2 0 bs
    -}