    {-# LANGUAGE ForeignFunctionInterface #-}

    -- |
    -- Module: Codec.Binary.Yenc
    -- Copyright: (c) 2012 Magnus Therning
    -- License: BSD3
    --
    -- Implementation based on the specification found at
    -- <http://yence.sourceforge.net/docs/protocol/version1_3_draft.html>.
    module Codec.Binary.Yenc
        ( yEncode
        , yDecode
        , encode
        , decode
        ) where

    import qualified Data.ByteString as BS
    import Foreign
    import Foreign.C.Types
    import System.IO.Unsafe as U
    import qualified Data.ByteString.Unsafe as BSU
    import Data.List

    castEnum :: (Enum a, Enum b) => a -> b
    castEnum :: forall a b. (Enum a, Enum b) => a -> b
    castEnum = Int -> b
    forall a. Enum a => Int -> a
    toEnum (Int -> b) -> (a -> Int) -> a -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Int
    forall a. Enum a => a -> Int
    fromEnum

    foreign import ccall "static yenc.h y_enc"
        c_y_enc :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO ()

    foreign import ccall "static yenc.h y_dec"
        c_y_dec :: Ptr Word8 -> CSize -> Ptr Word8 -> Ptr CSize -> Ptr (Ptr Word8) -> Ptr CSize -> IO CInt

    -- | Encoding function.
    --
    -- This function allocates enough space to hold 20% more than the size of the
    -- indata (or at least 512 bytes) and then encodes as much as possible of the
    -- indata.  That means there is a risk that the encoded data won't fit and in
    -- that case the second part of the pair contains the remainder of the indata.
    --
    -- >>> yEncode $ Data.ByteString.Char8.pack "foobar"
    -- ("\144\153\153\140\139\156","")
    -- >>> snd $ yEncode $ Data.ByteString.Char8.pack $ Data.List.take 257 $ repeat '\x13'
    -- "\DC3"
    yEncode :: BS.ByteString -> (BS.ByteString, BS.ByteString)
    yEncode :: ByteString -> (ByteString, ByteString)
    yEncode ByteString
    bs = IO (ByteString, ByteString) -> (ByteString, ByteString)
    forall a. IO a -> a
    U.unsafePerformIO (IO (ByteString, ByteString) -> (ByteString, ByteString))
    -> IO (ByteString, ByteString) -> (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ ByteString
    -> (CStringLen -> IO (ByteString, ByteString))
    -> IO (ByteString, ByteString)
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    BSU.unsafeUseAsCStringLen ByteString
    bs ((CStringLen -> IO (ByteString, ByteString))
     -> IO (ByteString, ByteString))
    -> (CStringLen -> IO (ByteString, ByteString))
    -> IO (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ \ (Ptr CChar
    inBuf, Int
    inLen) -> do
        let maxOutLen :: Int
    maxOutLen = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    512 (Rational -> Int
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    ceiling (Rational -> Int) -> Rational -> Int
    forall a b. (a -> b) -> a -> b
    $ (Int -> Rational
    forall a. Real a => a -> Rational
    toRational Int
    inLen) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    1.2)
        outBuf <- Int -> IO (Ptr Word8)
    forall a. Int -> IO (Ptr a)
    mallocBytes Int
    maxOutLen
        alloca $ \ Ptr CSize
    pOutLen ->
            (Ptr (Ptr Word8) -> IO (ByteString, ByteString))
    -> IO (ByteString, ByteString)
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr (Ptr Word8) -> IO (ByteString, ByteString))
     -> IO (ByteString, ByteString))
    -> (Ptr (Ptr Word8) -> IO (ByteString, ByteString))
    -> IO (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ \ Ptr (Ptr Word8)
    pRemBuf ->
                (Ptr CSize -> IO (ByteString, ByteString))
    -> IO (ByteString, ByteString)
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr CSize -> IO (ByteString, ByteString))
     -> IO (ByteString, ByteString))
    -> (Ptr CSize -> IO (ByteString, ByteString))
    -> IO (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ \ Ptr CSize
    pRemLen -> do
                    Ptr CSize -> CSize -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr CSize
    pOutLen (Int -> CSize
    forall a b. (Enum a, Enum b) => a -> b
    castEnum Int
    maxOutLen)
                    Ptr Word8
    -> CSize
    -> Ptr Word8
    -> Ptr CSize
    -> Ptr (Ptr Word8)
    -> Ptr CSize
    -> IO ()
    c_y_enc (Ptr CChar -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    castPtr Ptr CChar
    inBuf) (Int -> CSize
    forall a b. (Enum a, Enum b) => a -> b
    castEnum Int
    inLen) Ptr Word8
    outBuf Ptr CSize
    pOutLen Ptr (Ptr Word8)
    pRemBuf Ptr CSize
    pRemLen
                    outLen <- Ptr CSize -> IO CSize
    forall a. Storable a => Ptr a -> IO a
    peek Ptr CSize
    pOutLen
                    newOutBuf <- reallocBytes outBuf (castEnum outLen)
                    remBuf <- peek pRemBuf
                    remLen <- peek pRemLen
                    remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen)
                    outBs <- BSU.unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf)
                    return (outBs, remBs)

    -- | Decoding function.
    --
    -- >>> yDecode $ Data.ByteString.pack [144,153,153,140,139,156]
    -- Right ("foobar","")
    -- >>> yDecode $ Data.ByteString.Char8.pack "=}"
    -- Right ("\DC3","")
    --
    -- A @Left@ value is only ever returned on decoding errors which, due to
    -- characteristics of the encoding, can never happen.
    --
    -- >>> yDecode $ Data.ByteString.Char8.pack "="
    -- Right ("","=")
    yDecode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) (BS.ByteString, BS.ByteString)
    yDecode :: ByteString
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    yDecode ByteString
    bs = IO (Either (ByteString, ByteString) (ByteString, ByteString))
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    forall a. IO a -> a
    U.unsafePerformIO (IO (Either (ByteString, ByteString) (ByteString, ByteString))
     -> Either (ByteString, ByteString) (ByteString, ByteString))
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ ByteString
    -> (CStringLen
        -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    BSU.unsafeUseAsCStringLen ByteString
    bs ((CStringLen
      -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
     -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> (CStringLen
        -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a b. (a -> b) -> a -> b
    $ \ (Ptr CChar
    inBuf, Int
    inLen) -> do
        outBuf <- Int -> IO (Ptr Word8)
    forall a. Int -> IO (Ptr a)
    mallocBytes Int
    inLen
        alloca $ \ Ptr CSize
    pOutLen ->
            (Ptr (Ptr Word8)
     -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr (Ptr Word8)
      -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
     -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> (Ptr (Ptr Word8)
        -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a b. (a -> b) -> a -> b
    $ \ Ptr (Ptr Word8)
    pRemBuf ->
                (Ptr CSize
     -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr CSize
      -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
     -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> (Ptr CSize
        -> IO (Either (ByteString, ByteString) (ByteString, ByteString)))
    -> IO (Either (ByteString, ByteString) (ByteString, ByteString))
    forall a b. (a -> b) -> a -> b
    $ \ Ptr CSize
    pRemLen -> do
                    Ptr CSize -> CSize -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr CSize
    pOutLen (Int -> CSize
    forall a b. (Enum a, Enum b) => a -> b
    castEnum Int
    inLen)
                    r <- Ptr Word8
    -> CSize
    -> Ptr Word8
    -> Ptr CSize
    -> Ptr (Ptr Word8)
    -> Ptr CSize
    -> IO CInt
    c_y_dec (Ptr CChar -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    castPtr Ptr CChar
    inBuf) (Int -> CSize
    forall a b. (Enum a, Enum b) => a -> b
    castEnum Int
    inLen) Ptr Word8
    outBuf Ptr CSize
    pOutLen Ptr (Ptr Word8)
    pRemBuf Ptr CSize
    pRemLen
                    outLen <- peek pOutLen
                    newOutBuf <- reallocBytes outBuf (castEnum outLen)
                    remBuf <- peek pRemBuf
                    remLen <- peek pRemLen
                    remBs <- BS.packCStringLen (castPtr remBuf, castEnum remLen)
                    outBs <- BSU.unsafePackCStringFinalizer newOutBuf (castEnum outLen) (free newOutBuf)
                    if r == 0
                        then return $ Right (outBs, remBs)
                        else return $ Left (outBs, remBs)

    -- | Convenient function that calls 'y_enc' repeatedly until the whole input
    -- data is encoded.
    encode :: BS.ByteString -> BS.ByteString
    encode :: ByteString -> ByteString
    encode = [ByteString] -> ByteString
    BS.concat ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> Bool) -> [ByteString] -> [ByteString]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Bool -> Bool
    not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Bool
    BS.null) ([ByteString] -> [ByteString])
    -> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> Maybe (ByteString, ByteString))
    -> ByteString -> [ByteString]
    forall b a. (b -> Maybe (a, b)) -> b -> [a]
    unfoldr ((ByteString, ByteString) -> Maybe (ByteString, ByteString)
    forall a. a -> Maybe a
    Just ((ByteString, ByteString) -> Maybe (ByteString, ByteString))
    -> (ByteString -> (ByteString, ByteString))
    -> ByteString
    -> Maybe (ByteString, ByteString)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> (ByteString, ByteString)
    yEncode)

    -- | A synonym for 'y_dec'.
    decode :: BS.ByteString -> Either (BS.ByteString, BS.ByteString) BS.ByteString
    decode :: ByteString -> Either (ByteString, ByteString) ByteString
    decode ByteString
    bs = case ByteString
    -> Either (ByteString, ByteString) (ByteString, ByteString)
    yDecode ByteString
    bs of
        Right a :: (ByteString, ByteString)
    a@(ByteString
    d, ByteString
    r) -> if ByteString -> Bool
    BS.null ByteString
    r
            then ByteString -> Either (ByteString, ByteString) ByteString
    forall a b. b -> Either a b
    Right ByteString
    d
            else (ByteString, ByteString)
    -> Either (ByteString, ByteString) ByteString
    forall a b. a -> Either a b
    Left (ByteString, ByteString)
    a
        Left (ByteString, ByteString)
    a -> (ByteString, ByteString)
    -> Either (ByteString, ByteString) ByteString
    forall a b. a -> Either a b
    Left (ByteString, ByteString)
    a