!!******************************************************************************
!!
!!  This file is part of the AMUN source code, a program to perform
!!  Newtonian or relativistic magnetohydrodynamical simulations on uniform or
!!  adaptive mesh.
!!
!!  Copyright (C) 2020-2022 Grzegorz Kowal <grzegorz@amuncode.org>
!!
!!  This program is free software: you can redistribute it and/or modify
!!  it under the terms of the GNU General Public License as published by
!!  the Free Software Foundation, either version 3 of the License, or
!!  (at your option) any later version.
!!
!!  This program is distributed in the hope that it will be useful,
!!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!!  GNU General Public License for more details.
!!
!!  You should have received a copy of the GNU General Public License
!!  along with this program.  If not, see <http://www.gnu.org/licenses/>.
!!
!!******************************************************************************
!!
!! module: COMPRESSION
!!
!!  This module provides compression for the XML-binary format.
!!
!!******************************************************************************
!
module compression

  implicit none

! interfaces to compression algorithms
!
#ifdef ZSTD
  interface

    integer(c_size_t) function zstd_bound(srcSize) &
                               bind(C, name="ZSTD_compressBound")
      use iso_c_binding, only: c_size_t
      implicit none
      integer(kind=c_size_t), value :: srcSize
    end function zstd_bound

    integer(c_size_t) function zstd_compress(dst, dstCapacity, &
                                             src, srcSize, level) &
                               bind(C, name="ZSTD_compress")
      use iso_c_binding, only: c_size_t, c_int, c_ptr
      implicit none
      integer(kind=c_size_t), value :: srcSize, dstCapacity
      type(c_ptr)           , value :: src, dst
      integer(kind=c_int)   , value :: level
    end function zstd_compress

    integer(kind=c_int) function zstd_iserror(code) bind(C, name="ZSTD_isError")
      use iso_c_binding, only: c_int, c_size_t
      implicit none
      integer(kind=c_size_t), value :: code
    end function zstd_iserror

  end interface
#endif /* ZSTD */
#ifdef LZ4
  interface

    integer(kind=c_size_t) function lz4_bound(srcSize, prefsPtr)               &
                                    bind(C, name="LZ4F_compressFrameBound")
      use iso_c_binding, only: c_size_t, c_ptr
      implicit none
      integer(kind=c_size_t), value :: srcSize
      type(c_ptr)           , value :: prefsPtr
    end function lz4_bound

    integer(kind=c_size_t) function lz4_compress(dst, dstCapacity,             &
                                    src, srcSize, prefsPtr)                    &
                                    bind(C, name="LZ4F_compressFrame")
      use iso_c_binding, only: c_size_t, c_ptr
      implicit none
      integer(kind=c_size_t), value :: dstCapacity, srcSize
      type(c_ptr)           , value :: src, dst, prefsPtr
    end function lz4_compress

    integer(kind=c_int) function lz4_iserror(code) bind(C, name="LZ4F_isError")
      use iso_c_binding, only: c_int, c_size_t
      implicit none
      integer(kind=c_size_t), value :: code
    end function lz4_iserror

  end interface
#endif /* LZ4 */
#ifdef LZMA
  interface

    integer(c_int) function lzma_compress(preset, check, allocator,            &
                                          src, srcSize,                        &
                                          dst, dstPos, dstCapacity)            &
                            bind(C, name="lzma_easy_buffer_encode")
      use iso_c_binding, only: c_int, c_size_t, c_ptr
      implicit none
      integer(c_int)        , value :: preset, check
      integer(kind=c_size_t), value :: srcSize, dstCapacity
      type(c_ptr)           , value :: allocator, src, dst, dstPos
    end function lzma_compress

  end interface
#endif /* LZMA */

! supported compression formats
!
  enum, bind(c)
    enumerator compression_none
    enumerator compression_zstd
    enumerator compression_lz4
    enumerator compression_lzma
  end enum

! compression parameters
!
  integer(kind(compression_none)), save :: compression_format = 0
  integer                        , save :: compression_level  = 0
  character(len=4)               , save :: compression_suffix = ''

  private

  public :: set_compression, get_compression, compression_bound, compress
  public :: compression_suffix

!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
  contains
!
!===============================================================================
!!
!!***  PUBLIC SUBROUTINES  ****************************************************
!!
!===============================================================================
!
!===============================================================================
!
! subroutine SET_COMPRESSION:
! --------------------------
!
!   Subroutine sets the compression format and level.
!
!   Arguments:
!
!     cformat - the compression format string;
!     clevel  - the compression level;
!
!===============================================================================
!
  subroutine set_compression(cformat, clevel)

    implicit none

    character(len=*) , intent(inout) :: cformat
    integer          , intent(in)    :: clevel

!-------------------------------------------------------------------------------
!
    select case(trim(adjustl(cformat)))
#ifdef ZSTD
    case("zstd", "ZSTD", "zst", "ZST", "Zstandard")
      cformat            = "zstd"
      compression_format = compression_zstd
      compression_level  = max(0, min(19, clevel))
      compression_suffix = ".zst"
#endif /* ZSTD */
#ifdef LZ4
    case("lz4", "LZ4")
      cformat            = "lz4"
      compression_format = compression_lz4
      compression_level  = max(1, min(12, clevel))
      compression_suffix = ".lz4"
#endif /* LZ4 */
#ifdef LZMA
    case("lzma", "LZMA", "xz", "XZ")
      cformat            = "lzma"
      compression_format = compression_lzma
      compression_level  = max(0, min(9, clevel))
      compression_suffix = ".xz"
#endif /* LZMA */
    case default
      cformat            = "none"
      compression_format = compression_none
      compression_level  = clevel
      compression_suffix = ""
    end select

!-------------------------------------------------------------------------------
!
  end subroutine set_compression
!
!===============================================================================
!
! function GET_COMPRESSION:
! ------------------------
!
!   Function returns the compression format index.
!
!
!===============================================================================
!
  integer function get_compression()

    implicit none

!-------------------------------------------------------------------------------
!
    get_compression = compression_format
    return

!-------------------------------------------------------------------------------
!
  end function get_compression
!
!===============================================================================
!
! function COMPRESSION_BOUND:
! --------------------------
!
!   Function returns the minimum buffer size required to perform
!   the compression.
!
!   Arguments:
!
!     ilen - the length of the sequence of bytes to compress;
!
!===============================================================================
!
  integer(kind=8) function compression_bound(ilen)

    use iso_c_binding, only: c_loc

    implicit none

    integer(kind=8), intent(in)  :: ilen

#ifdef LZ4
    integer, dimension(14), target :: prefs = [5, 0, 1, 0, 0, 0, 0, 0, &
                                                           0, 0, 0, 0, 0, 0]
#endif /* LZ4 */

!-------------------------------------------------------------------------------
!
    select case(compression_format)
#ifdef ZSTD
    case(compression_zstd)
      compression_bound = zstd_bound(ilen)
#endif /* ZSTD */
#ifdef LZ4
    case(compression_lz4)
      prefs(5:6) = transfer(ilen, [ 0_4 ])
      prefs(9) = compression_level
      compression_bound = lz4_bound(ilen, c_loc(prefs))
#endif /* LZ4 */
    case default
      compression_bound = ilen
    end select

    return

!-------------------------------------------------------------------------------
!
  end function compression_bound
!
!===============================================================================
!
! subroutine COMPRESS:
! -------------------
!
!   Subroutine compressed input buffer using ZSTD compression.
!
!   Arguments:
!
!     input  - the pointer to the input sequence of bytes;
!     ilen   - the length of input;
!     buffer - the buffer where the compression is done;
!     clen   - the length of buffer in bytes; once the compression was
!              successful, it returns the length of the compressed stream;
!
!===============================================================================
!
  subroutine compress(input, ilen, buffer, clen)

    use iso_c_binding, only : c_int, c_loc, c_ptr
#ifdef LZ4
    use iso_c_binding, only : c_null_ptr
#endif /* LZ4 */

    implicit none

    type(c_ptr)    , intent(in)    :: input
    integer(kind=8), intent(in)    :: ilen
    type(c_ptr)    , intent(inout) :: buffer
    integer(kind=8), intent(inout) :: clen

#ifdef LZ4
    integer, dimension(14), target :: prefs = [5, 0, 1, 0, 0, 0, 0, 0, &
                                                           0, 0, 0, 0, 0, 0]
#endif /* LZ4 */
#ifdef LZMA
    integer(kind=8), target :: lsize
    integer                 :: ret
#endif /* LZMA */

!-------------------------------------------------------------------------------
!
    select case(compression_format)
#ifdef ZSTD
    case(compression_zstd)
      clen = zstd_compress(buffer, clen, input, ilen, compression_level)
      if (zstd_iserror(clen) /= 0) clen = 0
#endif /* ZSTD */
#ifdef LZ4
    case(compression_lz4)
      prefs(5:6) = transfer(ilen, [ 0_4 ])
      prefs(9) = compression_level
      clen = lz4_compress(buffer, clen, input, ilen, c_loc(prefs))
      if (lz4_iserror(clen) /= 0) clen = 0
#endif /* LZ4 */
#ifdef LZMA
    case(compression_lzma)
      lsize = 0
      ret = lzma_compress(compression_level, 4, c_null_ptr, &
                           input, ilen, buffer, c_loc(lsize), clen)
      if (ret > 0) then
        clen = 0
      else
        clen = lsize
      end if
#endif /* LZMA */
    case default
      clen = 0
    end select

!-------------------------------------------------------------------------------
!
  end subroutine compress

!===============================================================================
!
end module compression