{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE StrictData            #-}
{-# LANGUAGE TypeFamilies          #-}

-- |
-- Module      :  Data.BAM.Version1_6.GZipHeader
-- Copyright   :  (c) Matthew Mosior 2024
-- License     :  BSD-style
-- Maintainer  :  mattm.github@gmail.com
-- Portability :  portable
--
-- = Description
--
-- This library enables the decoding/encoding of SAM, BAM and CRAM file formats.

module Data.BAM.Version1_6.GZipHeader ( -- * BAM_V1_6_GZipHeader version 1.6 data type
                                        BAM_V1_6_GZipHeader(..)
                                      ) where

import Data.Data
import Data.Word
import Generics.Deriving.Base

-- | Custom @"BAM_V1_6_GZipHeader"@ (BAM version 1.6) data type.
--
-- See the [SAM v1.6](http://samtools.github.io/hts-specs/SAMv1.pdf) specification documentation.
data BAM_V1_6_GZipHeader = BAM_V1_6_GZipHeader
  { BAM_V1_6_GZipHeader -> Word8
bam_v1_6_gzip_header_gzip_identifier_1   :: Word8  -- ^ Magic number 1f (0x1f).
  , BAM_V1_6_GZipHeader -> Word8
bam_v1_6_gzip_header_gzip_identifier_2   :: Word8  -- ^ Magic number 08 (0x08).
  , BAM_V1_6_GZipHeader -> Word8
bam_v1_6_gzip_header_compression_method  :: Word8  -- ^ Compression method (08 for DEFLATE).
  , BAM_V1_6_GZipHeader -> Word8
bam_v1_6_gzip_header_header_flags        :: Word8  -- ^ 1-byte for header flags.
  , BAM_V1_6_GZipHeader -> Word32
bam_v1_6_gzip_header_modification_time   :: Word32 -- ^ 4-byte timestamp.
  , BAM_V1_6_GZipHeader -> Word8
bam_v1_6_gzip_header_extra_flags         :: Word8  -- ^ 1-byte eXtra FLags.
  , BAM_V1_6_GZipHeader -> Word8
bam_v1_6_gzip_header_operating_system    :: Word8  -- ^ The operating system id.
  , BAM_V1_6_GZipHeader -> Word16
bam_v1_6_gzip_header_extra_length        :: Word16 -- ^ If FLG.FEXTRA is set,
                                                       -- this gives the length of the optional
                                                       -- extra field.
  } deriving ((forall x. BAM_V1_6_GZipHeader -> Rep BAM_V1_6_GZipHeader x)
-> (forall x. Rep BAM_V1_6_GZipHeader x -> BAM_V1_6_GZipHeader)
-> Generic BAM_V1_6_GZipHeader
forall x. Rep BAM_V1_6_GZipHeader x -> BAM_V1_6_GZipHeader
forall x. BAM_V1_6_GZipHeader -> Rep BAM_V1_6_GZipHeader x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BAM_V1_6_GZipHeader -> Rep BAM_V1_6_GZipHeader x
from :: forall x. BAM_V1_6_GZipHeader -> Rep BAM_V1_6_GZipHeader x
$cto :: forall x. Rep BAM_V1_6_GZipHeader x -> BAM_V1_6_GZipHeader
to :: forall x. Rep BAM_V1_6_GZipHeader x -> BAM_V1_6_GZipHeader
Generic,Typeable)

instance Eq BAM_V1_6_GZipHeader where
  BAM_V1_6_GZipHeader Word8
bam_v1_6_gzip_header_gzip_identifier_11
                      Word8
bam_v1_6_gzip_header_gzip_identifier_21
                      Word8
bam_v1_6_gzip_header_compression_method1
                      Word8
bam_v1_6_gzip_header_header_flags1
                      Word32
bam_v1_6_gzip_header_modification_time1
                      Word8
bam_v1_6_gzip_header_extra_flags1
                      Word8
bam_v1_6_gzip_header_operating_system_id1
                      Word16
bam_v1_6_gzip_header_extra_length1 == :: BAM_V1_6_GZipHeader -> BAM_V1_6_GZipHeader -> Bool
==
    BAM_V1_6_GZipHeader Word8
bam_v1_6_gzip_header_gzip_identifier_12
                        Word8
bam_v1_6_gzip_header_gzip_identifier_22
                        Word8
bam_v1_6_gzip_header_compression_method2
                        Word8
bam_v1_6_gzip_header_header_flags2
                        Word32
bam_v1_6_gzip_header_modification_time2
                        Word8
bam_v1_6_gzip_header_extra_flags2
                        Word8
bam_v1_6_gzip_header_operating_system_id2
                        Word16
bam_v1_6_gzip_header_extra_length2 =
      Word8
bam_v1_6_gzip_header_gzip_identifier_11   Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bam_v1_6_gzip_header_gzip_identifier_12   Bool -> Bool -> Bool
&&
      Word8
bam_v1_6_gzip_header_gzip_identifier_21   Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bam_v1_6_gzip_header_gzip_identifier_22   Bool -> Bool -> Bool
&&
      Word8
bam_v1_6_gzip_header_compression_method1  Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bam_v1_6_gzip_header_compression_method2  Bool -> Bool -> Bool
&&
      Word8
bam_v1_6_gzip_header_header_flags1        Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bam_v1_6_gzip_header_header_flags2        Bool -> Bool -> Bool
&&
      Word32
bam_v1_6_gzip_header_modification_time1   Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
bam_v1_6_gzip_header_modification_time2   Bool -> Bool -> Bool
&&
      Word8
bam_v1_6_gzip_header_extra_flags1         Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bam_v1_6_gzip_header_extra_flags2         Bool -> Bool -> Bool
&&
      Word8
bam_v1_6_gzip_header_operating_system_id1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bam_v1_6_gzip_header_operating_system_id2 Bool -> Bool -> Bool
&&
      Word16
bam_v1_6_gzip_header_extra_length1        Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
bam_v1_6_gzip_header_extra_length2

instance Show BAM_V1_6_GZipHeader where
  show :: BAM_V1_6_GZipHeader -> String
show (BAM_V1_6_GZipHeader Word8
gzip_identifier_1
                            Word8
gzip_identifier_2
                            Word8
compression_method
                            Word8
header_flags
                            Word32
modification_time
                            Word8
extra_flags
                            Word8
operating_system_id
                            Word16
extra_length
       ) =
    String
"BAM_V1_6_GZipHeader { "                         String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
"bam_v1_6_gzip_header_gzip_identifier_1 = "      String -> ShowS
forall a. [a] -> [a] -> [a]
++
    (Word8 -> String
forall a. Show a => a -> String
show Word8
gzip_identifier_1)                         String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" , bam_v1_6_gzip_header_gzip_identifier_2 = "   String -> ShowS
forall a. [a] -> [a] -> [a]
++
    (Word8 -> String
forall a. Show a => a -> String
show Word8
gzip_identifier_2)                         String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" , bam_v1_6_gzip_header_compression_method = "  String -> ShowS
forall a. [a] -> [a] -> [a]
++
    (Word8 -> String
forall a. Show a => a -> String
show Word8
compression_method)                        String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" , bam_v1_6_gzip_header_header_flags = "        String -> ShowS
forall a. [a] -> [a] -> [a]
++
    (Word8 -> String
forall a. Show a => a -> String
show Word8
header_flags)                              String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" , bam_v1_6_gzip_header_modification_time = "   String -> ShowS
forall a. [a] -> [a] -> [a]
++
    (Word32 -> String
forall a. Show a => a -> String
show Word32
modification_time)                         String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" , bam_v1_6_gzip_header_extra_flags = "         String -> ShowS
forall a. [a] -> [a] -> [a]
++
    (Word8 -> String
forall a. Show a => a -> String
show Word8
extra_flags)                               String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" , bam_v1_6_gzip_header_operating_system_id = " String -> ShowS
forall a. [a] -> [a] -> [a]
++
    (Word8 -> String
forall a. Show a => a -> String
show Word8
operating_system_id)                       String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" , bam_v1_6_gzip_header_extra_length = "        String -> ShowS
forall a. [a] -> [a] -> [a]
++
    (Word16 -> String
forall a. Show a => a -> String
show Word16
extra_length)                              String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" }"