{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLists       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}

-- |
-- Module      :  Data.BAM.Version1_6.Read.Parser.BGZFBlock
-- Copyright   :  (c) Matthew Mosior 2024
-- License     :  BSD-style
-- Maintainer  :  mattm.github@gmail.com
-- Portability :  portable
--
-- = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this library are expected to track development
-- closely.
--
-- All credit goes to the author(s)/maintainer(s) of the
-- [containers](https://hackage.haskell.org/package/containers) library
-- for the above warning text.
--
-- = Description
--
-- This library enables the decoding/encoding of SAM, BAM and CRAM file formats.

module Data.BAM.Version1_6.Read.Parser.BGZFBlock ( -- * BAM_V1_6 parser - BGZF block section.
                                                   parse_BAM_V1_6_BGZFBlock
                                                 ) where

import           Data.BAM.Version1_6.Internal
import           Data.BAM.Version1_6.Read.Parser.BAM.Base
import           Data.BAM.Version1_6.BGZFBlock
import           Data.BAM.Version1_6.GZipHeader
import           Data.BAM.Version1_6.Read.Error

import           Codec.Compression.Zlib.Raw        as CCZlibR (decompress)
import           Data.Attoparsec.ByteString.Lazy   as DABL
import qualified Data.ByteString                   as DB      (fromStrict,unpack)
import           Data.Digest.CRC32                            (crc32)
import           Data.Word

-- | Defines a parser for a single BGZF block.
--
-- See the [SAM v1.6](http://samtools.github.io/hts-specs/SAMv1.pdf) specification documentation.
parse_BAM_V1_6_BGZFBlock :: Parser BAM_V1_6_BGZFBlock
parse_BAM_V1_6_BGZFBlock :: Parser BAM_V1_6_BGZFBlock
parse_BAM_V1_6_BGZFBlock = do
  ByteString
gzipheaderidentification1field <- do
    ByteString
gzipheaderidentification1fieldp <-
      Int -> Parser ByteString ByteString
DABL.take Int
1
    -- Parse GZip header Identification 1 field.
    case ( ( [Word8] -> Word8
word8sToWord8LE ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$
               ByteString -> [Word8]
DB.unpack ByteString
gzipheaderidentification1fieldp
           ) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x1f
         ) of
      Bool
False ->
        String -> Parser ByteString ByteString
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString ByteString)
-> String -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$
          BAM_V1_6_Read_Error -> String
forall a. Show a => a -> String
show BAM_V1_6_Read_Error
BAM_V1_6_Read_Error_GZipHeader_ID1_Incorrect_Format
      Bool
True  -> do
        -- Identification field 1 is in the accepted format.
        ByteString -> Parser ByteString ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
gzipheaderidentification1fieldp
  ByteString
gzipheaderidentification2field <- do
    ByteString
gzipheaderidentification2fieldp <-
      Int -> Parser ByteString ByteString
DABL.take Int
1
    -- Parse GZip header Identification 2 field.
    case ( ( [Word8] -> Word8
word8sToWord8LE ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$
               ByteString -> [Word8]
DB.unpack ByteString
gzipheaderidentification2fieldp
           ) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x8b
         ) of
      Bool
False ->
        String -> Parser ByteString ByteString
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString ByteString)
-> String -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$
          BAM_V1_6_Read_Error -> String
forall a. Show a => a -> String
show BAM_V1_6_Read_Error
BAM_V1_6_Read_Error_GZipHeader_ID2_Incorrect_Format
      Bool
True  ->
        -- Identification field 2 is in the accepted format.
        ByteString -> Parser ByteString ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
gzipheaderidentification2fieldp 
  ByteString
gzipheadercompressionmethodfield <- do
    ByteString
gzipheadercompressionmethodfieldp <-
      Int -> Parser ByteString ByteString
DABL.take Int
1
    -- Parse GZip header Compression Method field.
    case ( Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem
           ( [Word8] -> Word8
word8sToWord8LE ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$
               ByteString -> [Word8]
DB.unpack ByteString
gzipheadercompressionmethodfieldp
           )
           [Word8]
compressionmethodpossiblebytes
         ) of
      Bool
False ->
        String -> Parser ByteString ByteString
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString ByteString)
-> String -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$
          BAM_V1_6_Read_Error -> String
forall a. Show a => a -> String
show BAM_V1_6_Read_Error
BAM_V1_6_Read_Error_GZipHeader_Compression_Method_Incorrect_Format
      Bool
True  ->
        -- Compression Method is in the accepted format.
        ByteString -> Parser ByteString ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
gzipheadercompressionmethodfieldp
  ByteString
gzipheaderflagsfield <- do
    ByteString
gzipheaderflagsfieldp <-
      Int -> Parser ByteString ByteString
DABL.take Int
1
    -- Parse GZip Flags (FLaGs) field.
    case ( Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem
           ( [Word8] -> Word8
word8sToWord8LE ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$
               ByteString -> [Word8]
DB.unpack ByteString
gzipheaderflagsfieldp
           )
           [Word8]
flagpossiblebytes
         ) of
      Bool
False ->
        String -> Parser ByteString ByteString
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString ByteString)
-> String -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$
          BAM_V1_6_Read_Error -> String
forall a. Show a => a -> String
show BAM_V1_6_Read_Error
BAM_V1_6_Read_Error_GZipHeader_Flag_Incorrect_Format
      Bool
True  ->
        -- Flags (FLaGs) is in the accepted format.
        ByteString -> Parser ByteString ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
gzipheaderflagsfieldp
  ByteString
gzipheadermodificationtimefield <-
    Int -> Parser ByteString ByteString
DABL.take Int
4
  ByteString
gzipheaderextraflagsfield <-
    Int -> Parser ByteString ByteString
DABL.take Int
1
  ByteString
gzipheaderoperatingsystemfield <- do
    ByteString
gzipheaderoperatingsystemfieldp <-
      Int -> Parser ByteString ByteString
DABL.take Int
1
    -- Parse GZip header Operating System field.
    case ( Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem
             ( [Word8] -> Word8
word8sToWord8LE ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$
                 ByteString -> [Word8]
DB.unpack ByteString
gzipheaderoperatingsystemfieldp
             )
           [Word8]
operatingsystempossiblebytes
         ) of
      Bool
False ->
        String -> Parser ByteString ByteString
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString ByteString)
-> String -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$
          BAM_V1_6_Read_Error -> String
forall a. Show a => a -> String
show BAM_V1_6_Read_Error
BAM_V1_6_Read_Error_GZipHeader_Operating_System_Incorrect_Format
      Bool
True  ->
        -- Operating System is in the accepted format.
        ByteString -> Parser ByteString ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
gzipheaderoperatingsystemfieldp
  ByteString
gzipheaderextralengthfield <-
    Int -> Parser ByteString ByteString
DABL.take Int
2
  let gzipheader :: BAM_V1_6_GZipHeader
gzipheader = BAM_V1_6_GZipHeader
                     { bam_v1_6_gzip_header_gzip_identifier_1 :: Word8
bam_v1_6_gzip_header_gzip_identifier_1  = [Word8] -> Word8
word8sToWord8LE ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$
                                                                   ByteString -> [Word8]
DB.unpack ByteString
gzipheaderidentification1field
                     , bam_v1_6_gzip_header_gzip_identifier_2 :: Word8
bam_v1_6_gzip_header_gzip_identifier_2  = [Word8] -> Word8
word8sToWord8LE ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$
                                                                   ByteString -> [Word8]
DB.unpack ByteString
gzipheaderidentification2field
                     , bam_v1_6_gzip_header_compression_method :: Word8
bam_v1_6_gzip_header_compression_method = [Word8] -> Word8
word8sToWord8LE ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$
                                                                   ByteString -> [Word8]
DB.unpack ByteString
gzipheadercompressionmethodfield
                     , bam_v1_6_gzip_header_header_flags :: Word8
bam_v1_6_gzip_header_header_flags       = [Word8] -> Word8
word8sToWord8LE ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$
                                                                   ByteString -> [Word8]
DB.unpack ByteString
gzipheaderflagsfield
                     , bam_v1_6_gzip_header_modification_time :: Word32
bam_v1_6_gzip_header_modification_time  = [Word8] -> Word32
word8sToWord32LE ([Word8] -> Word32) -> [Word8] -> Word32
forall a b. (a -> b) -> a -> b
$
                                                                   ByteString -> [Word8]
DB.unpack ByteString
gzipheadermodificationtimefield
                     , bam_v1_6_gzip_header_extra_flags :: Word8
bam_v1_6_gzip_header_extra_flags        = [Word8] -> Word8
word8sToWord8LE ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$
                                                                   ByteString -> [Word8]
DB.unpack ByteString
gzipheaderextraflagsfield
                     , bam_v1_6_gzip_header_operating_system :: Word8
bam_v1_6_gzip_header_operating_system   = [Word8] -> Word8
word8sToWord8LE ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$
                                                                   ByteString -> [Word8]
DB.unpack ByteString
gzipheaderoperatingsystemfield
                     , bam_v1_6_gzip_header_extra_length :: Word16
bam_v1_6_gzip_header_extra_length       = [Word8] -> Word16
word8sToWord16LE ([Word8] -> Word16) -> [Word8] -> Word16
forall a b. (a -> b) -> a -> b
$
                                                                   ByteString -> [Word8]
DB.unpack ByteString
gzipheaderextralengthfield
                     }
  ByteString
bgzfblocksubfieldidentifier1field <- do
    ByteString
bgzfblocksubfieldidentifier1fieldp <-
      Int -> Parser ByteString ByteString
DABL.take Int
1
    -- Parse GZip header Subfield Identifier 1 field.
    case ( ( [Word8] -> Word8
word8sToWord8LE ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$
               ByteString -> [Word8]
DB.unpack ByteString
bgzfblocksubfieldidentifier1fieldp
           ) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x42
         ) of
      Bool
False ->
        String -> Parser ByteString ByteString
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString ByteString)
-> String -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$
          BAM_V1_6_Read_Error -> String
forall a. Show a => a -> String
show BAM_V1_6_Read_Error
BAM_V1_6_Read_Error_GZipHeader_Subfield_Identifier_1_Incorrect_Format
      Bool
True  ->
        -- Subfield Identifier 1 is in the accepted format.
        ByteString -> Parser ByteString ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bgzfblocksubfieldidentifier1fieldp
  ByteString
bgzfblocksubfieldidentifier2field <- do
    ByteString
bgzfblocksubfieldidentifier2fieldp <-
      Int -> Parser ByteString ByteString
DABL.take Int
1
    -- Parse GZip header Subfield Identifier 2 field.
    case ( ( [Word8] -> Word8
word8sToWord8LE ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$
               ByteString -> [Word8]
DB.unpack ByteString
bgzfblocksubfieldidentifier2fieldp
           ) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x43
         ) of
      Bool
False ->
        String -> Parser ByteString ByteString
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString ByteString)
-> String -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$
          BAM_V1_6_Read_Error -> String
forall a. Show a => a -> String
show BAM_V1_6_Read_Error
BAM_V1_6_Read_Error_GZipHeader_Subfield_Identifier_2_Incorrect_Format
      Bool
True  ->
        -- Subfield Identifier 2 is in the accepted format.
        ByteString -> Parser ByteString ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bgzfblocksubfieldidentifier2fieldp
  ByteString
bgzfblocksubfieldlengthfield <-
    Int -> Parser ByteString ByteString
DABL.take Int
2
  ByteString
bgzfblocktotalblocksizeminus1field <-
    Int -> Parser ByteString ByteString
DABL.take Int
2
  ByteString
bgzfblockcdata <-
    Int -> Parser ByteString ByteString
DABL.take (Int -> Parser ByteString ByteString)
-> Int -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$
      ( Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral       (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$
          [Word8] -> Word16
word8sToWord16LE ([Word8] -> Word16) -> [Word8] -> Word16
forall a b. (a -> b) -> a -> b
$
            ByteString -> [Word8]
DB.unpack ByteString
bgzfblocktotalblocksizeminus1field
      ) Int -> Int -> Int
forall a. Num a => a -> a -> a
-
      ( Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral       (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$
          BAM_V1_6_GZipHeader -> Word16
bam_v1_6_gzip_header_extra_length BAM_V1_6_GZipHeader
gzipheader
      ) Int -> Int -> Int
forall a. Num a => a -> a -> a
-
      Int
19
  let bgzfblockcdataf :: ByteString
bgzfblockcdataf = ByteString -> ByteString
CCZlibR.decompress (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
                          ByteString -> ByteString
DB.fromStrict ByteString
bgzfblockcdata
  case (Parser BAM_V1_6_BAM -> ByteString -> Either String BAM_V1_6_BAM
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser BAM_V1_6_BAM
parse_BAM_V1_6_BAM ByteString
bgzfblockcdataf) of
    Left String
_                 ->
      String -> Parser BAM_V1_6_BGZFBlock
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser BAM_V1_6_BGZFBlock)
-> String -> Parser BAM_V1_6_BGZFBlock
forall a b. (a -> b) -> a -> b
$
        BAM_V1_6_Read_Error -> String
forall a. Show a => a -> String
show BAM_V1_6_Read_Error
BAM_V1_6_Read_Error_CDATA_Incorrect_Format
    Right BAM_V1_6_BAM
bgzfblockcdataf' -> do
      ByteString
bgzfblockcrc32field <-
        Int -> Parser ByteString ByteString
DABL.take Int
4
      case (ByteString -> Word32
forall a. CRC32 a => a -> Word32
crc32 ByteString
bgzfblockcdataf Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== ( [Word8] -> Word32
word8sToWord32LE ([Word8] -> Word32) -> [Word8] -> Word32
forall a b. (a -> b) -> a -> b
$
                                         ByteString -> [Word8]
DB.unpack ByteString
bgzfblockcrc32field
                                     )
           ) of
        Bool
False ->
          String -> Parser BAM_V1_6_BGZFBlock
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser BAM_V1_6_BGZFBlock)
-> String -> Parser BAM_V1_6_BGZFBlock
forall a b. (a -> b) -> a -> b
$
            BAM_V1_6_Read_Error -> String
forall a. Show a => a -> String
show BAM_V1_6_Read_Error
BAM_V1_6_Read_Error_Calculated_CRC32_Not_Equivalent_To_CRC32
        Bool
True  -> do
          ByteString
bgzfblockisizefield <-
            Int -> Parser ByteString ByteString
DABL.take Int
4
          BAM_V1_6_BGZFBlock -> Parser BAM_V1_6_BGZFBlock
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return BAM_V1_6_BGZFBlock
                   { bam_v1_6_bgzfblock_gzip_header :: BAM_V1_6_GZipHeader
bam_v1_6_bgzfblock_gzip_header                = BAM_V1_6_GZipHeader
gzipheader
                   , bam_v1_6_bgzfblock_subfield_identifier_one :: Word8
bam_v1_6_bgzfblock_subfield_identifier_one    = [Word8] -> Word8
word8sToWord8LE ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$
                                                                       ByteString -> [Word8]
DB.unpack ByteString
bgzfblocksubfieldidentifier1field
                   , bam_v1_6_bgzfblock_subfield_identifier_two :: Word8
bam_v1_6_bgzfblock_subfield_identifier_two    = [Word8] -> Word8
word8sToWord8LE ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$
                                                                       ByteString -> [Word8]
DB.unpack ByteString
bgzfblocksubfieldidentifier2field
                   , bam_v1_6_bgzfblock_subfield_length :: Word16
bam_v1_6_bgzfblock_subfield_length            = [Word8] -> Word16
word8sToWord16LE ([Word8] -> Word16) -> [Word8] -> Word16
forall a b. (a -> b) -> a -> b
$
                                                                       ByteString -> [Word8]
DB.unpack ByteString
bgzfblocksubfieldlengthfield
                   , bam_v1_6_bgzfblock_total_block_size_minus_one :: Word16
bam_v1_6_bgzfblock_total_block_size_minus_one = [Word8] -> Word16
word8sToWord16LE ([Word8] -> Word16) -> [Word8] -> Word16
forall a b. (a -> b) -> a -> b
$
                                                                       ByteString -> [Word8]
DB.unpack ByteString
bgzfblocktotalblocksizeminus1field
                   , bam_v1_6_bgzfblock_cdata :: BAM_V1_6_BAM
bam_v1_6_bgzfblock_cdata                      = BAM_V1_6_BAM
bgzfblockcdataf'
                   , bam_v1_6_bgzfblock_crc32 :: Word32
bam_v1_6_bgzfblock_crc32                      = [Word8] -> Word32
word8sToWord32LE ([Word8] -> Word32) -> [Word8] -> Word32
forall a b. (a -> b) -> a -> b
$
                                                                       ByteString -> [Word8]
DB.unpack ByteString
bgzfblockcrc32field
                   , bam_v1_6_bgzfblock_isize :: Word32
bam_v1_6_bgzfblock_isize                      = [Word8] -> Word32
word8sToWord32LE ([Word8] -> Word32) -> [Word8] -> Word32
forall a b. (a -> b) -> a -> b
$
                                                                       ByteString -> [Word8]
DB.unpack ByteString
bgzfblockisizefield
                   }
  where
    compressionmethodpossiblebytes :: [Word8]
compressionmethodpossiblebytes = [ Word8
Item [Word8]
0x00
                                     , Word8
Item [Word8]
0x01
                                     , Word8
Item [Word8]
0x02
                                     , Word8
Item [Word8]
0x03
                                     , Word8
Item [Word8]
0x04
                                     , Word8
Item [Word8]
0x05
                                     , Word8
Item [Word8]
0x06
                                     , Word8
Item [Word8]
0x07
                                     , Word8
Item [Word8]
0x08
                                     ] :: [Word8]
    flagpossiblebytes :: [Word8]
flagpossiblebytes = [ Word8
Item [Word8]
0x00
                        , Word8
Item [Word8]
0x01
                        , Word8
Item [Word8]
0x02
                        , Word8
Item [Word8]
0x03
                        , Word8
Item [Word8]
0x04
                        , Word8
Item [Word8]
0x05
                        , Word8
Item [Word8]
0x06
                        , Word8
Item [Word8]
0x07
                        ] :: [Word8]
    operatingsystempossiblebytes :: [Word8]
operatingsystempossiblebytes = [ Word8
Item [Word8]
0x00
                                   , Word8
Item [Word8]
0x01
                                   , Word8
Item [Word8]
0x02
                                   , Word8
Item [Word8]
0x03
                                   , Word8
Item [Word8]
0x04
                                   , Word8
Item [Word8]
0x05
                                   , Word8
Item [Word8]
0x06
                                   , Word8
Item [Word8]
0x07
                                   , Word8
Item [Word8]
0x08
                                   , Word8
Item [Word8]
0x09
                                   , Word8
Item [Word8]
0x0A
                                   , Word8
Item [Word8]
0x0B
                                   , Word8
Item [Word8]
0x0C
                                   , Word8
Item [Word8]
0x0D
                                   , Word8
Item [Word8]
0xFF
                                   ] :: [Word8]