module Codec.Binary.Base16
( EncIncData(..)
, EncIncRes(..)
, encodeInc
, encode
, DecIncData(..)
, DecIncRes(..)
, decodeInc
, decode
, chop
, unchop
) where
import Codec.Binary.Util
import Control.Monad
import Data.Array
import Data.Bits
import Data.Maybe
import Data.Word
import qualified Data.Map as M
_encMap :: [(Word8, Char)]
_encMap =
[ (0, '0'), (1, '1'), (2, '2'), (3, '3'), (4, '4')
, (5, '5'), (6, '6'), (7, '7'), (8, '8'), (9, '9')
, (10, 'A'), (11, 'B'), (12, 'C'), (13, 'D'), (14, 'E')
, (15, 'F') ]
encodeArray :: Array Word8 Char
encodeArray :: Array Word8 Char
encodeArray = (Word8, Word8) -> [(Word8, Char)] -> Array Word8 Char
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (0, 64) [(Word8, Char)]
_encMap
decodeMap :: M.Map Char Word8
decodeMap :: Map Char Word8
decodeMap = [(Char, Word8)] -> Map Char Word8
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [((Word8, Char) -> Char
forall a b. (a, b) -> b
snd (Word8, Char)
i, (Word8, Char) -> Word8
forall a b. (a, b) -> a
fst (Word8, Char)
i) | (Word8, Char)
i <- [(Word8, Char)]
_encMap]
encodeInc :: EncIncData -> EncIncRes String
encodeInc :: EncIncData -> EncIncRes String
encodeInc EDone = String -> EncIncRes String
forall i. i -> EncIncRes i
EFinal []
encodeInc (EChunk os :: [Word8]
os) = String -> (EncIncData -> EncIncRes String) -> EncIncRes String
forall i. i -> (EncIncData -> EncIncRes i) -> EncIncRes i
EPart ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Word8 -> String) -> [Word8] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> String
toHex [Word8]
os) EncIncData -> EncIncRes String
encodeInc
encode :: [Word8] -> String
encode :: [Word8] -> String
encode = (EncIncData -> EncIncRes String) -> [Word8] -> String
forall a. (EncIncData -> EncIncRes [a]) -> [Word8] -> [a]
encoder EncIncData -> EncIncRes String
encodeInc
decodeInc :: DecIncData String -> DecIncRes String
decodeInc :: DecIncData String -> DecIncRes String
decodeInc d :: DecIncData String
d = String -> DecIncData String -> DecIncRes String
dI [] DecIncData String
d
where
dec2 :: String -> Maybe Word8
dec2 cs :: String
cs = let
ds :: [Maybe Word8]
ds = (Char -> Maybe Word8) -> String -> [Maybe Word8]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Map Char Word8 -> Maybe Word8)
-> Map Char Word8 -> Char -> Maybe Word8
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> Map Char Word8 -> Maybe Word8
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Char Word8
decodeMap) String
cs
es :: [Word8]
es@[e1 :: Word8
e1, e2 :: Word8
e2] = (Maybe Word8 -> Word8) -> [Maybe Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Word8 -> Word8
forall a. HasCallStack => Maybe a -> a
fromJust [Maybe Word8]
ds
o :: Word8
o = Word8
e1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` 4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
e2
allJust :: [Maybe a] -> Bool
allJust = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> ([Maybe a] -> [Bool]) -> [Maybe a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Bool) -> [Maybe a] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Maybe a -> Bool
forall a. Maybe a -> Bool
isJust
in if [Maybe Word8] -> Bool
forall a. [Maybe a] -> Bool
allJust [Maybe Word8]
ds
then Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
o
else Maybe Word8
forall a. Maybe a
Nothing
dI :: String -> DecIncData String -> DecIncRes String
dI [] DDone = [Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFinal [] []
dI lo :: String
lo DDone = [Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFail [] String
lo
dI lo :: String
lo (DChunk s :: String
s) = [Word8] -> String -> DecIncRes String
doDec [] (String
lo String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)
where
doDec :: [Word8] -> String -> DecIncRes String
doDec acc :: [Word8]
acc s' :: String
s'@(c1 :: Char
c1:c2 :: Char
c2:cs :: String
cs) = DecIncRes String
-> (Word8 -> DecIncRes String) -> Maybe Word8 -> DecIncRes String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
([Word8] -> String -> DecIncRes String
forall i. [Word8] -> i -> DecIncRes i
DFail [Word8]
acc String
s')
(\ b :: Word8
b -> [Word8] -> String -> DecIncRes String
doDec ([Word8]
acc [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8
b]) String
cs)
(String -> Maybe Word8
dec2 [Char
c1, Char
c2])
doDec acc :: [Word8]
acc s :: String
s = [Word8]
-> (DecIncData String -> DecIncRes String) -> DecIncRes String
forall i. [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
DPart [Word8]
acc (String -> DecIncData String -> DecIncRes String
dI String
s)
decode :: String -> Maybe [Word8]
decode :: String -> Maybe [Word8]
decode = (DecIncData String -> DecIncRes String) -> String -> Maybe [Word8]
forall i. (DecIncData i -> DecIncRes i) -> i -> Maybe [Word8]
decoder DecIncData String -> DecIncRes String
decodeInc
chop :: Int
-> String
-> [String]
chop :: Int -> String -> [String]
chop n :: Int
n "" = []
chop n :: Int
n s :: String
s = let
enc_len :: Int
enc_len | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = 2
| Bool
otherwise = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 2
in Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
enc_len String
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
chop Int
n (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
enc_len String
s)
unchop :: [String]
-> String
unchop :: [String] -> String
unchop = (String -> String -> String) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> String -> String
forall a. [a] -> [a] -> [a]
(++) ""