xxd on ByteArrayAccess, and xxd2 for ascii dump

1 files changed, 38 insertions, 5 deletions

diff --git a/src/Text/XXD.hs b/src/Text/XXD.hs
index d835b238..04c458a7 100644
--- a/src/Text/XXD.hs
+++ b/src/Text/XXD.hs
@@ -1,23 +1,56 @@
+{-# 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 :: Int -> ByteString -> [String]
-xxd offset bs | B.null bs = []
-xxd offset bs             = printf "%03x: %s" offset ds : xxd (offset + B.length xs) bs'
+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])
-                 $ B.unpack xs
-    (xs,bs') = B.splitAt 16 bs
+                 $ 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