module Bio.MMTF.Type where

import           Control.DeepSeq (NFData (..))
import           Data.Int        (Int32, Int8)
import           Data.Text       (Text)
import           Data.Vector     (Vector)
import           GHC.Generics    (Generic)

import           Bio.Structure   (SecondaryStructure)

-- | Transformation matrix
--
data M44 = M44 Float Float Float Float
               Float Float Float Float
               Float Float Float Float
               Float Float Float Float
  deriving (Int -> M44 -> ShowS
[M44] -> ShowS
M44 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [M44] -> ShowS
$cshowList :: [M44] -> ShowS
show :: M44 -> String
$cshow :: M44 -> String
showsPrec :: Int -> M44 -> ShowS
$cshowsPrec :: Int -> M44 -> ShowS
Show, M44 -> M44 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: M44 -> M44 -> Bool
$c/= :: M44 -> M44 -> Bool
== :: M44 -> M44 -> Bool
$c== :: M44 -> M44 -> Bool
Eq, forall x. Rep M44 x -> M44
forall x. M44 -> Rep M44 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep M44 x -> M44
$cfrom :: forall x. M44 -> Rep M44 x
Generic, M44 -> ()
forall a. (a -> ()) -> NFData a
rnf :: M44 -> ()
$crnf :: M44 -> ()
NFData)

-- | Unit cell data
--
data UnitCell = UnitCell { UnitCell -> Float
ucA     :: !Float -- ^ length of side 'a'
                         , UnitCell -> Float
ucB     :: !Float -- ^ length of side 'b'
                         , UnitCell -> Float
ucC     :: !Float -- ^ length of side 'c'
                         , UnitCell -> Float
ucAlpha :: !Float -- ^ alpha angle in degrees
                         , UnitCell -> Float
ucBeta  :: !Float -- ^ beta angle in degrees
                         , UnitCell -> Float
ucGamma :: !Float -- ^ gamma angle in degrees
                         }
  deriving (Int -> UnitCell -> ShowS
[UnitCell] -> ShowS
UnitCell -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnitCell] -> ShowS
$cshowList :: [UnitCell] -> ShowS
show :: UnitCell -> String
$cshow :: UnitCell -> String
showsPrec :: Int -> UnitCell -> ShowS
$cshowsPrec :: Int -> UnitCell -> ShowS
Show, UnitCell -> UnitCell -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnitCell -> UnitCell -> Bool
$c/= :: UnitCell -> UnitCell -> Bool
== :: UnitCell -> UnitCell -> Bool
$c== :: UnitCell -> UnitCell -> Bool
Eq, forall x. Rep UnitCell x -> UnitCell
forall x. UnitCell -> Rep UnitCell x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnitCell x -> UnitCell
$cfrom :: forall x. UnitCell -> Rep UnitCell x
Generic, UnitCell -> ()
forall a. (a -> ()) -> NFData a
rnf :: UnitCell -> ()
$crnf :: UnitCell -> ()
NFData)

-- | Transform data
--
data Transform = Transform { Transform -> Vector Int32
chainIndexList :: !(Vector Int32) -- ^ indices into the 'chainIdList' and 'chainNameList' fields
                           , Transform -> M44
matrix         :: !M44            -- ^ 4x4 transformation matrix
                           }
  deriving (Int -> Transform -> ShowS
[Transform] -> ShowS
Transform -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transform] -> ShowS
$cshowList :: [Transform] -> ShowS
show :: Transform -> String
$cshow :: Transform -> String
showsPrec :: Int -> Transform -> ShowS
$cshowsPrec :: Int -> Transform -> ShowS
Show, Transform -> Transform -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transform -> Transform -> Bool
$c/= :: Transform -> Transform -> Bool
== :: Transform -> Transform -> Bool
$c== :: Transform -> Transform -> Bool
Eq, forall x. Rep Transform x -> Transform
forall x. Transform -> Rep Transform x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Transform x -> Transform
$cfrom :: forall x. Transform -> Rep Transform x
Generic, Transform -> ()
forall a. (a -> ()) -> NFData a
rnf :: Transform -> ()
$crnf :: Transform -> ()
NFData)

-- | Assembly data
--
data Assembly = Assembly { Assembly -> Vector Transform
transformList :: !(Vector Transform) -- ^ List of transform objects
                         , Assembly -> Text
assemblyName  :: !Text               -- ^ Name of the biological assembly
                         }
  deriving (Int -> Assembly -> ShowS
[Assembly] -> ShowS
Assembly -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Assembly] -> ShowS
$cshowList :: [Assembly] -> ShowS
show :: Assembly -> String
$cshow :: Assembly -> String
showsPrec :: Int -> Assembly -> ShowS
$cshowsPrec :: Int -> Assembly -> ShowS
Show, Assembly -> Assembly -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assembly -> Assembly -> Bool
$c/= :: Assembly -> Assembly -> Bool
== :: Assembly -> Assembly -> Bool
$c== :: Assembly -> Assembly -> Bool
Eq, forall x. Rep Assembly x -> Assembly
forall x. Assembly -> Rep Assembly x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Assembly x -> Assembly
$cfrom :: forall x. Assembly -> Rep Assembly x
Generic, Assembly -> ()
forall a. (a -> ()) -> NFData a
rnf :: Assembly -> ()
$crnf :: Assembly -> ()
NFData)

-- | Entity data
--
data Entity = Entity { Entity -> Vector Int32
entityChainIndexList :: !(Vector Int32) -- ^ indices into the 'chainIdList' and 'chainNameList' fields
                     , Entity -> Text
entityDescription    :: !Text           -- ^ Description of the entity
                     , Entity -> Text
entityType           :: !Text           -- ^ Name of the entity type
                     , Entity -> Text
entitySequence       :: !Text           -- ^ Sequence of the full construct in one-letter-code
                     }
  deriving (Int -> Entity -> ShowS
[Entity] -> ShowS
Entity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entity] -> ShowS
$cshowList :: [Entity] -> ShowS
show :: Entity -> String
$cshow :: Entity -> String
showsPrec :: Int -> Entity -> ShowS
$cshowsPrec :: Int -> Entity -> ShowS
Show, Entity -> Entity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entity -> Entity -> Bool
$c/= :: Entity -> Entity -> Bool
== :: Entity -> Entity -> Bool
$c== :: Entity -> Entity -> Bool
Eq, forall x. Rep Entity x -> Entity
forall x. Entity -> Rep Entity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Entity x -> Entity
$cfrom :: forall x. Entity -> Rep Entity x
Generic, Entity -> ()
forall a. (a -> ()) -> NFData a
rnf :: Entity -> ()
$crnf :: Entity -> ()
NFData)

-- | Group type data
--
data GroupType = GroupType { GroupType -> Vector Int32
gtFormalChargeList :: !(Vector Int32)          -- ^ List of formal charges
                           , GroupType -> Vector Text
gtAtomNameList     :: !(Vector Text)           -- ^ List of atom names
                           , GroupType -> Vector Text
gtElementList      :: !(Vector Text)           -- ^ List of elements
                           , GroupType -> Vector (Int32, Int32)
gtBondAtomList     :: !(Vector (Int32, Int32)) -- ^ List of bonded atom indices
                           , GroupType -> Vector Int32
gtBondOrderList    :: !(Vector Int32)          -- ^ List of bond orders
                           , GroupType -> Text
gtGroupName        :: !Text                    -- ^ The name of the group
                           , GroupType -> Char
gtSingleLetterCode :: !Char                    -- ^ The single letter code
                           , GroupType -> Text
gtChemCompType     :: !Text                    -- ^ The chemical component type
                           }
  deriving (Int -> GroupType -> ShowS
[GroupType] -> ShowS
GroupType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupType] -> ShowS
$cshowList :: [GroupType] -> ShowS
show :: GroupType -> String
$cshow :: GroupType -> String
showsPrec :: Int -> GroupType -> ShowS
$cshowsPrec :: Int -> GroupType -> ShowS
Show, GroupType -> GroupType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupType -> GroupType -> Bool
$c/= :: GroupType -> GroupType -> Bool
== :: GroupType -> GroupType -> Bool
$c== :: GroupType -> GroupType -> Bool
Eq, forall x. Rep GroupType x -> GroupType
forall x. GroupType -> Rep GroupType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GroupType x -> GroupType
$cfrom :: forall x. GroupType -> Rep GroupType x
Generic, GroupType -> ()
forall a. (a -> ()) -> NFData a
rnf :: GroupType -> ()
$crnf :: GroupType -> ()
NFData)

-- | MMTF format data
--
data FormatData = FormatData { FormatData -> Text
mmtfVersion  :: !Text -- ^ The version number of the specification the file adheres to
                             , FormatData -> Text
mmtfProducer :: !Text -- ^ The name and version of the software used to produce the file
                             }
  deriving (Int -> FormatData -> ShowS
[FormatData] -> ShowS
FormatData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormatData] -> ShowS
$cshowList :: [FormatData] -> ShowS
show :: FormatData -> String
$cshow :: FormatData -> String
showsPrec :: Int -> FormatData -> ShowS
$cshowsPrec :: Int -> FormatData -> ShowS
Show, FormatData -> FormatData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatData -> FormatData -> Bool
$c/= :: FormatData -> FormatData -> Bool
== :: FormatData -> FormatData -> Bool
$c== :: FormatData -> FormatData -> Bool
Eq, forall x. Rep FormatData x -> FormatData
forall x. FormatData -> Rep FormatData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FormatData x -> FormatData
$cfrom :: forall x. FormatData -> Rep FormatData x
Generic, FormatData -> ()
forall a. (a -> ()) -> NFData a
rnf :: FormatData -> ()
$crnf :: FormatData -> ()
NFData)

-- | Structure data
--
data StructureData = StructureData { StructureData -> Text
title               :: !Text                    -- ^ A short description of the structural data included in the file
                                   , StructureData -> Text
structureId         :: !Text                    -- ^ An ID for the structure, for example the PDB ID if applicable
                                   , StructureData -> Text
depositionDate      :: !Text                    -- ^ A date that relates to the deposition of the structure in a database
                                   , StructureData -> Text
releaseDate         :: !Text                    -- ^ A date that relates to the release of the structure in a database
                                   , StructureData -> Int32
numBonds            :: !Int32                   -- ^ The overall number of bonds
                                   , StructureData -> Int32
numAtoms            :: !Int32                   -- ^ The overall number of atoms in the structure
                                   , StructureData -> Int32
numGroups           :: !Int32                   -- ^ The overall number of groups in the structure
                                   , StructureData -> Int32
numChains           :: !Int32                   -- ^ The overall number of chains in the structure
                                   , StructureData -> Int32
numModels           :: !Int32                   -- ^ The overall number of models in the structure
                                   , StructureData -> Text
spaceGroup          :: !Text                    -- ^ The Hermann-Mauguin space-group symbol
                                   , StructureData -> Maybe UnitCell
unitCell            :: !(Maybe UnitCell)        -- ^ Array of six values defining the unit cell
                                   , StructureData -> Vector M44
ncsOperatorList     :: !(Vector M44)            -- ^ List of 4x4 transformation matrices (transformation matrices describe noncrystallographic symmetry operations needed to create all molecules in the unit cell)
                                   , StructureData -> Vector Assembly
bioAssemblyList     :: !(Vector Assembly)       -- ^ List of instructions on how to transform coordinates for an array of chains to create (biological) assemblies
                                   , StructureData -> Vector Entity
entityList          :: !(Vector Entity)         -- ^ List of unique molecular entities within the structure
                                   , StructureData -> Maybe Float
resolution          :: !(Maybe Float)           -- ^ The experimental resolution in Angstrom
                                   , StructureData -> Maybe Float
rFree               :: !(Maybe Float)           -- ^ The R-free value
                                   , StructureData -> Maybe Float
rWork               :: !(Maybe Float)           -- ^ The R-work value
                                   , StructureData -> Vector Text
experimentalMethods :: !(Vector Text)           -- ^ List of experimental methods employed for structure determination
                                   , StructureData -> Vector (Int32, Int32)
bondAtomList        :: !(Vector (Int32, Int32)) -- ^ Pairs of values represent indices of covalently bonded atoms [binary (type 4)]
                                   , StructureData -> Vector Int8
bondOrderList       :: !(Vector Int8)           -- ^ List of bond orders for bonds in 'bondAtomList' [binary (type 2)]
                                   }
  deriving (Int -> StructureData -> ShowS
[StructureData] -> ShowS
StructureData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StructureData] -> ShowS
$cshowList :: [StructureData] -> ShowS
show :: StructureData -> String
$cshow :: StructureData -> String
showsPrec :: Int -> StructureData -> ShowS
$cshowsPrec :: Int -> StructureData -> ShowS
Show, StructureData -> StructureData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StructureData -> StructureData -> Bool
$c/= :: StructureData -> StructureData -> Bool
== :: StructureData -> StructureData -> Bool
$c== :: StructureData -> StructureData -> Bool
Eq, forall x. Rep StructureData x -> StructureData
forall x. StructureData -> Rep StructureData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StructureData x -> StructureData
$cfrom :: forall x. StructureData -> Rep StructureData x
Generic, StructureData -> ()
forall a. (a -> ()) -> NFData a
rnf :: StructureData -> ()
$crnf :: StructureData -> ()
NFData)

-- | Models data
--
data ModelData = ModelData { ModelData -> Vector Int32
chainsPerModel :: !(Vector Int32) -- ^ List of the number of chains in each model
                           }
  deriving (Int -> ModelData -> ShowS
[ModelData] -> ShowS
ModelData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelData] -> ShowS
$cshowList :: [ModelData] -> ShowS
show :: ModelData -> String
$cshow :: ModelData -> String
showsPrec :: Int -> ModelData -> ShowS
$cshowsPrec :: Int -> ModelData -> ShowS
Show, ModelData -> ModelData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelData -> ModelData -> Bool
$c/= :: ModelData -> ModelData -> Bool
== :: ModelData -> ModelData -> Bool
$c== :: ModelData -> ModelData -> Bool
Eq, forall x. Rep ModelData x -> ModelData
forall x. ModelData -> Rep ModelData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModelData x -> ModelData
$cfrom :: forall x. ModelData -> Rep ModelData x
Generic, ModelData -> ()
forall a. (a -> ()) -> NFData a
rnf :: ModelData -> ()
$crnf :: ModelData -> ()
NFData)

-- | Chains data
--
data ChainData = ChainData { ChainData -> Vector Int32
groupsPerChain :: !(Vector Int32)       -- ^ List of the number of groups (aka residues) in each chain
                           , ChainData -> Vector Text
chainIdList    :: !(Vector Text)        -- ^ List of chain IDs [binary (type 5)]
                           , ChainData -> Vector Text
chainNameList  :: !(Vector Text)        -- ^ List of chain names [binary (type 5)]
                           }
  deriving (Int -> ChainData -> ShowS
[ChainData] -> ShowS
ChainData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainData] -> ShowS
$cshowList :: [ChainData] -> ShowS
show :: ChainData -> String
$cshow :: ChainData -> String
showsPrec :: Int -> ChainData -> ShowS
$cshowsPrec :: Int -> ChainData -> ShowS
Show, ChainData -> ChainData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainData -> ChainData -> Bool
$c/= :: ChainData -> ChainData -> Bool
== :: ChainData -> ChainData -> Bool
$c== :: ChainData -> ChainData -> Bool
Eq, forall x. Rep ChainData x -> ChainData
forall x. ChainData -> Rep ChainData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChainData x -> ChainData
$cfrom :: forall x. ChainData -> Rep ChainData x
Generic, ChainData -> ()
forall a. (a -> ()) -> NFData a
rnf :: ChainData -> ()
$crnf :: ChainData -> ()
NFData)

-- | Groups data
--
data GroupData = GroupData { GroupData -> Vector GroupType
groupList         :: !(Vector GroupType)              -- ^ List of groupType objects
                           , GroupData -> Vector Int32
groupTypeList     :: !(Vector Int32)                  -- ^ List of pointers to 'groupType' entries in 'groupList' by their keys [binary (type 4)]
                           , GroupData -> Vector Int32
groupIdList       :: !(Vector Int32)                  -- ^ List of group (residue) numbers [binary (type 8)]
                           , GroupData -> Vector SecondaryStructure
secStructList     :: !(Vector SecondaryStructure)     -- ^ List of secondary structure assignments [binary (type 2)]
                           , GroupData -> Vector Text
insCodeList       :: !(Vector Text)                   -- ^ List of insertion codes, one for each group (residue) [binary (type 6)]
                           , GroupData -> Vector Int32
sequenceIndexList :: !(Vector Int32)                  -- ^ List of indices that point into the sequence property of an entity object in the 'entityList' field that is associated with the chain the group belongs to [binary (type 8)]
                           }
  deriving (Int -> GroupData -> ShowS
[GroupData] -> ShowS
GroupData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupData] -> ShowS
$cshowList :: [GroupData] -> ShowS
show :: GroupData -> String
$cshow :: GroupData -> String
showsPrec :: Int -> GroupData -> ShowS
$cshowsPrec :: Int -> GroupData -> ShowS
Show, GroupData -> GroupData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupData -> GroupData -> Bool
$c/= :: GroupData -> GroupData -> Bool
== :: GroupData -> GroupData -> Bool
$c== :: GroupData -> GroupData -> Bool
Eq, forall x. Rep GroupData x -> GroupData
forall x. GroupData -> Rep GroupData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GroupData x -> GroupData
$cfrom :: forall x. GroupData -> Rep GroupData x
Generic, GroupData -> ()
forall a. (a -> ()) -> NFData a
rnf :: GroupData -> ()
$crnf :: GroupData -> ()
NFData)

-- | Atoms data
--
data AtomData = AtomData { AtomData -> Vector Int32
atomIdList    :: !(Vector Int32)        -- ^ List of atom serial numbers [binary (type 8)]
                         , AtomData -> Vector Text
altLocList    :: !(Vector Text)         -- ^ List of alternate location labels, one for each atom [binary (type 6)]
                         , AtomData -> Vector Float
bFactorList   :: !(Vector Float)        -- ^ List of atom B-factors in in A^2, one for each atom [binary (type 10)]
                         , AtomData -> Vector Float
xCoordList    :: !(Vector Float)        -- ^ List of x atom coordinates in A, one for each atom [binary (type 10)]
                         , AtomData -> Vector Float
yCoordList    :: !(Vector Float)        -- ^ List of y atom coordinates in A, one for each atom [binary (type 10)]
                         , AtomData -> Vector Float
zCoordList    :: !(Vector Float)        -- ^ List of z atom coordinates in A, one for each atom [binary (type 10)]
                         , AtomData -> Vector Float
occupancyList :: !(Vector Float)        -- ^ List of atom occupancies, one for each atom [binary (type 9)]
                         }
  deriving (Int -> AtomData -> ShowS
[AtomData] -> ShowS
AtomData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AtomData] -> ShowS
$cshowList :: [AtomData] -> ShowS
show :: AtomData -> String
$cshow :: AtomData -> String
showsPrec :: Int -> AtomData -> ShowS
$cshowsPrec :: Int -> AtomData -> ShowS
Show, AtomData -> AtomData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AtomData -> AtomData -> Bool
$c/= :: AtomData -> AtomData -> Bool
== :: AtomData -> AtomData -> Bool
$c== :: AtomData -> AtomData -> Bool
Eq, forall x. Rep AtomData x -> AtomData
forall x. AtomData -> Rep AtomData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AtomData x -> AtomData
$cfrom :: forall x. AtomData -> Rep AtomData x
Generic, AtomData -> ()
forall a. (a -> ()) -> NFData a
rnf :: AtomData -> ()
$crnf :: AtomData -> ()
NFData)

-- | MMTF datatype
--
data MMTF = MMTF { MMTF -> FormatData
format    :: !FormatData    -- ^ MMTF format data
                 , MMTF -> StructureData
structure :: !StructureData -- ^ Biological structure data
                 , MMTF -> ModelData
model     :: !ModelData     -- ^ Models data
                 , MMTF -> ChainData
chain     :: !ChainData     -- ^ Chains data
                 , MMTF -> GroupData
group     :: !GroupData     -- ^ Groups data
                 , MMTF -> AtomData
atom      :: !AtomData      -- ^ Atoms data
                 }
  deriving (Int -> MMTF -> ShowS
[MMTF] -> ShowS
MMTF -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MMTF] -> ShowS
$cshowList :: [MMTF] -> ShowS
show :: MMTF -> String
$cshow :: MMTF -> String
showsPrec :: Int -> MMTF -> ShowS
$cshowsPrec :: Int -> MMTF -> ShowS
Show, MMTF -> MMTF -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MMTF -> MMTF -> Bool
$c/= :: MMTF -> MMTF -> Bool
== :: MMTF -> MMTF -> Bool
$c== :: MMTF -> MMTF -> Bool
Eq, forall x. Rep MMTF x -> MMTF
forall x. MMTF -> Rep MMTF x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MMTF x -> MMTF
$cfrom :: forall x. MMTF -> Rep MMTF x
Generic, MMTF -> ()
forall a. (a -> ()) -> NFData a
rnf :: MMTF -> ()
$crnf :: MMTF -> ()
NFData)