module Bio.PDB.Type where

import           Control.DeepSeq (NFData (..))
import           Data.Map.Strict (Map)
import           Data.Text       (Text)
import           Data.Vector     (Vector)
import           GHC.Generics    (Generic)

-- * Read PDB specification [here](http://www.wwpdb.org/documentation/file-format-content/format33/v3.3.html).

data PDB = PDB { PDB -> Text
title       :: Text
               , PDB -> Vector Model
models      :: Vector Model
               , PDB -> Map RemarkCode RemarkData
remarks     :: Map RemarkCode RemarkData
               , PDB -> Map FieldType RemarkData
otherFields :: Map FieldType FieldData
               }
  deriving (Int -> PDB -> ShowS
[PDB] -> ShowS
PDB -> String
(Int -> PDB -> ShowS)
-> (PDB -> String) -> ([PDB] -> ShowS) -> Show PDB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDB] -> ShowS
$cshowList :: [PDB] -> ShowS
show :: PDB -> String
$cshow :: PDB -> String
showsPrec :: Int -> PDB -> ShowS
$cshowsPrec :: Int -> PDB -> ShowS
Show, PDB -> PDB -> Bool
(PDB -> PDB -> Bool) -> (PDB -> PDB -> Bool) -> Eq PDB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDB -> PDB -> Bool
$c/= :: PDB -> PDB -> Bool
== :: PDB -> PDB -> Bool
$c== :: PDB -> PDB -> Bool
Eq, (forall x. PDB -> Rep PDB x)
-> (forall x. Rep PDB x -> PDB) -> Generic PDB
forall x. Rep PDB x -> PDB
forall x. PDB -> Rep PDB x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PDB x -> PDB
$cfrom :: forall x. PDB -> Rep PDB x
Generic, PDB -> ()
(PDB -> ()) -> NFData PDB
forall a. (a -> ()) -> NFData a
rnf :: PDB -> ()
$crnf :: PDB -> ()
NFData)

type RemarkCode = Maybe Int
type RemarkData = Vector Text

type FieldData = Vector Text
data FieldType
   =
   -- Title Section (except TITLE and REMARKS)
     HEADER
   | OBSLTE
   | SPLIT
   | CAVEAT
   | COMPND
   | SOURCE
   | KEYWDS
   | EXPDTA
   | NUMMDL
   | MDLTYP
   | AUTHOR
   | REVDAT
   | SPRSDE
   | JRNL
   -- Primary Structure Section
   | DBREF
   | DBREF1
   | DBREF2
   | SEQADV
   | SEQRES
   | MODRES
   -- Heterogen Section
   | HET
   | FORMUL
   | HETNAM
   | HETSYN
   -- Secondary Structure Section
   | HELIX
   | SHEET
   -- Connectivity Annotation Section
   | SSBOND
   | LINK
   | CISPEP
   -- Miscellaneous Features Section
   | SITE
   -- Crystallographic and Coordinate Transformation Section
   | CRYST1
   | MTRIX1
   | MTRIX2
   | MTRIX3
   | ORIGX1
   | ORIGX2
   | ORIGX3
   | SCALE1
   | SCALE2
   | SCALE3
   -- Bookkeeping Section
   | MASTER
  deriving (Int -> FieldType -> ShowS
[FieldType] -> ShowS
FieldType -> String
(Int -> FieldType -> ShowS)
-> (FieldType -> String)
-> ([FieldType] -> ShowS)
-> Show FieldType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldType] -> ShowS
$cshowList :: [FieldType] -> ShowS
show :: FieldType -> String
$cshow :: FieldType -> String
showsPrec :: Int -> FieldType -> ShowS
$cshowsPrec :: Int -> FieldType -> ShowS
Show, FieldType -> FieldType -> Bool
(FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool) -> Eq FieldType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldType -> FieldType -> Bool
$c/= :: FieldType -> FieldType -> Bool
== :: FieldType -> FieldType -> Bool
$c== :: FieldType -> FieldType -> Bool
Eq, ReadPrec [FieldType]
ReadPrec FieldType
Int -> ReadS FieldType
ReadS [FieldType]
(Int -> ReadS FieldType)
-> ReadS [FieldType]
-> ReadPrec FieldType
-> ReadPrec [FieldType]
-> Read FieldType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FieldType]
$creadListPrec :: ReadPrec [FieldType]
readPrec :: ReadPrec FieldType
$creadPrec :: ReadPrec FieldType
readList :: ReadS [FieldType]
$creadList :: ReadS [FieldType]
readsPrec :: Int -> ReadS FieldType
$creadsPrec :: Int -> ReadS FieldType
Read, (forall x. FieldType -> Rep FieldType x)
-> (forall x. Rep FieldType x -> FieldType) -> Generic FieldType
forall x. Rep FieldType x -> FieldType
forall x. FieldType -> Rep FieldType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FieldType x -> FieldType
$cfrom :: forall x. FieldType -> Rep FieldType x
Generic, FieldType -> ()
(FieldType -> ()) -> NFData FieldType
forall a. (a -> ()) -> NFData a
rnf :: FieldType -> ()
$crnf :: FieldType -> ()
NFData, Eq FieldType
Eq FieldType
-> (FieldType -> FieldType -> Ordering)
-> (FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> FieldType)
-> (FieldType -> FieldType -> FieldType)
-> Ord FieldType
FieldType -> FieldType -> Bool
FieldType -> FieldType -> Ordering
FieldType -> FieldType -> FieldType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldType -> FieldType -> FieldType
$cmin :: FieldType -> FieldType -> FieldType
max :: FieldType -> FieldType -> FieldType
$cmax :: FieldType -> FieldType -> FieldType
>= :: FieldType -> FieldType -> Bool
$c>= :: FieldType -> FieldType -> Bool
> :: FieldType -> FieldType -> Bool
$c> :: FieldType -> FieldType -> Bool
<= :: FieldType -> FieldType -> Bool
$c<= :: FieldType -> FieldType -> Bool
< :: FieldType -> FieldType -> Bool
$c< :: FieldType -> FieldType -> Bool
compare :: FieldType -> FieldType -> Ordering
$ccompare :: FieldType -> FieldType -> Ordering
$cp1Ord :: Eq FieldType
Ord)

type Model = Vector Chain

type Chain = Vector Atom

data Atom = Atom { Atom -> Int
atomSerial     :: Int     -- ^ Atom serial number.
                 , Atom -> Text
atomName       :: Text    -- ^ Atom name.
                 , Atom -> Char
atomAltLoc     :: Char    -- ^ Alternate location indicator.
                 , Atom -> Text
atomResName    :: Text    -- ^ Residue name.
                 , Atom -> Char
atomChainID    :: Char    -- ^ Chain identifier.
                 , Atom -> Int
atomResSeq     :: Int     -- ^ Residue sequence number.
                 , Atom -> Char
atomICode      :: Char    -- ^ Code for insertion of residues.
                 , Atom -> Float
atomX          :: Float   -- ^ Orthogonal coordinates for X in Angstroms.
                 , Atom -> Float
atomY          :: Float   -- ^ Orthogonal coordinates for Y in Angstroms.
                 , Atom -> Float
atomZ          :: Float   -- ^ Orthogonal coordinates for Z in Angstroms.
                 , Atom -> Float
atomOccupancy  :: Float   -- ^ Occupancy.
                 , Atom -> Float
atomTempFactor :: Float   -- ^ Temperature factor.
                 , Atom -> Text
atomElement    :: Text    -- ^ Element symbol, right-justified.
                 , Atom -> Text
atomCharge     :: Text    -- ^ Charge on the atom.
                 }
  deriving (Int -> Atom -> ShowS
[Atom] -> ShowS
Atom -> String
(Int -> Atom -> ShowS)
-> (Atom -> String) -> ([Atom] -> ShowS) -> Show Atom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Atom] -> ShowS
$cshowList :: [Atom] -> ShowS
show :: Atom -> String
$cshow :: Atom -> String
showsPrec :: Int -> Atom -> ShowS
$cshowsPrec :: Int -> Atom -> ShowS
Show, Atom -> Atom -> Bool
(Atom -> Atom -> Bool) -> (Atom -> Atom -> Bool) -> Eq Atom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Atom -> Atom -> Bool
$c/= :: Atom -> Atom -> Bool
== :: Atom -> Atom -> Bool
$c== :: Atom -> Atom -> Bool
Eq, (forall x. Atom -> Rep Atom x)
-> (forall x. Rep Atom x -> Atom) -> Generic Atom
forall x. Rep Atom x -> Atom
forall x. Atom -> Rep Atom x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Atom x -> Atom
$cfrom :: forall x. Atom -> Rep Atom x
Generic, Atom -> ()
(Atom -> ()) -> NFData Atom
forall a. (a -> ()) -> NFData a
rnf :: Atom -> ()
$crnf :: Atom -> ()
NFData)

-- | We cannot use only atomSerial as key because there
-- | can be two atoms with the same atomSerial in different chains
--
instance Ord Atom where
  Atom
a1 <= :: Atom -> Atom -> Bool
<= Atom
a2 = (Atom -> Int
atomSerial Atom
a1, Atom -> Char
atomChainID Atom
a1) (Int, Char) -> (Int, Char) -> Bool
forall a. Ord a => a -> a -> Bool
<= (Atom -> Int
atomSerial Atom
a2, Atom -> Char
atomChainID Atom
a2)