ktx-codec 0.0.2.0 → 0.0.2.1

raw patch · 10 files changed

+613/−41 lines, 10 filesdep ~basedep ~binarydep ~bytestringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, binary, bytestring, containers, text, vector

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• ktx-codec.cabal +2/−1
• src/Codec/Ktx/KeyValue.hs +42/−0
• src/Codec/Ktx2/DFD.hs +4/−4
• src/Codec/Ktx2/DFD/Khronos/BasicV2.hs +252/−0
• src/Codec/Ktx2/Header.hs +36/−1
• src/Codec/Ktx2/Level.hs +20/−0
• src/Codec/Ktx2/Read.hs +40/−15
• src/Codec/Ktx2/Write.hs +121/−0
• test/Spec.hs +88/−20

@@ -1,5 +1,13 @@ # Changelog for ktx-codec +## [0.0.2.1] - 2023-04-08++* Add `Codec.Ktx2.Write`.+* Add patterns for Khronos keys+* Add patterns for Khronos DFD.BasicV2++[0.0.2.1]: https://gitlab.com/dpwiz/ktx/-/tree/v0.0.2.1-codec+ ## [0.0.2.0] - 2023-03-18  * Add experimental KTX 2.0 support.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           ktx-codec-version:        0.0.2.0+version:        0.0.2.1 synopsis:       Khronos texture format description:    This package implements low-level encoding and decoding for .ktx and .ktx2 files.                 .@@ -42,6 +42,7 @@       Codec.Ktx2.Header       Codec.Ktx2.Level       Codec.Ktx2.Read+      Codec.Ktx2.Write   other-modules:       Paths_ktx_codec   hs-source-dirs:

@@ -1,6 +1,18 @@ module Codec.Ktx.KeyValue   ( KeyValueData +    -- * Predefined keys+  , pattern KTXcubemapIncomplete+  , pattern KTXanimData+  , pattern KTXastcDecodeMode+  , pattern KTXwriterScParams+  , pattern KTXwriter+  , pattern KTXswizzle+  , pattern KTXmetalPixelFormat+  , pattern KTXdxgiFormat__+  , pattern KTXglFormat+  , pattern KTXorientation+     -- * Writing   , Value(..)   , text@@ -124,3 +136,33 @@     putSize (fromIntegral keyAndValueByteSize)     putByteString keyAndValue     putByteString $ BS.replicate paddingSize 0++pattern KTXcubemapIncomplete :: Text+pattern KTXcubemapIncomplete = "KTXcubemapIncomplete"++pattern KTXorientation :: Text+pattern KTXorientation = "KTXorientation"++pattern KTXglFormat :: Text+pattern KTXglFormat = "KTXglFormat"++pattern KTXdxgiFormat__ :: Text+pattern KTXdxgiFormat__ = "KTXdxgiFormat__"++pattern KTXmetalPixelFormat :: Text+pattern KTXmetalPixelFormat = "KTXmetalPixelFormat"++pattern KTXswizzle :: Text+pattern KTXswizzle = "KTXswizzle"++pattern KTXwriter :: Text+pattern KTXwriter = "KTXwriter"++pattern KTXwriterScParams :: Text+pattern KTXwriterScParams = "KTXwriterScParams"++pattern KTXastcDecodeMode :: Text+pattern KTXastcDecodeMode = "KTXastcDecodeMode"++pattern KTXanimData :: Text+pattern KTXanimData = "KTXanimData"

@@ -55,11 +55,11 @@     b <- getWord32le     let       descriptorBlockSize = shiftR b 16-      versionNumber = b .&. 0x0000FFFF-    body <- getByteString $ fromIntegral (descriptorBlockSize - 8)+      versionNumber = b .&. 0x00007FFF+    body <- getByteString $ fromIntegral descriptorBlockSize - 8     pure Block{..}    put Block{..} = do-    put $ shiftL descriptorType 17 .|. vendorId-    put $ shiftL descriptorBlockSize 16 .|. versionNumber+    putWord32le $ shiftL descriptorType 17 .|. vendorId+    putWord32le $ shiftL descriptorBlockSize 16 .|. versionNumber     putByteString body

@@ -188,3 +188,255 @@     }   where     body = BSL.toStrict . runPut $ putter v2++-- * Constructors++unspecified :: BasicV2+unspecified = BasicV2+  { colorModel = KHR_DF_MODEL_UNSPECIFIED+  , colorPrimaries = KHR_DF_PRIMARIES_UNSPECIFIED+  , transferFunction = KHR_DF_TRANSFER_LINEAR+  , flags = KHR_DF_FLAG_ALPHA_STRAIGHT+  , texelBlockDimension0 = 1+  , texelBlockDimension1 = 1+  , texelBlockDimension2 = 1+  , texelBlockDimension3 = 1+  , bytesPlane0 = 0+  , bytesPlane1 = 0+  , bytesPlane2 = 0+  , bytesPlane3 = 0+  , bytesPlane4 = 0+  , bytesPlane5 = 0+  , bytesPlane6 = 0+  , bytesPlane7 = 0+  , samples = mempty+  }++-- * Patterns++pattern KHR_DF_MODEL_UNSPECIFIED :: Word8+pattern KHR_DF_MODEL_UNSPECIFIED = 0++pattern KHR_DF_MODEL_RGBSDA :: Word8+pattern KHR_DF_MODEL_RGBSDA = 1++pattern KHR_DF_MODEL_YUVSDA :: Word8+pattern KHR_DF_MODEL_YUVSDA = 2++pattern KHR_DF_MODEL_YIQSDA :: Word8+pattern KHR_DF_MODEL_YIQSDA = 3++pattern KHR_DF_MODEL_LABSDA :: Word8+pattern KHR_DF_MODEL_LABSDA = 4++pattern KHR_DF_MODEL_CMYKA :: Word8+pattern KHR_DF_MODEL_CMYKA = 5++pattern KHR_DF_MODEL_XYZW :: Word8+pattern KHR_DF_MODEL_XYZW = 6++pattern KHR_DF_MODEL_HSVA_ANG :: Word8+pattern KHR_DF_MODEL_HSVA_ANG = 7++pattern KHR_DF_MODEL_HSLA_ANG :: Word8+pattern KHR_DF_MODEL_HSLA_ANG = 8++pattern KHR_DF_MODEL_HSVA_HEX :: Word8+pattern KHR_DF_MODEL_HSVA_HEX = 9++pattern KHR_DF_MODEL_HSLA_HEX :: Word8+pattern KHR_DF_MODEL_HSLA_HEX = 10++pattern KHR_DF_MODEL_YCGCOA :: Word8+pattern KHR_DF_MODEL_YCGCOA = 11++pattern KHR_DF_MODEL_YCCBCCRC :: Word8+pattern KHR_DF_MODEL_YCCBCCRC = 12++pattern KHR_DF_MODEL_ICTCP :: Word8+pattern KHR_DF_MODEL_ICTCP = 13++pattern KHR_DF_MODEL_CIEXYZ :: Word8+pattern KHR_DF_MODEL_CIEXYZ = 14++pattern KHR_DF_MODEL_CIEXYY :: Word8+pattern KHR_DF_MODEL_CIEXYY = 15++-- *** Compressed formats++pattern KHR_DF_MODEL_DXT1A :: Word8+pattern KHR_DF_MODEL_DXT1A = 128++pattern KHR_DF_MODEL_BC1A :: Word8+pattern KHR_DF_MODEL_BC1A = KHR_DF_MODEL_DXT1A++pattern KHR_DF_MODEL_DXT2 :: Word8+pattern KHR_DF_MODEL_DXT2 = 129++pattern KHR_DF_MODEL_DXT3 :: Word8+pattern KHR_DF_MODEL_DXT3 = KHR_DF_MODEL_DXT2++pattern KHR_DF_MODEL_BC2 :: Word8+pattern KHR_DF_MODEL_BC2 = KHR_DF_MODEL_DXT2++pattern KHR_DF_MODEL_DXT4 :: Word8+pattern KHR_DF_MODEL_DXT4 = 130++pattern KHR_DF_MODEL_DXT5 :: Word8+pattern KHR_DF_MODEL_DXT5 = KHR_DF_MODEL_DXT4++pattern KHR_DF_MODEL_BC3 :: Word8+pattern KHR_DF_MODEL_BC3 = KHR_DF_MODEL_DXT4++pattern KHR_DF_MODEL_BC4 :: Word8+pattern KHR_DF_MODEL_BC4 = 131++pattern KHR_DF_MODEL_BC5 :: Word8+pattern KHR_DF_MODEL_BC5 = 132++pattern KHR_DF_MODEL_BC6H :: Word8+pattern KHR_DF_MODEL_BC6H = 133++pattern KHR_DF_MODEL_BC7 :: Word8+pattern KHR_DF_MODEL_BC7 = 134+++pattern KHR_DF_MODEL_ETC1 :: Word8+pattern KHR_DF_MODEL_ETC1 = 160++pattern KHR_DF_MODEL_ETC2 :: Word8+pattern KHR_DF_MODEL_ETC2 = 161++pattern KHR_DF_MODEL_ASTC2 :: Word8+pattern KHR_DF_MODEL_ASTC2 = 162++pattern KHR_DF_MODEL_ETC1S :: Word8+pattern KHR_DF_MODEL_ETC1S = 163++pattern KHR_DF_MODEL_PVRTC :: Word8+pattern KHR_DF_MODEL_PVRTC = 164++pattern KHR_DF_MODEL_PVRTC2 :: Word8+pattern KHR_DF_MODEL_PVRTC2 = 165++-- ** Color primaries++pattern KHR_DF_PRIMARIES_UNSPECIFIED :: Word8+pattern KHR_DF_PRIMARIES_UNSPECIFIED = 0++pattern KHR_DF_PRIMARIES_BT709 :: Word8+pattern KHR_DF_PRIMARIES_BT709 = 1++pattern KHR_DF_PRIMARIES_SRGB :: Word8+pattern KHR_DF_PRIMARIES_SRGB = KHR_DF_PRIMARIES_BT709++pattern KHR_DF_PRIMARIES_BT601_EBU :: Word8+pattern KHR_DF_PRIMARIES_BT601_EBU = 2++pattern KHR_DF_PRIMARIES_BT601_SMPTE :: Word8+pattern KHR_DF_PRIMARIES_BT601_SMPTE = 3++pattern KHR_DF_PRIMARIES_BT2020 :: Word8+pattern KHR_DF_PRIMARIES_BT2020 = 4++pattern KHR_DF_PRIMARIES_CIEXYZ :: Word8+pattern KHR_DF_PRIMARIES_CIEXYZ = 5++pattern KHR_DF_PRIMARIES_ACES :: Word8+pattern KHR_DF_PRIMARIES_ACES = 6++pattern KHR_DF_PRIMARIES_ACESCC :: Word8+pattern KHR_DF_PRIMARIES_ACESCC = 7++pattern KHR_DF_PRIMARIES_NTSC1953 :: Word8+pattern KHR_DF_PRIMARIES_NTSC1953 = 8++pattern KHR_DF_PRIMARIES_PAL525 :: Word8+pattern KHR_DF_PRIMARIES_PAL525 = 9++pattern KHR_DF_PRIMARIES_DISPLAYP3 :: Word8+pattern KHR_DF_PRIMARIES_DISPLAYP3 = 10++pattern KHR_DF_PRIMARIES_ADOBERGB :: Word8+pattern KHR_DF_PRIMARIES_ADOBERGB = 11++-- ** Transfer functions++pattern KHR_DF_TRANSFER_UNSPECIFIED :: Word8+pattern KHR_DF_TRANSFER_UNSPECIFIED = 0++pattern KHR_DF_TRANSFER_LINEAR :: Word8+pattern KHR_DF_TRANSFER_LINEAR = 1++pattern KHR_DF_TRANSFER_SRGB :: Word8+pattern KHR_DF_TRANSFER_SRGB = 2++pattern KHR_DF_TRANSFER_ITU :: Word8+pattern KHR_DF_TRANSFER_ITU = 3++pattern KHR_DF_TRANSFER_NTSC :: Word8+pattern KHR_DF_TRANSFER_NTSC = 4++pattern KHR_DF_TRANSFER_SLOG :: Word8+pattern KHR_DF_TRANSFER_SLOG = 5++pattern KHR_DF_TRANSFER_SLOG2 :: Word8+pattern KHR_DF_TRANSFER_SLOG2 = 6++pattern KHR_DF_TRANSFER_BT1886 :: Word8+pattern KHR_DF_TRANSFER_BT1886 = 7++pattern KHR_DF_TRANSFER_HLG_OETF :: Word8+pattern KHR_DF_TRANSFER_HLG_OETF = 8++pattern KHR_DF_TRANSFER_HLG_EOTF :: Word8+pattern KHR_DF_TRANSFER_HLG_EOTF = 9++pattern KHR_DF_TRANSFER_PQ_EOTF :: Word8+pattern KHR_DF_TRANSFER_PQ_EOTF = 10++pattern KHR_DF_TRANSFER_PQ_OETF :: Word8+pattern KHR_DF_TRANSFER_PQ_OETF = 11++pattern KHR_DF_TRANSFER_DCIP3 :: Word8+pattern KHR_DF_TRANSFER_DCIP3 = 12++pattern KHR_DF_TRANSFER_PAL_OETF :: Word8+pattern KHR_DF_TRANSFER_PAL_OETF = 13++pattern KHR_DF_TRANSFER_PAL625_EOTF :: Word8+pattern KHR_DF_TRANSFER_PAL625_EOTF = 14++pattern KHR_DF_TRANSFER_ST240 :: Word8+pattern KHR_DF_TRANSFER_ST240 = 15++pattern KHR_DF_TRANSFER_ACESCC :: Word8+pattern KHR_DF_TRANSFER_ACESCC = 16++pattern KHR_DF_TRANSFER_ACESCCT :: Word8+pattern KHR_DF_TRANSFER_ACESCCT = 17++pattern KHR_DF_TRANSFER_ADOBERGB :: Word8+pattern KHR_DF_TRANSFER_ADOBERGB = 18++-- ** Flags++pattern KHR_DF_FLAG_ALPHA_STRAIGHT :: Word8+pattern KHR_DF_FLAG_ALPHA_STRAIGHT = 0++pattern KHR_DF_FLAG_ALPHA_PREMULTIPLIED :: Word8+pattern KHR_DF_FLAG_ALPHA_PREMULTIPLIED = 1++-- ** Samples++pattern KHR_DF_SAMPLE_DATATYPE_FLOAT :: (Eq a, Num a) => a+pattern KHR_DF_SAMPLE_DATATYPE_FLOAT = 0x80++pattern KHR_DF_SAMPLE_DATATYPE_SIGNED :: (Eq a, Num a) => a+pattern KHR_DF_SAMPLE_DATATYPE_SIGNED = 0x40++pattern KHR_DF_SAMPLE_DATATYPE_EXPONENT :: (Eq a, Num a) => a+pattern KHR_DF_SAMPLE_DATATYPE_EXPONENT = 0x20++pattern KHR_DF_SAMPLE_DATATYPE_LINEAR :: (Eq a, Num a) => a+pattern KHR_DF_SAMPLE_DATATYPE_LINEAR = 0x10

@@ -1,4 +1,12 @@-module Codec.Ktx2.Header where+module Codec.Ktx2.Header+  ( Header(..)+  , prepare+  , canonicalIdentifier+  , pattern SC_NONE+  , pattern SC_BASISLZ+  , pattern SC_ZSTANDARD+  , pattern SC_ZLIB+  ) where  import Data.Binary (Binary(..)) import Data.Binary.Get (getWord32le, getWord64le, getByteString)@@ -30,6 +38,33 @@   , sgdByteOffset :: Word64 -- ^ The offset from the start of the file of supercompressionGlobalData. The value must be 0 when sgdByteLength = 0.   , sgdByteLength :: Word64 -- ^ The number of bytes of supercompressionGlobalData. For supercompression schemes for which no reference is provided in the Global Data Format column of Table 2, “Supercompression Schemes”. the value must be 0.   } deriving (Eq, Show, Generic)++prepare+  :: Integral dims+  => Word32+  -> Word32+  -> dims+  -> dims+  -> dims+  -> Word32+  -> Header+prepare vkFormat typeSize imageWidth imageHeight imageDepth scheme = Header+  { vkFormat+  , typeSize+  , pixelWidth = fromIntegral imageWidth+  , pixelHeight = fromIntegral imageHeight+  , pixelDepth = fromIntegral imageDepth+  , layerCount = 0+  , faceCount = 1+  , levelCount = 1+  , supercompressionScheme = scheme+  , dfdByteOffset = 0+  , dfdByteLength = 0+  , kvdByteOffset = 0+  , kvdByteLength = 0+  , sgdByteOffset = 0+  , sgdByteLength = 0+  }  instance Binary Header where   get = do

@@ -3,6 +3,12 @@ import Data.Binary (Binary(..)) import Data.Binary.Get (getWord64le) import Data.Binary.Put (putWord64le)+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.List (mapAccumR)+import Data.Maybe (fromMaybe)+import Data.Vector (Vector)+import Data.Vector qualified as Vector import Data.Word (Word64) import GHC.Generics (Generic) @@ -23,3 +29,17 @@     putWord64le byteOffset     putWord64le byteLength     putWord64le uncompressedByteLength++-- | Build a level index from level data.+--+-- Levels should be placed from largest (mip 0) to smallest.+index :: Word64 -> [(Maybe Word64, ByteString)] -> Vector Level+index startOffset = Vector.fromList . snd . mapAccumR mkIndex startOffset+  where+    mkIndex byteOffset (uncompressed, bytes) =+      ( byteOffset + byteLength+      , Level{..}+      )+      where+        byteLength = fromIntegral $ BS.length bytes+        uncompressedByteLength = fromMaybe byteLength uncompressed

@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}  {- | Block-by-block extraction of data from a KTX2 file. @@ -63,7 +64,8 @@ import Codec.Ktx.KeyValue qualified as KeyValue import Codec.Ktx2.Header (Header(..)) import Codec.Ktx2.Level (Level(..))-import Codec.Ktx2.DFD (DFD)+import Codec.Ktx2.DFD (DFD(..))+import Data.Typeable (Typeable, Proxy(..), typeRep)  -- * Context @@ -207,11 +209,17 @@   => Context src   -> io DFD dataFormatDescriptor (Context handle Header{..}) =-  decodeAt-    handle-    (fromIntegral dfdByteOffset)-    (fromIntegral dfdByteLength)-    get+  if dfdByteLength == 0 then+    pure DFD+      { dfdTotalSize = 0+      , dfdBlocks = mempty+      }+  else+    decodeAt+      handle+      (fromIntegral dfdByteOffset)+      (fromIntegral dfdByteLength)+      get  {- | Read and parse Key-Value Data block. -}@@ -222,11 +230,14 @@   => Context src   -> io KeyValueData keyValueData (Context handle Header{..}) =-  decodeAt-    handle-    (fromIntegral kvdByteOffset)-    (fromIntegral kvdByteLength)-    (KeyValue.getDataLe $ fromIntegral kvdByteLength)+  if kvdByteLength == 0 then+    pure mempty+  else+    decodeAt+      handle+      (fromIntegral kvdByteOffset)+      (fromIntegral kvdByteLength)+      (KeyValue.getDataLe $ fromIntegral kvdByteLength)  -- | Get a copy of global supercompression data. supercompressionGlobalData@@ -259,8 +270,10 @@  -- | Get a chunk of data and run a decoder on it. decodeAt-  :: ( ReadChunk src+  :: forall a src io+  .  ( ReadChunk src      , Show a+     , Typeable a      , MonadIO io      )   => src@@ -274,10 +287,22 @@     Right ("", used, ok) | fromIntegral used == size ->       pure ok     Right (remains, finalOffset, _okBut) ->-      liftIO . throwIO $ DecodeError finalOffset $-        "BUG: unused data" <> fromString (show remains)+      liftIO . throwIO $ DecodeError+        (fromIntegral offset + finalOffset)+        ( "BUG: unused data " <>+          fromString (show remains)+        )     Left (_remains, errorOffset, message) ->-      liftIO . throwIO $ DecodeError errorOffset (fromString message)+      liftIO . throwIO $ DecodeError+        (fromIntegral offset + errorOffset)+        ( fromString $ unwords+            [ typeName+            , "-"+            , message+            ]+        )+  where+    typeName = show $ typeRep (Proxy :: Proxy a)  data DecodeError = DecodeError ByteOffset Text   deriving (Eq, Show)

@@ -0,0 +1,121 @@+module Codec.Ktx2.Write+  ( toFile+  , toChunks+  ) where++import Control.Monad (unless)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Binary (Binary(..))+import Data.Binary.Put (runPut, putLazyByteString, putByteString)+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BSL+import Data.Foldable (traverse_)+import Data.Map qualified as Map+import Data.Vector (Vector)+import Data.Vector qualified as Vector+import Data.Word (Word64)++import Codec.Ktx.KeyValue (KeyValueData)+import Codec.Ktx.KeyValue qualified as KeyValueData+import Codec.Ktx2.DFD (DFD(..))+import Codec.Ktx2.DFD qualified as DFD+import Codec.Ktx2.Header (Header)+import Codec.Ktx2.Header qualified as Header+import Codec.Ktx2.Level qualified as Level++toFile+  :: MonadIO io+  => FilePath+  -> Header+  -> Vector DFD.Block+  -> KeyValueData+  -> ByteString+  -> [(Maybe Word64, ByteString)]+  -> io ()+toFile path headerBase dfdBlocks kvd sgd levels =+  liftIO . BSL.writeFile path $+    toChunks headerBase dfdBlocks kvd sgd levels++toChunks+  :: Header+  -> Vector DFD.Block+  -> KeyValueData+  -> ByteString+  -> [(Maybe Word64, ByteString)]+  -> BSL.ByteString+toChunks headerBase dfdBlocks kvd sgd levels =+  runPut do+    put header+    Vector.mapM_ put levelIndex+    put dfd++    putLazyByteString kvdBytes++    unless (BS.null sgd) do+      putByteString $ BS.replicate sgdPadding 0x00+      putByteString sgd++    traverse_ (putByteString . snd) (reverse levels)+  where+    header = headerBase+      { Header.levelCount =+          fromIntegral levelCount++      , Header.dfdByteOffset =+          fromIntegral dfdOffset+      , Header.dfdByteLength =+          fromIntegral dfdLength++      , Header.kvdByteOffset =+          fromIntegral kvdOffset+      , Header.kvdByteLength =+          fromIntegral kvdLength++      , Header.sgdByteOffset =+          fromIntegral sgdOffset+      , Header.sgdByteLength =+          fromIntegral sgdLength+      }++    levelIndex = Level.index levelBaseOffset levels+    levelCount = Vector.length levelIndex+    levelIndexOffset = 80+    levelIndexLength = levelCount * 8 * 3+    levelIndexEnd = levelIndexOffset + levelIndexLength++    (dfdOffset, dfdLength) =+      if Vector.null dfdBlocks then+        (0, 0)+      else+        ( levelIndexEnd+        , fromIntegral $ dfdTotalSize dfd+        )+    dfd = DFD+      { dfdTotalSize =+          4 + Vector.sum (Vector.map DFD.descriptorBlockSize dfdBlocks)+      , dfdBlocks = dfdBlocks+      }+    dfdEnd = levelIndexEnd + dfdLength++    (kvdOffset, kvdLength) =+      if Map.null kvd then+        (0, 0)+      else+        ( dfdEnd+        , fromIntegral $ BSL.length kvdBytes+        )+    kvdBytes = runPut $ KeyValueData.putDataLe kvd+    kvdEnd = dfdEnd + kvdLength++    (sgdPadding, sgdOffset, sgdLength) =+      if BS.null sgd then+        (0, 0, 0)+      else+        ( 7 - ((kvdEnd + 7) `rem` 8)+        , sgdPadding + kvdEnd+        , BS.length sgd+        )+    sgdEnd = kvdEnd + sgdLength++    levelBaseOffset = fromIntegral sgdEnd

@@ -2,11 +2,13 @@  import Codec.Compression.Zstd.FFI qualified as Zstd import Control.Exception (bracket)-import Control.Monad (guard, unless)+import Control.Monad (guard, unless, void) import Data.ByteString qualified as BS import Data.ByteString.Builder (toLazyByteString) import Data.ByteString.Lazy qualified as BSL+import Data.Foldable (for_) import Data.List (isSuffixOf)+import Data.Traversable (for) import Data.Vector qualified as Vector import Debug.Trace (traceM) import Foreign qualified@@ -14,8 +16,8 @@ import System.Directory (listDirectory) import System.Environment (lookupEnv) import System.FilePath ((</>))-import Test.Tasty-import Test.Tasty.HUnit+import Test.Tasty (testGroup, defaultMain)+import Test.Tasty.HUnit (testCase)  import Codec.Ktx qualified as Ktx1 import Codec.Ktx.KeyValue qualified as KeyValue@@ -24,6 +26,7 @@ import Codec.Ktx2.Header qualified as Header import Codec.Ktx2.Level qualified as Level import Codec.Ktx2.Read qualified as Read+import Codec.Ktx2.Write qualified as Write  assetsPath :: FilePath assetsPath = ".." </> "assets"@@ -71,13 +74,59 @@ testKtx2File :: FilePath -> IO () testKtx2File source =   bracket (Read.open source) Read.close $-    testKtx2Context source+    void . testKtx2Context source  testKtx2Bytes :: FilePath -> IO () testKtx2Bytes source = do   contents <- BS.readFile source-  Read.bytes contents >>= testKtx2Context source+  context <- Read.bytes contents +  chunks <- testKtx2Context source context+  -- BSL.writeFile (source <> ".out") chunks++  tripping <- Read.bytes (BSL.toStrict chunks)+  let+    readHeader = Read.header context+    writeHeader = Read.header tripping+  unless (readHeader == writeHeader) $+    fail . mappend "Header tripping failed:\n" $ show+      ( readHeader+      , writeHeader+      )++  readLevels <- Read.levels context+  writeLevels <- Read.levels tripping+  unless (readLevels == writeLevels) $+    fail . mappend "Level index tripping failed:\n" $ show+      ( readLevels+      , writeLevels+      )++  readDfd <- Read.dataFormatDescriptor context+  writeDfd <- Read.dataFormatDescriptor tripping+  unless (readDfd == writeDfd) $+    fail . mappend "DFD tripping failed:\n" $ show+      ( readDfd+      , writeDfd+      )++  readKvd <- Read.keyValueData context+  writeKvd <- Read.keyValueData tripping+  unless (readKvd == writeKvd) $+    fail . mappend "KeyValue tripping failed:\n" $ show+      ( readKvd+      , writeKvd+      )++  for_ readLevels \level -> do+    readLevel <- Read.levelData context level+    writeLevel <- Read.levelData tripping level+    unless (readLevel == writeLevel) $+      fail . mappend "Level tripping failed:\n" $ show+        ( level+        , BS.take 16 readLevel+        , BS.take 16 writeLevel+        ) testKtx2Context   :: ( Read.ReadChunk a      , Read.ReadLevel a@@ -85,7 +134,7 @@      )   => FilePath   -> Read.Context a-  -> IO ()+  -> IO BSL.ByteString testKtx2Context source ctx = do   printer ctx @@ -93,21 +142,25 @@   printer levels    DFD{dfdBlocks} <- Read.dataFormatDescriptor ctx-  block0 <- Vector.headM dfdBlocks-  case BasicV2.fromBlock block0 of-    Nothing -> do-      printer block0-      fail $ "Unexpected block type in test suite in " <> source-    Just basic -> do-      -- printer basic-      let back = BasicV2.toBlock basic-      unless (back == block0) do-        printer (back, block0)-        fail "BasicV2 tripping failed"+  Vector.forM_ dfdBlocks \block -> do+    case BasicV2.fromBlock block of+      Nothing -> do+        printer block+        fail $ "Unexpected block type in test suite in " <> source+      Just basic -> do+        -- printer basic+        let back = BasicV2.toBlock basic+        unless (back == block) do+          printer (back, block)+          fail "BasicV2 DFD tripping failed" -  fmap KeyValue.textual (Read.keyValueData ctx) >>= Shower.printer-  Read.supercompressionGlobalData ctx >>= printer-  Vector.forM_ levels \level -> do+  kvd <- Read.keyValueData ctx+  printer $ KeyValue.textual kvd++  sgd <- Read.supercompressionGlobalData ctx+  printer sgd++  levelBuffers <- for (Vector.toList levels) \level -> do     bytes <- Read.levelData ctx level     unless (BS.length bytes == fromIntegral (Level.byteLength level)) $       fail "Uncompressed level data does not match with index!"@@ -145,6 +198,21 @@          huh ->           fail $ "Unexpected supercompression: " <> show huh+    pure+      ( if Header.supercompressionScheme (Read.header ctx) == Header.SC_NONE then+          Nothing+        else+          Just . fromIntegral $ Level.uncompressedByteLength level+      , bytes+      )++  pure $+    Write.toChunks+      (Read.header ctx)+      dfdBlocks+      kvd+      sgd+      levelBuffers  printer :: Show a => a -> IO () printer x =