zlib.fs

#nowarn "9"
namespace Sayuri.IO.Compression
open System.IO.Compression
open System.Reflection

type ZLibOption = {
    CompressionLevel    : int   // -1, 0 .. 9
    WindowBits          : int   // (8), 9 .. 15
    MemLevel            : int   // 1 .. 9
    CompressionStrategy : int   // 0, 1 .. 4
}
    with
    static member Default = { CompressionLevel = -1; WindowBits = 15; MemLevel = 8; CompressionStrategy = 0 }

module ZLib =
    let private zlibNative = typeof<DeflateStream>.Assembly.GetType "System.IO.Compression.ZLibNative"
    let private compressionLevel = zlibNative.GetNestedType "CompressionLevel"
    let private compressionStrategy = zlibNative.GetNestedType "CompressionStrategy"
    let private zlibStreamHandle = zlibNative.GetNestedType "ZLibStreamHandle"
    let private nextIn = zlibStreamHandle.GetProperty "NextIn"
    let private availIn = zlibStreamHandle.GetProperty "AvailIn"
    let private totalIn = zlibStreamHandle.GetProperty "TotalIn"
    let private nextOut = zlibStreamHandle.GetProperty "NextOut"
    let private availOut = zlibStreamHandle.GetProperty "AvailOut"
    let private totalOut = zlibStreamHandle.GetProperty "TotalOut"
    let private deflate = zlibStreamHandle.GetMethod "Deflate"
    let private inflate = zlibStreamHandle.GetMethod "Inflate"
    let private createZLibStreamForDeflate = zlibNative.GetMethod("CreateZLibStreamForDeflate", [| zlibStreamHandle.MakeByRefType(); compressionLevel; typeof<int>; typeof<int>; compressionStrategy |])
    let private createZLibStreamForInflate = zlibNative.GetMethod("CreateZLibStreamForInflate", [| zlibStreamHandle.MakeByRefType(); typeof<int>; |])
    [<Literal>]
    let private NoFlush = 0
    [<Literal>]
    let private Finish = 4
    [<Literal>]
    let private Ok = 0
    [<Literal>]
    let private StreamEnd = 1
    let inline private invoke (methodInfo : MethodInfo) flush handle (inBuffer : byte[]) (outBuffer : byte[]) =
        use handle = unbox handle
        use inPtr = fixed inBuffer
        use outPtr = fixed outBuffer
        nextIn.SetValue(handle, inPtr)
        availIn.SetValue(handle, uint32 inBuffer.Length)
        nextOut.SetValue(handle, outPtr)
        availOut.SetValue(handle, uint32 outBuffer.Length)
        let result = downcast methodInfo.Invoke(handle, [| flush |])
        if result <> StreamEnd then failwithf "%s failed: %d." methodInfo.Name result
        totalOut.GetValue handle :?> uint32
    let compressWithOption { CompressionLevel = compressionLevel; WindowBits = windowBits; MemLevel = memLevel; CompressionStrategy = compressionStrategy } (inBuffer : _[]) =
        let args = [| null; compressionLevel; windowBits; memLevel; compressionStrategy |] : obj[]
        let result = downcast createZLibStreamForDeflate.Invoke(null, args)
        if result <> Ok then failwithf "CreateZLibStreamForDeflate failed: %d." result
        let outBuffer = Array.zeroCreate (inBuffer.Length + inBuffer.Length / 10)
        let totalOut = invoke deflate Finish args.[0] inBuffer outBuffer
        outBuffer.[.. int totalOut - 1]
    [<CompiledName "Compress">]
    let compress inBuffer =
        compressWithOption ZLibOption.Default inBuffer
    [<CompiledName "Uncompress">]
    let uncompress inBuffer outBuffer =
        let args = [| null; 15 |] : obj[]
        let result = downcast createZLibStreamForInflate.Invoke(null, args)
        if result <> Ok then failwithf "CreateZLibStreamForInflate failed: %d." result
        let totalOut = invoke inflate NoFlush args.[0] inBuffer outBuffer
        if totalOut <> uint32 outBuffer.Length then failwithf "Inflate invalid length: %d." totalOut