-- |
-- Module    : Codec.Binary.Xx
-- Copyright : (c) 2007 Magnus Therning
-- License   : BSD3
--
-- Xxencoding is obsolete but still included for completeness.  Further
-- information on the encoding can be found at
-- <http://en.wikipedia.org/wiki/Xxencode>.  It should be noted that this
-- implementation performs no padding, due to the splitting up between encoding
-- and chopping.
--
-- Further documentation and information can be found at
-- <http://www.haskell.org/haskellwiki/Library/Data_encoding>.
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

-- {{{1 enc/dec map
_encMap :: [(Word8, Char)]
_encMap = [Word8] -> [Char] -> [(Word8, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word8
0..] [Char]
"+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

-- {{{1 encodeArray
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 (Word8
0, Word8
64) [(Word8, Char)]
_encMap

-- {{{1 decodeMap
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]

-- {{{1 encode
-- | Incremental encoder function.
encodeInc :: EncIncData -> EncIncRes String
encodeInc :: EncIncData -> EncIncRes [Char]
encodeInc EncIncData
e = [Word8] -> EncIncData -> EncIncRes [Char]
eI [] EncIncData
e
    where
        enc3 :: [Word8] -> [Char]
enc3 [Word8
o1, Word8
o2, Word8
o3] = (Word8 -> Char) -> [Word8] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (Array Word8 Char
encodeArray Array Word8 Char -> Word8 -> Char
forall i e. Ix i => Array i e -> i -> e
!) [Word8
i1, Word8
i2, Word8
i3, Word8
i4]
            where
                i1 :: Word8
i1 = Word8
o1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
2
                i2 :: Word8
i2 = (Word8
o1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
o2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x3f
                i3 :: Word8
i3 = (Word8
o2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
2 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
o3 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x3f
                i4 :: Word8
i4 = Word8
o3 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x3f

        eI :: [Word8] -> EncIncData -> EncIncRes [Char]
eI [] EncIncData
EDone = [Char] -> EncIncRes [Char]
forall i. i -> EncIncRes i
EFinal []
        eI [Word8
o1] EncIncData
EDone = [Char] -> EncIncRes [Char]
forall i. i -> EncIncRes i
EFinal ([Char] -> EncIncRes [Char]) -> [Char] -> EncIncRes [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
2 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Word8] -> [Char]
enc3 [Word8
o1, Word8
0, Word8
0]
        eI [Word8
o1, Word8
o2] EncIncData
EDone = [Char] -> EncIncRes [Char]
forall i. i -> EncIncRes i
EFinal ([Char] -> EncIncRes [Char]) -> [Char] -> EncIncRes [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
3 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Word8] -> [Char]
enc3 [Word8
o1, Word8
o2, Word8
0]
        eI [Word8]
lo (EChunk [Word8]
bs) = [Char] -> [Word8] -> EncIncRes [Char]
doEnc [] ([Word8]
lo [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8]
bs)
            where
                doEnc :: [Char] -> [Word8] -> EncIncRes [Char]
doEnc [Char]
acc (Word8
o1:Word8
o2:Word8
o3:[Word8]
os) = [Char] -> [Word8] -> EncIncRes [Char]
doEnc ([Char]
acc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Word8] -> [Char]
enc3 [Word8
o1, Word8
o2, Word8
o3]) [Word8]
os
                doEnc [Char]
acc [Word8]
os = [Char] -> (EncIncData -> EncIncRes [Char]) -> EncIncRes [Char]
forall i. i -> (EncIncData -> EncIncRes i) -> EncIncRes i
EPart [Char]
acc ([Word8] -> EncIncData -> EncIncRes [Char]
eI [Word8]
os)

-- | Encode data.
encode :: [Word8] -> String
encode :: [Word8] -> [Char]
encode = (EncIncData -> EncIncRes [Char]) -> [Word8] -> [Char]
forall {a}. (EncIncData -> EncIncRes [a]) -> [Word8] -> [a]
encoder EncIncData -> EncIncRes [Char]
encodeInc

-- {{{1 decode
-- | Incremental decoder function.
decodeInc :: DecIncData String -> DecIncRes String
decodeInc :: DecIncData [Char] -> DecIncRes [Char]
decodeInc DecIncData [Char]
d = [Char] -> DecIncData [Char] -> DecIncRes [Char]
dI [] DecIncData [Char]
d
    where
        dec4 :: [Char] -> Maybe [Word8]
dec4 [Char]
cs = let
                ds :: [Maybe Word8]
ds = (Char -> Maybe Word8) -> [Char] -> [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) [Char]
cs
                [Word8
e1, Word8
e2, Word8
e3, Word8
e4] = (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
                o1 :: Word8
o1 = Word8
e1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
2 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
e2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4
                o2 :: Word8
o2 = Word8
e2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
e3 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
2
                o3 :: Word8
o3 = Word8
e3 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
6 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
e4
                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
o1, Word8
o2, Word8
o3]
                else Maybe [Word8]
forall a. Maybe a
Nothing

        dI :: [Char] -> DecIncData [Char] -> DecIncRes [Char]
dI [] DecIncData [Char]
DDone = [Word8] -> [Char] -> DecIncRes [Char]
forall i. [Word8] -> i -> DecIncRes i
DFinal [] []
        dI lo :: [Char]
lo@[Char
c1, Char
c2] DecIncData [Char]
DDone = DecIncRes [Char]
-> ([Word8] -> DecIncRes [Char])
-> Maybe [Word8]
-> DecIncRes [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            ([Word8] -> [Char] -> DecIncRes [Char]
forall i. [Word8] -> i -> DecIncRes i
DFail [] [Char]
lo)
            (\ [Word8]
bs -> [Word8] -> [Char] -> DecIncRes [Char]
forall i. [Word8] -> i -> DecIncRes i
DFinal (Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
1 [Word8]
bs) [])
            ([Char] -> Maybe [Word8]
dec4 [Char
c1, Char
c2, Char
'+', Char
'+'])
        dI lo :: [Char]
lo@[Char
c1, Char
c2, Char
c3] DecIncData [Char]
DDone = DecIncRes [Char]
-> ([Word8] -> DecIncRes [Char])
-> Maybe [Word8]
-> DecIncRes [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            ([Word8] -> [Char] -> DecIncRes [Char]
forall i. [Word8] -> i -> DecIncRes i
DFail [] [Char]
lo)
            (\ [Word8]
bs -> [Word8] -> [Char] -> DecIncRes [Char]
forall i. [Word8] -> i -> DecIncRes i
DFinal (Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
2 [Word8]
bs) [])
            ([Char] -> Maybe [Word8]
dec4 [Char
c1, Char
c2, Char
c3, Char
'+'])
        dI [Char]
lo DecIncData [Char]
DDone = [Word8] -> [Char] -> DecIncRes [Char]
forall i. [Word8] -> i -> DecIncRes i
DFail [] [Char]
lo
        dI [Char]
lo (DChunk [Char]
s) = [Word8] -> [Char] -> DecIncRes [Char]
doDec [] ([Char]
lo [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s)
            where
                doDec :: [Word8] -> [Char] -> DecIncRes [Char]
doDec [Word8]
acc s' :: [Char]
s'@(Char
c1:Char
c2:Char
c3:Char
c4:[Char]
cs) = DecIncRes [Char]
-> ([Word8] -> DecIncRes [Char])
-> Maybe [Word8]
-> DecIncRes [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                    ([Word8] -> [Char] -> DecIncRes [Char]
forall i. [Word8] -> i -> DecIncRes i
DFail [Word8]
acc [Char]
s')
                    (\ [Word8]
bs -> [Word8] -> [Char] -> DecIncRes [Char]
doDec ([Word8]
acc [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8]
bs) [Char]
cs)
                    ([Char] -> Maybe [Word8]
dec4 [Char
c1, Char
c2, Char
c3, Char
c4])
                doDec [Word8]
acc [Char]
s' = [Word8]
-> (DecIncData [Char] -> DecIncRes [Char]) -> DecIncRes [Char]
forall i. [Word8] -> (DecIncData i -> DecIncRes i) -> DecIncRes i
DPart [Word8]
acc ([Char] -> DecIncData [Char] -> DecIncRes [Char]
dI [Char]
s')

-- | Decode data.
decode :: String
    -> Maybe [Word8]
decode :: [Char] -> Maybe [Word8]
decode = (DecIncData [Char] -> DecIncRes [Char]) -> [Char] -> Maybe [Word8]
forall i. (DecIncData i -> DecIncRes i) -> i -> Maybe [Word8]
decoder DecIncData [Char] -> DecIncRes [Char]
decodeInc

-- {{{1 chop
-- | Chop up a string in parts.  Each string in the resulting list is prepended
--   with the length according to the xxencode \"specificiation\".
--
--   /Notes:/
--
--   * The length of the strings in the result will be @(n -1) `div` 4 * 4 +
--   1@.  The @-1@ comes from the need to prepend the length (which explains
--   the final @+1@).  Keeping it to a multiple of 4 means that strings
--   returned from 'encode' can be chopped without requiring any changes.
chop :: Int     -- ^ length (value should be in the range @[5..85]@)
    -> String
    -> [String]
chop :: Int -> [Char] -> [[Char]]
chop Int
n [Char]
"" = []
chop Int
n [Char]
s = let
        enc_len :: Int
enc_len | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5     = Int
4
                | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
85   = Int
84
                | Bool
otherwise = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
64 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4
        enc_line :: [Char]
enc_line = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
enc_len [Char]
s
        act_len :: Word8
act_len = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ case ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
enc_line Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
4) of
            (Int
l, Int
0) -> Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3
            (Int
l, Int
2) -> Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            (Int
l, Int
3) -> Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
        len :: Char
len = (Array Word8 Char
encodeArray Array Word8 Char -> Word8 -> Char
forall i e. Ix i => Array i e -> i -> e
! Word8
act_len)
    in (Char
len Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
enc_line) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: Int -> [Char] -> [[Char]]
chop Int
n (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
enc_len [Char]
s)

-- {{{1 unchop
-- | Concatenate the strings into one long string.  Each string is assumed to
--   be prepended with the length according to the xxencode specification.
unchop :: [String]
    -> String
unchop :: [[Char]] -> [Char]
unchop [[Char]]
ss = let
        singleUnchop :: [Char] -> [Char]
singleUnchop (Char
l : [Char]
cs) = let
                act_len :: Int
act_len = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Map Char Word8
decodeMap Map Char Word8 -> Char -> Word8
forall k a. Ord k => Map k a -> k -> a
M.! Char
l
                enc_len :: Int
enc_len = case (Int
act_len Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
3) of
                    (Int
n, Int
0) -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4
                    (Int
n, Int
1) -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
                    (Int
n, Int
2) -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3
            in Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
enc_len [Char]
cs
    in ([Char] -> [Char] -> [Char]) -> [Char] -> [[Char]] -> [Char]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++) ([Char] -> [Char] -> [Char])
-> ([Char] -> [Char]) -> [Char] -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
singleUnchop) [Char]
"" [[Char]]
ss