{-# LINE 1 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

{-|
Module      : Codec.Compression.LZ4.CTypes
Description : C type definitions for the lz4 compression codec.
Copyright   : (c) Niklas Hambüchen, 2020
License     : MIT
Maintainer  : mail@nh2.me
Stability   : stable

-}


module Codec.Compression.LZ4.CTypes
  ( Lz4FrameException(..)
  , BlockSizeID(..)
  , BlockMode(..)
  , ContentChecksum(..)
  , BlockChecksum(..)
  , FrameType(..)
  , FrameInfo(..)
  , Preferences(..)
  , LZ4F_cctx
  , LZ4F_dctx
  , lz4FrameTypesTable
  ) where

import           Control.Exception (Exception, throwIO)
import           Data.Map (Map)
import qualified Data.Map as Map
import           Data.Typeable (Typeable)
import           Data.Word (Word32, Word64)
import           Foreign.Marshal.Utils (fillBytes)
import           Foreign.Ptr (Ptr, castPtr)
import           Foreign.Storable (Storable(..), poke)
import qualified Language.C.Types as C
import qualified Language.Haskell.TH as TH




data Lz4FrameException = Lz4FormatException String
  deriving (Lz4FrameException -> Lz4FrameException -> Bool
(Lz4FrameException -> Lz4FrameException -> Bool)
-> (Lz4FrameException -> Lz4FrameException -> Bool)
-> Eq Lz4FrameException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lz4FrameException -> Lz4FrameException -> Bool
== :: Lz4FrameException -> Lz4FrameException -> Bool
$c/= :: Lz4FrameException -> Lz4FrameException -> Bool
/= :: Lz4FrameException -> Lz4FrameException -> Bool
Eq, Eq Lz4FrameException
Eq Lz4FrameException =>
(Lz4FrameException -> Lz4FrameException -> Ordering)
-> (Lz4FrameException -> Lz4FrameException -> Bool)
-> (Lz4FrameException -> Lz4FrameException -> Bool)
-> (Lz4FrameException -> Lz4FrameException -> Bool)
-> (Lz4FrameException -> Lz4FrameException -> Bool)
-> (Lz4FrameException -> Lz4FrameException -> Lz4FrameException)
-> (Lz4FrameException -> Lz4FrameException -> Lz4FrameException)
-> Ord Lz4FrameException
Lz4FrameException -> Lz4FrameException -> Bool
Lz4FrameException -> Lz4FrameException -> Ordering
Lz4FrameException -> Lz4FrameException -> Lz4FrameException
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Lz4FrameException -> Lz4FrameException -> Ordering
compare :: Lz4FrameException -> Lz4FrameException -> Ordering
$c< :: Lz4FrameException -> Lz4FrameException -> Bool
< :: Lz4FrameException -> Lz4FrameException -> Bool
$c<= :: Lz4FrameException -> Lz4FrameException -> Bool
<= :: Lz4FrameException -> Lz4FrameException -> Bool
$c> :: Lz4FrameException -> Lz4FrameException -> Bool
> :: Lz4FrameException -> Lz4FrameException -> Bool
$c>= :: Lz4FrameException -> Lz4FrameException -> Bool
>= :: Lz4FrameException -> Lz4FrameException -> Bool
$cmax :: Lz4FrameException -> Lz4FrameException -> Lz4FrameException
max :: Lz4FrameException -> Lz4FrameException -> Lz4FrameException
$cmin :: Lz4FrameException -> Lz4FrameException -> Lz4FrameException
min :: Lz4FrameException -> Lz4FrameException -> Lz4FrameException
Ord, Int -> Lz4FrameException -> ShowS
[Lz4FrameException] -> ShowS
Lz4FrameException -> String
(Int -> Lz4FrameException -> ShowS)
-> (Lz4FrameException -> String)
-> ([Lz4FrameException] -> ShowS)
-> Show Lz4FrameException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lz4FrameException -> ShowS
showsPrec :: Int -> Lz4FrameException -> ShowS
$cshow :: Lz4FrameException -> String
show :: Lz4FrameException -> String
$cshowList :: [Lz4FrameException] -> ShowS
showList :: [Lz4FrameException] -> ShowS
Show, Typeable)

instance Exception Lz4FrameException


data BlockSizeID
  = LZ4F_default
  | LZ4F_max64KB
  | LZ4F_max256KB
  | LZ4F_max1MB
  | LZ4F_max4MB
  deriving (BlockSizeID -> BlockSizeID -> Bool
(BlockSizeID -> BlockSizeID -> Bool)
-> (BlockSizeID -> BlockSizeID -> Bool) -> Eq BlockSizeID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockSizeID -> BlockSizeID -> Bool
== :: BlockSizeID -> BlockSizeID -> Bool
$c/= :: BlockSizeID -> BlockSizeID -> Bool
/= :: BlockSizeID -> BlockSizeID -> Bool
Eq, Eq BlockSizeID
Eq BlockSizeID =>
(BlockSizeID -> BlockSizeID -> Ordering)
-> (BlockSizeID -> BlockSizeID -> Bool)
-> (BlockSizeID -> BlockSizeID -> Bool)
-> (BlockSizeID -> BlockSizeID -> Bool)
-> (BlockSizeID -> BlockSizeID -> Bool)
-> (BlockSizeID -> BlockSizeID -> BlockSizeID)
-> (BlockSizeID -> BlockSizeID -> BlockSizeID)
-> Ord BlockSizeID
BlockSizeID -> BlockSizeID -> Bool
BlockSizeID -> BlockSizeID -> Ordering
BlockSizeID -> BlockSizeID -> BlockSizeID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BlockSizeID -> BlockSizeID -> Ordering
compare :: BlockSizeID -> BlockSizeID -> Ordering
$c< :: BlockSizeID -> BlockSizeID -> Bool
< :: BlockSizeID -> BlockSizeID -> Bool
$c<= :: BlockSizeID -> BlockSizeID -> Bool
<= :: BlockSizeID -> BlockSizeID -> Bool
$c> :: BlockSizeID -> BlockSizeID -> Bool
> :: BlockSizeID -> BlockSizeID -> Bool
$c>= :: BlockSizeID -> BlockSizeID -> Bool
>= :: BlockSizeID -> BlockSizeID -> Bool
$cmax :: BlockSizeID -> BlockSizeID -> BlockSizeID
max :: BlockSizeID -> BlockSizeID -> BlockSizeID
$cmin :: BlockSizeID -> BlockSizeID -> BlockSizeID
min :: BlockSizeID -> BlockSizeID -> BlockSizeID
Ord, Int -> BlockSizeID -> ShowS
[BlockSizeID] -> ShowS
BlockSizeID -> String
(Int -> BlockSizeID -> ShowS)
-> (BlockSizeID -> String)
-> ([BlockSizeID] -> ShowS)
-> Show BlockSizeID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockSizeID -> ShowS
showsPrec :: Int -> BlockSizeID -> ShowS
$cshow :: BlockSizeID -> String
show :: BlockSizeID -> String
$cshowList :: [BlockSizeID] -> ShowS
showList :: [BlockSizeID] -> ShowS
Show)

instance Storable BlockSizeID where
  sizeOf :: BlockSizeID -> Int
sizeOf BlockSizeID
_ = (Int
4)
{-# LINE 61 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
  alignment _ = 4
{-# LINE 62 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
  peek p = do
    n <- peek (castPtr p :: Ptr Word32)
{-# LINE 64 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    case n of
      0 -> return LZ4F_default
{-# LINE 66 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
      4 -> return LZ4F_max64KB
{-# LINE 67 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
      5 -> return LZ4F_max256KB
{-# LINE 68 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
      6 -> return LZ4F_max1MB
{-# LINE 69 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
      7 -> return LZ4F_max4MB
{-# LINE 70 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
      _ -> throwIO $ Lz4FormatException $ "lz4 instance Storable BlockSizeID: encountered unknown LZ4F_blockSizeID_t: " ++ show n
  poke :: Ptr BlockSizeID -> BlockSizeID -> IO ()
poke Ptr BlockSizeID
p BlockSizeID
i = Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BlockSizeID -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr BlockSizeID
p :: Ptr Word32) (Word32 -> IO ()) -> Word32 -> IO ()
forall a b. (a -> b) -> a -> b
$ case BlockSizeID
i of
{-# LINE 72 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    LZ4F_default -> 0
{-# LINE 73 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    LZ4F_max64KB -> 4
{-# LINE 74 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    LZ4F_max256KB -> 5
{-# LINE 75 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    LZ4F_max1MB -> 6
{-# LINE 76 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    LZ4F_max4MB -> 7
{-# LINE 77 "src/Codec/Compression/LZ4/CTypes.hsc" #-}


data BlockMode
  = LZ4F_blockLinked
  | LZ4F_blockIndependent
  deriving (BlockMode -> BlockMode -> Bool
(BlockMode -> BlockMode -> Bool)
-> (BlockMode -> BlockMode -> Bool) -> Eq BlockMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockMode -> BlockMode -> Bool
== :: BlockMode -> BlockMode -> Bool
$c/= :: BlockMode -> BlockMode -> Bool
/= :: BlockMode -> BlockMode -> Bool
Eq, Eq BlockMode
Eq BlockMode =>
(BlockMode -> BlockMode -> Ordering)
-> (BlockMode -> BlockMode -> Bool)
-> (BlockMode -> BlockMode -> Bool)
-> (BlockMode -> BlockMode -> Bool)
-> (BlockMode -> BlockMode -> Bool)
-> (BlockMode -> BlockMode -> BlockMode)
-> (BlockMode -> BlockMode -> BlockMode)
-> Ord BlockMode
BlockMode -> BlockMode -> Bool
BlockMode -> BlockMode -> Ordering
BlockMode -> BlockMode -> BlockMode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BlockMode -> BlockMode -> Ordering
compare :: BlockMode -> BlockMode -> Ordering
$c< :: BlockMode -> BlockMode -> Bool
< :: BlockMode -> BlockMode -> Bool
$c<= :: BlockMode -> BlockMode -> Bool
<= :: BlockMode -> BlockMode -> Bool
$c> :: BlockMode -> BlockMode -> Bool
> :: BlockMode -> BlockMode -> Bool
$c>= :: BlockMode -> BlockMode -> Bool
>= :: BlockMode -> BlockMode -> Bool
$cmax :: BlockMode -> BlockMode -> BlockMode
max :: BlockMode -> BlockMode -> BlockMode
$cmin :: BlockMode -> BlockMode -> BlockMode
min :: BlockMode -> BlockMode -> BlockMode
Ord, Int -> BlockMode -> ShowS
[BlockMode] -> ShowS
BlockMode -> String
(Int -> BlockMode -> ShowS)
-> (BlockMode -> String)
-> ([BlockMode] -> ShowS)
-> Show BlockMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockMode -> ShowS
showsPrec :: Int -> BlockMode -> ShowS
$cshow :: BlockMode -> String
show :: BlockMode -> String
$cshowList :: [BlockMode] -> ShowS
showList :: [BlockMode] -> ShowS
Show)

instance Storable BlockMode where
  sizeOf :: BlockMode -> Int
sizeOf BlockMode
_ = (Int
4)
{-# LINE 86 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
  alignment _ = 4
{-# LINE 87 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
  peek p = do
    n <- peek (castPtr p :: Ptr Word32)
{-# LINE 89 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    case n of
      0 -> return LZ4F_blockLinked
{-# LINE 91 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
      1 -> return LZ4F_blockIndependent
{-# LINE 92 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
      _ -> throwIO $ Lz4FormatException $ "lz4 instance Storable BlockMode: encountered unknown LZ4F_blockMode_t: " ++ show n
  poke :: Ptr BlockMode -> BlockMode -> IO ()
poke Ptr BlockMode
p BlockMode
mode = Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BlockMode -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr BlockMode
p :: Ptr Word32) (Word32 -> IO ()) -> Word32 -> IO ()
forall a b. (a -> b) -> a -> b
$ case BlockMode
mode of
{-# LINE 94 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    LZ4F_blockLinked -> 0
{-# LINE 95 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    LZ4F_blockIndependent -> 1
{-# LINE 96 "src/Codec/Compression/LZ4/CTypes.hsc" #-}


data ContentChecksum
  = LZ4F_noContentChecksum
  | LZ4F_contentChecksumEnabled
  deriving (ContentChecksum -> ContentChecksum -> Bool
(ContentChecksum -> ContentChecksum -> Bool)
-> (ContentChecksum -> ContentChecksum -> Bool)
-> Eq ContentChecksum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContentChecksum -> ContentChecksum -> Bool
== :: ContentChecksum -> ContentChecksum -> Bool
$c/= :: ContentChecksum -> ContentChecksum -> Bool
/= :: ContentChecksum -> ContentChecksum -> Bool
Eq, Eq ContentChecksum
Eq ContentChecksum =>
(ContentChecksum -> ContentChecksum -> Ordering)
-> (ContentChecksum -> ContentChecksum -> Bool)
-> (ContentChecksum -> ContentChecksum -> Bool)
-> (ContentChecksum -> ContentChecksum -> Bool)
-> (ContentChecksum -> ContentChecksum -> Bool)
-> (ContentChecksum -> ContentChecksum -> ContentChecksum)
-> (ContentChecksum -> ContentChecksum -> ContentChecksum)
-> Ord ContentChecksum
ContentChecksum -> ContentChecksum -> Bool
ContentChecksum -> ContentChecksum -> Ordering
ContentChecksum -> ContentChecksum -> ContentChecksum
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ContentChecksum -> ContentChecksum -> Ordering
compare :: ContentChecksum -> ContentChecksum -> Ordering
$c< :: ContentChecksum -> ContentChecksum -> Bool
< :: ContentChecksum -> ContentChecksum -> Bool
$c<= :: ContentChecksum -> ContentChecksum -> Bool
<= :: ContentChecksum -> ContentChecksum -> Bool
$c> :: ContentChecksum -> ContentChecksum -> Bool
> :: ContentChecksum -> ContentChecksum -> Bool
$c>= :: ContentChecksum -> ContentChecksum -> Bool
>= :: ContentChecksum -> ContentChecksum -> Bool
$cmax :: ContentChecksum -> ContentChecksum -> ContentChecksum
max :: ContentChecksum -> ContentChecksum -> ContentChecksum
$cmin :: ContentChecksum -> ContentChecksum -> ContentChecksum
min :: ContentChecksum -> ContentChecksum -> ContentChecksum
Ord, Int -> ContentChecksum -> ShowS
[ContentChecksum] -> ShowS
ContentChecksum -> String
(Int -> ContentChecksum -> ShowS)
-> (ContentChecksum -> String)
-> ([ContentChecksum] -> ShowS)
-> Show ContentChecksum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContentChecksum -> ShowS
showsPrec :: Int -> ContentChecksum -> ShowS
$cshow :: ContentChecksum -> String
show :: ContentChecksum -> String
$cshowList :: [ContentChecksum] -> ShowS
showList :: [ContentChecksum] -> ShowS
Show)

instance Storable ContentChecksum where
  sizeOf :: ContentChecksum -> Int
sizeOf ContentChecksum
_ = (Int
4)
{-# LINE 105 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
  alignment _ = 4
{-# LINE 106 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
  peek p = do
    n <- peek (castPtr p :: Ptr Word32)
{-# LINE 108 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    case n of
      0 -> return LZ4F_noContentChecksum
{-# LINE 110 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
      1 -> return LZ4F_contentChecksumEnabled
{-# LINE 111 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
      _ -> throwIO $ Lz4FormatException $ "lz4 instance Storable ContentChecksum: encountered unknown LZ4F_contentChecksum_t: " ++ show n
  poke :: Ptr ContentChecksum -> ContentChecksum -> IO ()
poke Ptr ContentChecksum
p ContentChecksum
mode = Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ContentChecksum -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr ContentChecksum
p :: Ptr Word32) (Word32 -> IO ()) -> Word32 -> IO ()
forall a b. (a -> b) -> a -> b
$ case ContentChecksum
mode of
{-# LINE 113 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    LZ4F_noContentChecksum -> 0
{-# LINE 114 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    LZ4F_contentChecksumEnabled -> 1
{-# LINE 115 "src/Codec/Compression/LZ4/CTypes.hsc" #-}


data BlockChecksum
  = LZ4F_noBlockChecksum
  | LZ4F_blockChecksumEnabled
  deriving (BlockChecksum -> BlockChecksum -> Bool
(BlockChecksum -> BlockChecksum -> Bool)
-> (BlockChecksum -> BlockChecksum -> Bool) -> Eq BlockChecksum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockChecksum -> BlockChecksum -> Bool
== :: BlockChecksum -> BlockChecksum -> Bool
$c/= :: BlockChecksum -> BlockChecksum -> Bool
/= :: BlockChecksum -> BlockChecksum -> Bool
Eq, Eq BlockChecksum
Eq BlockChecksum =>
(BlockChecksum -> BlockChecksum -> Ordering)
-> (BlockChecksum -> BlockChecksum -> Bool)
-> (BlockChecksum -> BlockChecksum -> Bool)
-> (BlockChecksum -> BlockChecksum -> Bool)
-> (BlockChecksum -> BlockChecksum -> Bool)
-> (BlockChecksum -> BlockChecksum -> BlockChecksum)
-> (BlockChecksum -> BlockChecksum -> BlockChecksum)
-> Ord BlockChecksum
BlockChecksum -> BlockChecksum -> Bool
BlockChecksum -> BlockChecksum -> Ordering
BlockChecksum -> BlockChecksum -> BlockChecksum
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BlockChecksum -> BlockChecksum -> Ordering
compare :: BlockChecksum -> BlockChecksum -> Ordering
$c< :: BlockChecksum -> BlockChecksum -> Bool
< :: BlockChecksum -> BlockChecksum -> Bool
$c<= :: BlockChecksum -> BlockChecksum -> Bool
<= :: BlockChecksum -> BlockChecksum -> Bool
$c> :: BlockChecksum -> BlockChecksum -> Bool
> :: BlockChecksum -> BlockChecksum -> Bool
$c>= :: BlockChecksum -> BlockChecksum -> Bool
>= :: BlockChecksum -> BlockChecksum -> Bool
$cmax :: BlockChecksum -> BlockChecksum -> BlockChecksum
max :: BlockChecksum -> BlockChecksum -> BlockChecksum
$cmin :: BlockChecksum -> BlockChecksum -> BlockChecksum
min :: BlockChecksum -> BlockChecksum -> BlockChecksum
Ord, Int -> BlockChecksum -> ShowS
[BlockChecksum] -> ShowS
BlockChecksum -> String
(Int -> BlockChecksum -> ShowS)
-> (BlockChecksum -> String)
-> ([BlockChecksum] -> ShowS)
-> Show BlockChecksum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockChecksum -> ShowS
showsPrec :: Int -> BlockChecksum -> ShowS
$cshow :: BlockChecksum -> String
show :: BlockChecksum -> String
$cshowList :: [BlockChecksum] -> ShowS
showList :: [BlockChecksum] -> ShowS
Show)

instance Storable BlockChecksum where
  sizeOf :: BlockChecksum -> Int
sizeOf BlockChecksum
_ = (Int
4)
{-# LINE 124 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
  alignment _ = 4
{-# LINE 125 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
  peek p = do
    n <- peek (castPtr p :: Ptr Word32)
{-# LINE 127 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    case n of
      0 -> return LZ4F_noBlockChecksum
{-# LINE 129 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
      1 -> return LZ4F_blockChecksumEnabled
{-# LINE 130 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
      _ -> throwIO $ Lz4FormatException $ "lz4 instance Storable BlockChecksum: encountered unknown LZ4F_blockChecksum_t: " ++ show n
  poke :: Ptr BlockChecksum -> BlockChecksum -> IO ()
poke Ptr BlockChecksum
p BlockChecksum
mode = Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr BlockChecksum -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr BlockChecksum
p :: Ptr Word32) (Word32 -> IO ()) -> Word32 -> IO ()
forall a b. (a -> b) -> a -> b
$ case BlockChecksum
mode of
{-# LINE 132 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    LZ4F_noBlockChecksum  -> 0
{-# LINE 133 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    LZ4F_blockChecksumEnabled -> 1
{-# LINE 134 "src/Codec/Compression/LZ4/CTypes.hsc" #-}


data FrameType
  = LZ4F_frame
  | LZ4F_skippableFrame
  deriving (FrameType -> FrameType -> Bool
(FrameType -> FrameType -> Bool)
-> (FrameType -> FrameType -> Bool) -> Eq FrameType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FrameType -> FrameType -> Bool
== :: FrameType -> FrameType -> Bool
$c/= :: FrameType -> FrameType -> Bool
/= :: FrameType -> FrameType -> Bool
Eq, Eq FrameType
Eq FrameType =>
(FrameType -> FrameType -> Ordering)
-> (FrameType -> FrameType -> Bool)
-> (FrameType -> FrameType -> Bool)
-> (FrameType -> FrameType -> Bool)
-> (FrameType -> FrameType -> Bool)
-> (FrameType -> FrameType -> FrameType)
-> (FrameType -> FrameType -> FrameType)
-> Ord FrameType
FrameType -> FrameType -> Bool
FrameType -> FrameType -> Ordering
FrameType -> FrameType -> FrameType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FrameType -> FrameType -> Ordering
compare :: FrameType -> FrameType -> Ordering
$c< :: FrameType -> FrameType -> Bool
< :: FrameType -> FrameType -> Bool
$c<= :: FrameType -> FrameType -> Bool
<= :: FrameType -> FrameType -> Bool
$c> :: FrameType -> FrameType -> Bool
> :: FrameType -> FrameType -> Bool
$c>= :: FrameType -> FrameType -> Bool
>= :: FrameType -> FrameType -> Bool
$cmax :: FrameType -> FrameType -> FrameType
max :: FrameType -> FrameType -> FrameType
$cmin :: FrameType -> FrameType -> FrameType
min :: FrameType -> FrameType -> FrameType
Ord, Int -> FrameType -> ShowS
[FrameType] -> ShowS
FrameType -> String
(Int -> FrameType -> ShowS)
-> (FrameType -> String)
-> ([FrameType] -> ShowS)
-> Show FrameType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FrameType -> ShowS
showsPrec :: Int -> FrameType -> ShowS
$cshow :: FrameType -> String
show :: FrameType -> String
$cshowList :: [FrameType] -> ShowS
showList :: [FrameType] -> ShowS
Show)

instance Storable FrameType where
  sizeOf :: FrameType -> Int
sizeOf FrameType
_ = (Int
4)
{-# LINE 143 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
  alignment _ = 4
{-# LINE 144 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
  peek p = do
    n <- peek (castPtr p :: Ptr Word32)
{-# LINE 146 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    case n of
      0 -> return LZ4F_frame
{-# LINE 148 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
      1 -> return LZ4F_skippableFrame
{-# LINE 149 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
      _ -> throwIO $ Lz4FormatException $ "lz4 instance Storable FrameType: encountered unknown LZ4F_frameType_t: " ++ show n
  poke :: Ptr FrameType -> FrameType -> IO ()
poke Ptr FrameType
p FrameType
mode = Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr FrameType -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr FrameType
p :: Ptr Word32) (Word32 -> IO ()) -> Word32 -> IO ()
forall a b. (a -> b) -> a -> b
$ case FrameType
mode of
{-# LINE 151 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    LZ4F_frame  -> 0
{-# LINE 152 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    LZ4F_skippableFrame -> 1
{-# LINE 153 "src/Codec/Compression/LZ4/CTypes.hsc" #-}


data FrameInfo = FrameInfo
  { FrameInfo -> BlockSizeID
blockSizeID         :: BlockSizeID
  , FrameInfo -> BlockMode
blockMode           :: BlockMode
  , FrameInfo -> ContentChecksum
contentChecksumFlag :: ContentChecksum
  , FrameInfo -> FrameType
frameType           :: FrameType
  , FrameInfo -> Word64
contentSize         :: Word64
  , FrameInfo -> Word32
dictID              :: Word32 -- ^ @unsigned int@ in @lz4frame.h@, which can be 16 or 32 bits; AFAIK GHC does not run on archs where it is 16-bit, so there's a compile-time check for it.
  , FrameInfo -> BlockChecksum
blockChecksumFlag   :: BlockChecksum
  }

-- See comment on `dictID`.
$(if (4) /= (4 :: Int)
{-# LINE 167 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    then error "sizeof(unsigned) is not 4 (32-bits), the code is not written for this"
    else pure []
 )

instance Storable FrameInfo where
  sizeOf :: FrameInfo -> Int
sizeOf FrameInfo
_ = (Int
32)
{-# LINE 173 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
  alignment _ = 8
{-# LINE 174 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
  peek p = do
    blockSizeID <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 176 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    blockMode <- (\hsc_ptr -> peekByteOff hsc_ptr 4) p
{-# LINE 177 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    contentChecksumFlag <- (\hsc_ptr -> peekByteOff hsc_ptr 8) p
{-# LINE 178 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    frameType <- (\hsc_ptr -> peekByteOff hsc_ptr 12) p
{-# LINE 179 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    contentSize <- (\hsc_ptr -> peekByteOff hsc_ptr 16) p
{-# LINE 180 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    dictID <- (\hsc_ptr -> peekByteOff hsc_ptr 24) p
{-# LINE 181 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    blockChecksumFlag <- (\hsc_ptr -> peekByteOff hsc_ptr 28) p
{-# LINE 182 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    return $ FrameInfo
      { blockSizeID
      , blockMode
      , contentChecksumFlag
      , frameType
      , contentSize
      , dictID
      , blockChecksumFlag
      }
  poke :: Ptr FrameInfo -> FrameInfo -> IO ()
poke Ptr FrameInfo
p FrameInfo
frameInfo = do
    (\Ptr FrameInfo
hsc_ptr -> Ptr FrameInfo -> Int -> BlockSizeID -> IO ()
forall b. Ptr b -> Int -> BlockSizeID -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FrameInfo
hsc_ptr Int
0) Ptr FrameInfo
p (BlockSizeID -> IO ()) -> BlockSizeID -> IO ()
forall a b. (a -> b) -> a -> b
$ FrameInfo -> BlockSizeID
blockSizeID FrameInfo
frameInfo
{-# LINE 193 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 4) p $ blockMode frameInfo
{-# LINE 194 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 8) p $ contentChecksumFlag frameInfo
{-# LINE 195 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 12) p $ frameType frameInfo
{-# LINE 196 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 16) p $ contentSize frameInfo
{-# LINE 197 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    -- These were reserved fields once; versions of `lz4frame.h` older
    -- than v1.8.0 will not have them.
    (\Ptr FrameInfo
hsc_ptr -> Ptr FrameInfo -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FrameInfo
hsc_ptr Int
24) Ptr FrameInfo
p (Word32 -> IO ()) -> Word32 -> IO ()
forall a b. (a -> b) -> a -> b
$ FrameInfo -> Word32
dictID FrameInfo
frameInfo
{-# LINE 200 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 28) p $ blockChecksumFlag frameInfo
{-# LINE 201 "src/Codec/Compression/LZ4/CTypes.hsc" #-}


data Preferences = Preferences
  { Preferences -> FrameInfo
frameInfo        :: FrameInfo
  , Preferences -> Int
compressionLevel :: Int
  , Preferences -> Bool
autoFlush        :: Bool
  , Preferences -> Bool
favorDecSpeed    :: Bool
  }

instance Storable Preferences where
  sizeOf :: Preferences -> Int
sizeOf Preferences
_ = (Int
56)
{-# LINE 212 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
  alignment _ = 8
{-# LINE 213 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
  peek p = do
    frameInfo <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 215 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    compressionLevel <- (\hsc_ptr -> peekByteOff hsc_ptr 32) p
{-# LINE 216 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    autoFlush <- (\hsc_ptr -> peekByteOff hsc_ptr 36) p
{-# LINE 217 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    favorDecSpeed <- (\hsc_ptr -> peekByteOff hsc_ptr 40) p
{-# LINE 218 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    return $ Preferences
      { frameInfo
      , compressionLevel
      , autoFlush
      , favorDecSpeed
      }
  poke :: Ptr Preferences -> Preferences -> IO ()
poke Ptr Preferences
p Preferences
preferences = do
    Ptr Preferences -> Word8 -> Int -> IO ()
forall a. Ptr a -> Word8 -> Int -> IO ()
fillBytes Ptr Preferences
p Word8
0 (Int
56) -- set reserved fields to 0 as lz4frame.h requires
{-# LINE 226 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 0) p $ frameInfo preferences
{-# LINE 227 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 32) p $ compressionLevel preferences
{-# LINE 228 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 36) p $ autoFlush preferences
{-# LINE 229 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 40) p $ favorDecSpeed preferences -- since lz4 v1.8.2
{-# LINE 230 "src/Codec/Compression/LZ4/CTypes.hsc" #-}
    -- reserved uint field here, see lz4frame.h
    -- reserved uint field here, see lz4frame.h
    -- reserved uint field here, see lz4frame.h


data LZ4F_cctx
data LZ4F_dctx


lz4FrameTypesTable :: Map C.TypeSpecifier TH.TypeQ
lz4FrameTypesTable :: Map TypeSpecifier TypeQ
lz4FrameTypesTable = [(TypeSpecifier, TypeQ)] -> Map TypeSpecifier TypeQ
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  [ (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"LZ4F_cctx", [t| LZ4F_cctx |])
  , (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"LZ4F_dctx", [t| LZ4F_dctx |])
  , (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"LZ4F_blockSizeID_t", [t| BlockSizeID |])
  , (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"LZ4F_blockMode_t", [t| BlockMode |])
  , (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"LZ4F_contentChecksum_t", [t| ContentChecksum |])
  , (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"LZ4F_blockChecksum_t", [t| BlockChecksum |])
  , (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"LZ4F_frameInfo_t", [t| FrameInfo |])
  , (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"LZ4F_frameType_t", [t| FrameType |])
  , (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"LZ4F_preferences_t", [t| Preferences |])
  ]