module Codec.Binary.Xx
( 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 = forall a b. [a] -> [b] -> [(a, b)]
zip [Word8
0..] String
"+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
encodeArray :: Array Word8 Char
encodeArray :: Array Word8 Char
encodeArray = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Word8
0, Word8
64) [(Word8, Char)]
_encMap
decodeMap :: M.Map Char Word8
decodeMap :: Map Char Word8
decodeMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(forall a b. (a, b) -> b
snd (Word8, Char)
i, 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 EncIncData
e = [Word8] -> EncIncData -> EncIncRes String
eI [] EncIncData
e
where
enc3 :: [Word8] -> String
enc3 [Word8
o1, Word8
o2, Word8
o3] = forall a b. (a -> b) -> [a] -> [b]
map (Array Word8 Char
encodeArray forall i e. Ix i => Array i e -> i -> e
!) [Word8
i1, Word8
i2, Word8
i3, Word8
i4]
where
i1 :: Word8
i1 = Word8
o1 forall a. Bits a => a -> Int -> a
`shiftR` Int
2
i2 :: Word8
i2 = (Word8
o1 forall a. Bits a => a -> Int -> a
`shiftL` Int
4 forall a. Bits a => a -> a -> a
.|. Word8
o2 forall a. Bits a => a -> Int -> a
`shiftR` Int
4) forall a. Bits a => a -> a -> a
.&. Word8
0x3f
i3 :: Word8
i3 = (Word8
o2 forall a. Bits a => a -> Int -> a
`shiftL` Int
2 forall a. Bits a => a -> a -> a
.|. Word8
o3 forall a. Bits a => a -> Int -> a
`shiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Word8
0x3f
i4 :: Word8
i4 = Word8
o3 forall a. Bits a => a -> a -> a
.&. Word8
0x3f
eI :: [Word8] -> EncIncData -> EncIncRes String
eI [] EncIncData
EDone = forall i. i -> EncIncRes i
EFinal []
eI [Word8
o1] EncIncData
EDone = forall i. i -> EncIncRes i
EFinal forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ [Word8] -> String
enc3 [Word8
o1, Word8
0, Word8
0]
eI [Word8
o1, Word8
o2] EncIncData
EDone = forall i. i -> EncIncRes i
EFinal forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ [Word8] -> String
enc3 [Word8
o1, Word8
o2, Word8
0]
eI [Word8]
lo (EChunk [Word8]
bs) = String -> [Word8] -> EncIncRes String
doEnc [] ([Word8]
lo forall a. [a] -> [a] -> [a]
++ [Word8]
bs)
where
doEnc :: String -> [Word8] -> EncIncRes String
doEnc String
acc (Word8
o1:Word8
o2:Word8
o3:[Word8]
os) = String -> [Word8] -> EncIncRes String
doEnc (String
acc forall a. [a] -> [a] -> [a]
++ [Word8] -> String
enc3 [Word8
o1, Word8
o2, Word8
o3]) [Word8]
os
doEnc String
acc [Word8]
os = forall i. i -> (EncIncData -> EncIncRes i) -> EncIncRes i
EPart String
acc ([Word8] -> EncIncData -> EncIncRes String
eI [Word8]
os)
encode :: [Word8] -> String
encode :: [Word8] -> String
encode = forall {a}. (EncIncData -> EncIncRes [a]) -> [Word8] -> [a]
encoder EncIncData -> EncIncRes String
encodeInc
decodeInc :: DecIncData String -> DecIncRes String
decodeInc :: DecIncData String -> DecIncRes String
decodeInc DecIncData String
d = String -> DecIncData String -> DecIncRes String
dI [] DecIncData String
d
where
dec4 :: String -> Maybe [Word8]
dec4 String
cs = let
ds :: [Maybe Word8]
ds = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Char Word8
decodeMap) String
cs
[Word8
e1, Word8
e2, Word8
e3, Word8
e4] = forall a b. (a -> b) -> [a] -> [b]
map forall a. HasCallStack => Maybe a -> a
fromJust [Maybe Word8]
ds
o1 :: Word8
o1 = Word8
e1 forall a. Bits a => a -> Int -> a
`shiftL` Int
2 forall a. Bits a => a -> a -> a
.|. Word8
e2 forall a. Bits a => a -> Int -> a
`shiftR` Int
4
o2 :: Word8
o2 = Word8
e2 forall a. Bits a => a -> Int -> a
`shiftL` Int
4 forall a. Bits a => a -> a -> a
.|. Word8
e3 forall a. Bits a => a -> Int -> a
`shiftR` Int
2
o3 :: Word8
o3 = Word8
e3 forall a. Bits a => a -> Int -> a
`shiftL` Int
6 forall a. Bits a => a -> a -> a
.|. Word8
e4
allJust :: [Maybe a] -> Bool
allJust = forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Maybe a -> Bool
isJust
in if forall {a}. [Maybe a] -> Bool
allJust [Maybe Word8]
ds
then forall a. a -> Maybe a
Just [Word8
o1, Word8
o2, Word8
o3]
else forall a. Maybe a
Nothing
dI :: String -> DecIncData String -> DecIncRes String
dI [] DecIncData String
DDone = forall i. [Word8] -> i -> DecIncRes i
DFinal [] []
dI lo :: String
lo@[Char
c1, Char
c2] DecIncData String
DDone = forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall i. [Word8] -> i -> DecIncRes i
DFail [] String
lo)
(\ [Word8]
bs -> forall i. [Word8] -> i -> DecIncRes i
DFinal (forall a. Int -> [a] -> [a]
take Int
1 [Word8]
bs) [])
(String -> Maybe [Word8]
dec4 [Char
c1, Char
c2, Char
'+', Char
'+'])
dI lo :: String
lo@[Char
c1, Char
c2, Char
c3] DecIncData String
DDone = forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall i. [Word8] -> i -> DecIncRes i
DFail [] String
lo)
(\ [Word8]
bs -> forall i. [Word8] -> i -> DecIncRes i
DFinal (forall a. Int -> [a] -> [a]
take Int
2 [Word8]
bs) [])
(String -> Maybe [Word8]
dec4 [Char
c1, Char
c2, Char
c3, Char
'+'])
dI String
lo DecIncData String
DDone = forall i. [Word8] -> i -> DecIncRes i
DFail [] String
lo
dI String
lo (DChunk String
s) = [Word8] -> String -> DecIncRes String
doDec [] (String
lo forall a. [a] -> [a] -> [a]
++ String
s)
where
doDec :: [Word8] -> String -> DecIncRes String
doDec [Word8]
acc s' :: String
s'@(Char
c1:Char
c2:Char
c3:Char
c4:String
cs) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall i. [Word8] -> i -> DecIncRes i
DFail [Word8]
acc String
s')
(\ [Word8]
bs -> [Word8] -> String -> DecIncRes String
doDec ([Word8]
acc forall a. [a] -> [a] -> [a]
++ [Word8]
bs) String
cs)
(String -> Maybe [Word8]
dec4 [Char
c1, Char
c2, Char
c3, Char
c4])
doDec [Word8]
acc String
s' = 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 = forall i. (DecIncData i -> DecIncRes i) -> i -> Maybe [Word8]
decoder DecIncData String -> DecIncRes String
decodeInc
chop :: Int
-> String
-> [String]
chop :: Int -> String -> [String]
chop Int
n String
"" = []
chop Int
n String
s = let
enc_len :: Int
enc_len | Int
n forall a. Ord a => a -> a -> Bool
< Int
5 = Int
4
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
85 = Int
84
| Bool
otherwise = forall a. Ord a => a -> a -> a
min Int
64 forall a b. (a -> b) -> a -> b
$ (Int
n forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`div` Int
4 forall a. Num a => a -> a -> a
* Int
4
enc_line :: String
enc_line = forall a. Int -> [a] -> [a]
take Int
enc_len String
s
act_len :: Word8
act_len = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ case (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
enc_line forall a. Integral a => a -> a -> (a, a)
`divMod` Int
4) of
(Int
l, Int
0) -> Int
l forall a. Num a => a -> a -> a
* Int
3
(Int
l, Int
2) -> Int
l forall a. Num a => a -> a -> a
* Int
3 forall a. Num a => a -> a -> a
+ Int
1
(Int
l, Int
3) -> Int
l forall a. Num a => a -> a -> a
* Int
3 forall a. Num a => a -> a -> a
+ Int
2
len :: Char
len = (Array Word8 Char
encodeArray forall i e. Ix i => Array i e -> i -> e
! Word8
act_len)
in (Char
len forall a. a -> [a] -> [a]
: String
enc_line) forall a. a -> [a] -> [a]
: Int -> String -> [String]
chop Int
n (forall a. Int -> [a] -> [a]
drop Int
enc_len String
s)
unchop :: [String]
-> String
unchop :: [String] -> String
unchop [String]
ss = let
singleUnchop :: String -> String
singleUnchop (Char
l : String
cs) = let
act_len :: Int
act_len = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Map Char Word8
decodeMap forall k a. Ord k => Map k a -> k -> a
M.! Char
l
enc_len :: Int
enc_len = case (Int
act_len forall a. Integral a => a -> a -> (a, a)
`divMod` Int
3) of
(Int
n, Int
0) -> Int
n forall a. Num a => a -> a -> a
* Int
4
(Int
n, Int
1) -> Int
n forall a. Num a => a -> a -> a
* Int
4 forall a. Num a => a -> a -> a
+ Int
2
(Int
n, Int
2) -> Int
n forall a. Num a => a -> a -> a
* Int
4 forall a. Num a => a -> a -> a
+ Int
3
in forall a. Int -> [a] -> [a]
take Int
enc_len String
cs
in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
singleUnchop) String
"" [String]
ss