{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
module Bio.Structure
( SecondaryStructure (..)
, Atom (..), Bond (..)
, Residue (..), Chain (..), Model (..)
, StructureModels (..), StructureSerializable (..)
, LocalID (..)
, GlobalID (..)
, atoms, localBonds
, residues
, chains, globalBonds
) where
import Control.DeepSeq (NFData (..))
import Control.Lens (makeLensesFor)
import Data.Text (Text)
import Data.Vector (Vector)
import GHC.Generics (Generic)
import Linear.V3 (V3)
data SecondaryStructure = PiHelix
| Bend
| AlphaHelix
| Extended
| ThreeTenHelix
| Bridge
| Turn
| Coil
| Undefined
deriving (Show, Eq, Generic)
instance NFData SecondaryStructure
newtype GlobalID = GlobalID { getGlobalID :: Int }
deriving (Eq, Show, Ord, Generic, NFData)
newtype LocalID = LocalID { getLocalID :: Int }
deriving (Eq, Show, Ord, Generic, NFData)
data Atom = Atom { atomId :: GlobalID
, atomInputIndex :: Int
, atomName :: Text
, atomElement :: Text
, atomCoords :: V3 Float
, formalCharge :: Int
, bFactor :: Float
, occupancy :: Float
}
deriving (Show, Eq, Generic)
instance Ord Atom where
a1 <= a2 = atomId a1 <= atomId a2
instance NFData Atom
data Bond m = Bond { bondStart :: m
, bondEnd :: m
, bondOrder :: Int
}
deriving (Show, Eq, Functor, Generic)
instance Ord (Bond LocalID) where
(Bond (LocalID x) (LocalID y) _) <= (Bond (LocalID x') (LocalID y') _) | x == x' = y <= y'
| otherwise = x <= x'
instance Ord (Bond GlobalID) where
(Bond (GlobalID x) (GlobalID y) _) <= (Bond (GlobalID x') (GlobalID y') _) | x == x' = y <= y'
| otherwise = x <= x'
instance NFData a => NFData (Bond a)
data Residue = Residue { resName :: Text
, resNumber :: Int
, resInsertionCode :: Char
, resAtoms :: Vector Atom
, resBonds :: Vector (Bond LocalID)
, resSecondary :: SecondaryStructure
, resChemCompType :: Text
}
deriving (Show, Eq, Generic, NFData)
makeLensesFor [("resAtoms", "atoms"), ("resBonds", "localBonds")] ''Residue
data Chain = Chain { chainName :: Text
, chainResidues :: Vector Residue
}
deriving (Show, Eq, Generic, NFData)
makeLensesFor [("chainResidues", "residues")] ''Chain
data Model = Model { modelChains :: Vector Chain
, modelBonds :: Vector (Bond GlobalID)
}
deriving (Show, Eq, Generic, NFData)
makeLensesFor [("modelChains", "chains"), ("modelBonds", "globalBonds")] ''Model
class StructureModels a where
modelsOf :: a -> Vector Model
class StructureSerializable a where
serializeModels :: Vector Model -> a