From 85b57ef9aa9f7108fe73a116e93c3ef2de5a37f1 Mon Sep 17 00:00:00 2001
From: stefan <stefan@intheopen.org>
Date: Tue, 19 Nov 2024 18:24:36 +0100
Subject: [PATCH] added unary encoding

---
 src/Encoding/Base2.hs |  1 +
 src/Encoding/Unary.hs | 63 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 64 insertions(+)
 create mode 100644 src/Encoding/Unary.hs

diff --git a/src/Encoding/Base2.hs b/src/Encoding/Base2.hs
index 2365ee9..c7446e9 100644
--- a/src/Encoding/Base2.hs
+++ b/src/Encoding/Base2.hs
@@ -31,6 +31,7 @@
 module Encoding.Base2
   ( enc2
   , dec2
+  , binaryToChar
   ) where
 
 import Data.Char (ord, chr, digitToInt, intToDigit)
diff --git a/src/Encoding/Unary.hs b/src/Encoding/Unary.hs
new file mode 100644
index 0000000..af86ac7
--- /dev/null
+++ b/src/Encoding/Unary.hs
@@ -0,0 +1,63 @@
+module Encoding.Unary
+  ( encunary
+  , decunary
+  ) where
+
+import Data.ByteString (ByteString)
+import Data.List (group)
+import qualified Data.ByteString.Char8 as BC
+import Encoding.Base2 (dec2, enc2, binaryToChar)
+import Debug.Trace (trace)
+
+encodeChuckNorris :: ByteString -> ByteString
+encodeChuckNorris binary = 
+  let cleanBinary = BC.filter (/= ' ') binary
+   in BC.unwords . concatMap encodeRunLength . group $ BC.unpack cleanBinary
+  where
+    encodeRunLength :: String -> [ByteString]
+    encodeRunLength xs@(x:_) = [prefix x, BC.pack (replicate (length xs) '0')]
+    encodeRunLength [] = []
+
+    prefix '0' = BC.pack "00"
+    prefix '1' = BC.pack "0"
+    prefix  c  = error $ "Invalid binary character encoding" ++ show c
+    
+pairs :: [a] -> [(a, a)]
+pairs (x:y:rest) = (x, y) : pairs rest
+pairs _ = []
+
+encunary :: ByteString -> ByteString
+encunary input = encodeChuckNorris $ enc2 input
+
+decodeChuckNorris :: ByteString -> ByteString
+decodeChuckNorris encoded = BC.pack . concatMap (BC.unpack . decodeRunLength) . pairs . BC.words $ encoded
+  where
+    decodeRunLength :: (ByteString, ByteString) -> ByteString
+    decodeRunLength (prefix, zeros)
+      | prefix == BC.pack "00" = BC.replicate (BC.length zeros) '0'
+      | prefix == BC.pack "0" = BC.replicate (BC.length zeros) '1'
+      | otherwise = error "Invalid Unary encoding"
+    -- pairs (x:y:rest) = (x, y) : pairs rest
+    -- pairs _ = []
+
+    -- decodeRunLength ("00", zeros) = replicate (BC.length zeros) '0'
+    -- decodeRunLength ("0", zeros) = replicate (BC.length zeros) '1'
+    -- decodeRunLength _ = error "Invalid Unary encoding"
+
+decunary :: ByteString -> ByteString
+decunary encoded =
+  let binaryStr = decodeChuckNorris encoded
+  in BC.pack $ map binaryToChar (chunkBinaryString binaryStr)
+  where
+    chunkBinaryString :: ByteString -> [ByteString]
+    chunkBinaryString bs
+      | BC.null bs = []
+      | otherwise  = let (chunk, rest) = BC.splitAt 8 bs
+                     in chunk : chunkBinaryString rest
+
+-- encunary input = 
+--   let binaryStr = enc2 input
+--    in trace (show binaryStr) $ encodeChuckNorris binaryStr
+
+-- decunary :: ByteString -> ByteString
+-- decunary encoded = dec2 $ decodeChuckNorris encoded