{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.XXD (xxd, xxd2) where

import Data.ByteArray (ByteArrayAccess)
import qualified Data.ByteArray as BA
import Data.Word
import Data.Bits
import Data.Char
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
    -}