-- | This module contains datatype declaration for PDB parsing
-- events generated by 'PDBEventParser' module.
module Bio.PDB.EventParser.PDBEvents(
  String,Vector3(..),ATID(..),RESID(..),PDBEvent(..),
  StrandSenseT(..),HelixT(..),ExpMethod(..))
where

import Prelude hiding (String)
import qualified Data.ByteString.Char8 as BS

import Bio.PDB.EventParser.ExperimentalMethods
import Bio.PDB.EventParser.HelixTypes
import Bio.PDB.EventParser.StrandSense 

import Bio.PDB.Common(String,Vector3(..))

-- | Atom id: atom name, residue name, chain, residue id, residue insertion code
newtype ATID = ATID (String, String, Char, Int, Char)
  deriving(Show, Ord, Eq)

-- | Residue id: residue name, chain, residue id, residue insertion code
newtype RESID = RESID (String, Char, Int, Char)
  deriving(Show, Ord, Eq)

-- | Datatype for event-based PDB parser
data PDBEvent = ATOM { no        :: !Int,
                       atomtype  :: !String,
                       restype   :: !String,
                       chain     :: !Char,
                       resid     :: !Int,
                       resins    :: !Char,
                       altloc    :: !Char,
                       coords    :: !Vector3,
                       occupancy :: !Double,
                       bfactor   :: !Double,
                       segid     :: !String,
                       elt       :: !String,
                       charge    :: !String, -- why not a number?
                       hetatm    :: !Bool
                     }                                  |
                SIGATM { no        :: !Int,
                         atomtype  :: !String,
                         restype   :: !String,
                         chain     :: !Char,
                         resid     :: !Int,
                         resins    :: !Char,
                         altloc    :: !Char,
                         coords    :: !Vector3,
                         occupancy :: !Double,
                         bfactor   :: !Double,
                         segid     :: !String,
                         elt       :: !String,
                         charge    :: !String -- why not a number?
                       }                                  |
                 ANISOU { no        :: !Int,
                          atomtype  :: !String,
                          restype   :: !String,
                          chain     :: !Char,
                          resid     :: !Int,
                          resins    :: !Char,
                          altloc    :: !Char,
                          u_1_1     :: !Int,
                          u_2_2     :: !Int,
                          u_3_3     :: !Int,
                          u_1_2     :: !Int,
                          u_1_3     :: !Int,
                          u_2_3     :: !Int,
                          segid     :: !String,
                          elt       :: !String,
                          charge    :: !String
                        }                                  |
                 SIGUIJ { no        :: !Int,
                          atomtype  :: !String,
                          restype   :: !String,
                          chain     :: !Char,
                          resid     :: !Int,
                          resins    :: !Char,
                          altloc    :: !Char,
                          u_1_1     :: !Int,
                          u_2_2     :: !Int,
                          u_3_3     :: !Int,
                          u_1_2     :: !Int,
                          u_1_3     :: !Int,
                          u_2_3     :: !Int,
                          segid     :: !String,
                          elt       :: !String,
                          charge    :: !String
                        }                                  |
                SEQRES { serial  :: !Int,
                         chain   :: !Char,
                         num     :: !Int,
                         resList :: ![String] }         |
                HEADER { classification :: !String,
                         depDate        :: !String,
                         idCode         :: !String }    |
                TITLE { continuation   :: !Int,
                        title          :: !String    }    |
                KEYWDS { continuation  :: !Int,
                         aList         :: ![String] }    |
                AUTHOR { continuation  :: !Int,
                         aList         :: ![String] }    |
                REMARK { num           :: !Int,
                         text          :: ![String] }    |
                EXPDTA { continuation  :: !Int,
                         expMethods    :: ![ExpMethod] } |
                MDLTYP { continuation  :: !Int,
                         aList         :: ![String] }    |
                NUMMDL { num           :: !Int  }        |
                MODEL  { num           :: !Int  }        |
                CONECT { atoms         :: ![Int] }       |
                CAVEAT { cont          :: !Int,
                         pdbid         :: !String,
                         comment       :: !String  }     |
                DBREF  { idCode        :: !String,
                         chain         :: !Char,
                         iniSeqNumPDB  :: !Int,
                         iniInsCodePDB :: !Char,
                         endSeqNumPDB  :: !Int,
                         endInsCodePDB :: !Char,
                         seqDbName     :: !String,
                         seqDbAccCode  :: !String,
                         seqDbIdCode   :: !String,
                         iniSeqNumInDb :: !Int,
                         iniInsCodeInPDBRef :: !Char,
                         endSeqNumInDb      :: !Int,
                         endInsCodeInPDBRef :: !Char } |
                REVDAT { modNum  :: !Int,
                         cont    :: !Int,
                         modDat  :: !String,
                         modId   :: !String,
                         modTyp  :: !Int,
                         details :: ![String] }         |
                HETNAM { cont       :: !Int,
                         hetId      :: !String,
                         name       :: !String,
                         notSynonym :: !Bool }          | 
                HET    { hetId       :: !String,
                         chain       :: !Char,
                         seqNum      :: !Int,
                         insCode     :: !Char,
                         atmNum      :: !Int,
                         description :: !String }       |
                FORMUL { compNum     :: !Int,
                         hetId       :: !String,
                         cont        :: !Int,
                         isWater     :: !Bool,
                         formula     :: ![String] }     |
                CISPEP { serial      :: !Int,
                         res1        :: !RESID,
                         res2        :: !RESID,
                         modNum      :: !Int,
                         angle       :: Maybe Double }  |
                HELIX  { serial     :: Int,
                         iniRes     :: RESID,
                         endRes     :: RESID,
                         helixClass :: HelixT,
                         comment    :: String,
                         len        :: Int     }        |
                SHEET  { strandId    :: Int,
                         sheetId     :: String,
                         numStrands  :: Int,
                         sense       :: Maybe StrandSenseT, 
                         
                         iniRes      :: RESID,
                         endRes      :: RESID,

                         curAt      :: Maybe ATID,
                         prevAt     :: Maybe ATID  }    |
                ORIGXn { n       :: Int,
                         o       :: [Vector3],
                         t       :: [Double]  }          | 
                SCALEn { n       :: Int,
                         o       :: [Vector3],
                         t       :: [Double]  }          | 
                MTRIXn { serial  :: !Int,
                         relMol  :: !Bool,
                         n       :: !Int,
                         o       :: ![Vector3],
                         t       :: ![Double]  }         | 
                CRYST1 { a       :: !Double,
                         b       :: !Double,
                         c       :: !Double,
                         alpha   :: !Double,
                         beta    :: !Double,
                         gamma   :: !Double,
                         spcGrp  :: !String,
                         zValue  :: !Int     }          | 
                COMPND { cont    :: !Int,
                         tokens  :: ![(String, String)]} |
                SOURCE { cont    :: !Int,
                         tokens  :: ![(String, String)]} |
                TER    { num     :: !Int,
                         resname :: !String,
                         chain   :: !Char,
                         resid   :: !Int,
                         insCode :: !Char }             |
                MASTER { numRemark :: !Int,
                         numHet    :: !Int,
                         numHelix  :: !Int,
                         numSheet  :: !Int,
                         numTurn   :: !Int,
                         numSite   :: !Int,
                         numXform  :: !Int,
                         numAts    :: !Int,
                         numMaster :: !Int,
                         numConect :: !Int,
                         numSeqres :: !Int  }        |
                END                                     |
                ENDMDL                                  |
                SITE   { serial   :: !Int,
                         siteid   :: !String,
                         numres   :: !Int,
                         residues :: ![RESID] }         |
                OBSLTE { cont    :: !Int,
                         date    :: !String,
                         this    :: !String,
                         entries :: ![String] }         |
                SPRSDE { cont    :: !Int,
                         date    :: !String,
                         this    :: !String,
                         entries :: ![String] }         |
                SPLIT  { cont    :: !Int,
                         codes   :: ![String] }         |
                SSBOND { serial  :: !Int,
                         res1    :: RESID,
                         res2    :: RESID,
                         symOp1  :: !String,
                         symOp2  :: !String,
                         bondLen :: !Double }            |
                LINK   { at1      :: !ATID,
                         altloc1  :: !Char,
                         at2      :: !ATID,
                         altloc2  :: !Char,
                         symop1   :: !String,
                         symop2   :: !String,
                         linkdist :: Maybe Double }      |
                SLTBRG { at1      :: !ATID,
                         altloc1  :: !Char,
                         at2      :: !ATID,
                         altloc2  :: !Char,
                         symOp1   :: !String,
                         symOp2   :: !String }          |
                HYDBND { at1      :: !ATID,
                         altloc1  :: !Char,
                         atH      :: !ATID,
                         altlocH  :: !Char,
                         at2      :: !ATID,
                         altloc2  :: !Char,
                         symOp1   :: !String,
                         symOp2   :: !String }          |
                TVECT  { serial  :: !Int,
                         vec     :: Vector3 }             |
                JRNL   { cont    :: !Int,
                         content :: ![(String, String)],
                         isFirst :: !Bool }             |
                MODRES { pdbCode :: !String,
                         residue :: !RESID,
                         stdRes  :: !String,
                         comment :: !String }           |
                SEQADV { pdbId         :: !String,
                         advResidue    :: Maybe RESID,
                         database      :: !String,
                         accessionCode :: !String,
                         dbResname     :: !String,
                         dbSeqNum      :: Maybe Int,
                         comment       :: !String }     |
  -- Errors
                PDBParseError !Int !Int !String         |
                PDBIgnoredLine BS.ByteString
  deriving (Show, Eq)