From fc9ed0a8f3d71b529fb4277ce55c761f1df737ee Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Sun, 19 Nov 2017 13:19:13 -0500
Subject: Simplified xxd hex-dump code.

---
 src/Text/XXD.hs | 49 +++++++++++++++++++++----------------------------
 1 file changed, 21 insertions(+), 28 deletions(-)

diff --git a/src/Text/XXD.hs b/src/Text/XXD.hs
index 04c458a7..b73a1ea2 100644
--- a/src/Text/XXD.hs
+++ b/src/Text/XXD.hs
@@ -1,5 +1,6 @@
+{-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-module Text.XXD where
+module Text.XXD (xxd, xxd2) where
 
 import qualified Data.ByteString.Base16 as Base16
 import Data.ByteString (ByteString)
@@ -15,45 +16,37 @@ 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'
+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
-    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)
 
+xxd :: ByteArrayAccess a => Int -> a -> [String]
+xxd = xxd0 (const "")
+
 -- | 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
+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 = let c = chr (fromIntegral w)
+            where word8tochar w | (w .&. 0x80 /= 0) = '.'
+                  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
+    mapM_ putStrLn $ xxd2 0 bs
     -}
-- 
cgit v1.2.3