parsestar-1.4: Data/STAR/Coords.hs
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}
module Data.STAR.Coords(Coord(..), extractCoords, parse)
where
import Prelude hiding(String)
import qualified Data.ByteString.Char8 as BSC
import Data.ByteString.Nums.Careless.Float as F
import Data.ByteString.Nums.Careless.Int as I
import Data.Binary
import Control.DeepSeq(NFData(..))
import Data.STAR.Parser(parseFile)
import Data.STAR.Type
import Data.STAR.Path
data Coord = Coord { model_id :: !Int,
res_id :: !Int,
entity_id :: !Int,
resname :: !String,
atom_id :: !Int,
atom_type :: !String,
x :: !Float,
y :: !Float,
z :: !Float,
x_sigma :: !Float,
y_sigma :: !Float,
z_sigma :: !Float,
entry_id :: !String }
deriving (Eq, Ord, Show)
{-!
deriving instance Binary Coord
deriving instance NFData Coord
!-}
extractCoords (STAR l) = concatMap extract' l
where
extract' (Global l) = []
extract' (Data _ l) = concatMap coordFrame l
coordFrame (Frame name elts) | frameCategory elts == "conformer_family_coord_set" = concatMap coordLoop elts
where
frameCategory elts = emptyHead $ elts ->// entriesByName "Conformer_family_coord_set.Sf_category" ./ entryValue
emptyHead [] = ""
emptyHead l = head l
coordFrame _ = []
coordLoop (Loop elts@((Entry e v:_):_)) | "Atom_site.Assembly_ID" `BSC.isPrefixOf` e = map extractCoord elts
coordLoop _ = []
emptyCoord = Coord { model_id = maxBound,
res_id = maxBound,
resname = "<UNKNOWN RESIDUE>",
atom_id = maxBound,
entity_id = maxBound,
atom_type = "<UNKNOWN ATOM>",
x = 99e99,
y = 99e99,
z = 99e99,
x_sigma = 99e99,
y_sigma = 99e99,
z_sigma = 99e99,
entry_id = "<UNKNOWN ENTRY>" }
isFilledCoord cs = all (\f -> f cs) [is_good model_id,
is_good res_id,
is_good resname,
is_good atom_id,
is_good atom_type,
is_good x,
is_good y,
is_good z,
is_good x_sigma,
is_good y_sigma,
is_good z_sigma,
is_good entry_id]
{-((cs_id cs != cs_id emptyCoord) &&
(seq_id cs != seq_id emptyCoord) &&
(atom_type cs != atom_type emptyCoord) &&
(isotope cs != isotope emptyCoord) &&-}
where
is_good :: (Eq a) => (Coord -> a) -> Coord -> Bool
is_good f cs = f cs /= f emptyCoord
compose = foldl apply
where
apply e f = f e
extractCoord :: [STAREntry] -> Coord
extractCoord entries = if isFilledCoord entry
then entry
else error $ "Cannot fill entry from: " ++ show entries
where
entryUpdate (Entry "Atom_site.Model_ID" v) cs = cs{ model_id = I.int v }
entryUpdate (Entry "Atom_site.Label_comp_index_ID" v) cs = cs{ res_id = I.int v }
entryUpdate (Entry "Atom_site.Label_comp_ID" v) cs = cs{ resname = v }
entryUpdate (Entry "Atom_site.Label_entity_ID" v) cs = cs{ entity_id = I.int v }
entryUpdate (Entry "Atom_site.Label_atom_ID" v) cs = cs{ atom_id = I.int v }
entryUpdate (Entry "Atom_site.Type_symbol" v) cs = cs{ atom_type = v }
entryUpdate (Entry "Atom_site.Cartn_x" v) cs = cs{ x = F.float v }
entryUpdate (Entry "Atom_site.Cartn_y" v) cs = cs{ y = F.float v }
entryUpdate (Entry "Atom_site.Cartn_z" v) cs = cs{ z = F.float v }
entryUpdate (Entry "Atom_site.Cartn_x_esd" v) cs = cs{ x_sigma = F.float v }
entryUpdate (Entry "Atom_site.Cartn_y_esd" v) cs = cs{ y_sigma = F.float v }
entryUpdate (Entry "Atom_site.Cartn_z_esd" v) cs = cs{ z_sigma = F.float v }
entryUpdate (Entry "Atom_site.Entry_ID" v) cs = cs{ entry_id = v }
entryUpdate _ cs = cs -- nothing changed
updates :: [Coord -> Coord] = map entryUpdate entries
entry :: Coord = compose emptyCoord updates
parse input = do dat <- Data.STAR.Parser.parseFile input
return $ case dat of
Right parsed -> Right $ extractCoords parsed
Left e -> Left e
{-
loop_
_Atom_site.Assembly_ID
_Atom_site.Model_ID
_Atom_site.Model_site_ID
_Atom_site.ID
_Atom_site.Assembly_atom_ID
_Atom_site.Label_entity_assembly_ID
_Atom_site.Label_entity_ID
_Atom_site.Label_comp_index_ID
_Atom_site.Label_comp_ID
_Atom_site.Label_atom_ID
_Atom_site.Type_symbol
_Atom_site.Cartn_x
_Atom_site.Cartn_y
_Atom_site.Cartn_z
_Atom_site.Cartn_x_esd
_Atom_site.Cartn_y_esd
_Atom_site.Cartn_z_esd
_Atom_site.Occupancy
_Atom_site.Occupancy_esd
_Atom_site.Uncertainty
_Atom_site.Ordered_flag
_Atom_site.Footnote_ID
_Atom_site.PDBX_label_asym_ID
_Atom_site.PDBX_label_seq_ID
_Atom_site.PDBX_label_comp_ID
_Atom_site.PDBX_label_atom_ID
_Atom_site.PDBX_formal_charge
_Atom_site.PDBX_label_entity_ID
_Atom_site.PDB_record_ID
_Atom_site.PDB_model_num
_Atom_site.PDB_strand_ID
_Atom_site.PDB_ins_code
_Atom_site.PDB_residue_no
_Atom_site.PDB_residue_name
_Atom_site.PDB_atom_name
_Atom_site.Auth_entity_assembly_ID
_Atom_site.Auth_asym_ID
_Atom_site.Auth_chain_ID
_Atom_site.Auth_seq_ID
_Atom_site.Auth_comp_ID
_Atom_site.Auth_atom_ID
_Atom_site.Auth_alt_ID
_Atom_site.Auth_atom_name
_Atom_site.Details
_Atom_site.Entry_ID
_Atom_site.Conformer_family_coord_set_ID
. 1 . 1 . 1 1 1 LYS C C -5.326 27.082 -6.102 . . . 1.0 . . . . . . . . . . . . X . 1 LYS C . . . . . . . . . c17438_2l96 1
. 1 . 2 . 1 1 1 LYS CA C -5.079 27.607 -7.510 . . . 1.0 . . . . . . . . . . . . X . 1 LYS CA . . . . . . . . . c17438_2l96 1
. 1 . 25 . 1 1 2 LYS C C -5.856 23.694 -4.903 . . . 1.0 . . . . . . . . . . . . X . 2 LYS C . . . . . . . . . c17438_2l96 1
. 1 . 26 . 1 1 2 LYS CA C -6.026 25.200 -4.740 . . . 1.0 . . . . . . . . . . . . X . 2 LYS CA . . . . . . . . . c17438_2l96 1
. 1 . 27 . 1 1 2 LYS CB C -7.407 25.546 -4.177 . . . 1.0 . . . . . . . . . . . . X . 2 LYS CB . . . . . . . . . c17438_2l96 1
. 1 . 28 . 1 1 2 LYS CD C -8.970 25.425 -2.197 . . . 1.0 . . . . . . . . . . . . X . 2 LYS CD . . . . . . . . . c17438_2l96 1
. 1 . 29 . 1 1 2 LYS CE C -10.181 25.325 -3.117 . . . 1.0 . . . . . . . . . . . . X . 2 LYS CE . . . . . . . . . c17438_2l96 1
. 1 . 30 . 1 1 2 LYS CG C -7.704 24.880 -2.844 . . . 1.0 . . . . . . . . . . . . X . 2 LYS CG . . . . . . . . . c17438_2l96 1
. 7 . 2838 . 1 1 15 LYS HD2 H 3.549 -4.552 -4.566 . . . 1.0 . . . . . . . . . . . . X . 15 LYS HD2 . . . . . . . . . c17438_2l96 1
. 7 . 2839 . 1 1 15 LYS HD3 H 5.219 -5.118 -4.629 . . . 1.0 . . . . . . . . . . . . X . 15 LYS HD3 . . . . . . . . . c17438_2l96 1
. 7 . 2840 . 1 1 15 LYS HE2 H 3.081 -6.054 -2.720 . . . 1.0 . . . . . . . . . . . . X . 15 LYS HE2 . . . . . . . . . c17438_2l96 1
. 7 . 2841 . 1 1 15 LYS HE3 H 3.709 -6.947 -4.104 . . . 1.0 . . . . . . . . . . . . X . 15 LYS HE3 . . . . . . . . . c17438_2l96 1
. 7 . 2842 . 1 1 15 LYS HG2 H 5.522 -4.307 -2.297 . . . 1.0 . . . . . . . . . . . . X . 15 LYS HG2 . . . . . . . . . c17438_2l96 1
. 7 . 2843 . 1 1 15 LYS HG3 H 3.896 -3.623 -2.367 . . . 1.0 . . . . . . . . . . . . X . 15 LYS HG3 . . . . . . . . . c17438_2l96 1
. 10 . 4288 . 1 1 24 ALA N N 18.192 1.376 1.791 . . . 1.0 . . . . . . . . . . . . X . 24 ALA N . . . . . . . . . c17438_2l96 1
. 10 . 4289 . 1 1 24 ALA O O 20.909 2.034 3.478 . . . 1.0 . . . . . . . . . . . . X . 24 ALA O . . . . . . . . . c17438_2l96 1
. 10 . 4290 . 1 1 24 ALA OXT O 19.164 1.437 4.669 . . . 1.0 . . . . . . . . . . . . X . 24 ALA OXT . . . . . . . . . c17438_2l96 1
-}