diff --git a/Bio/PDB.hs b/Bio/PDB.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB.hs @@ -0,0 +1,21 @@ +module Bio.PDB(parse, write, + Structure(..), Model(..), Chain(..), Residue(..), Atom(..), + Iterable(..), + numAtoms, numResidues, numChains, numModels, + firstModel, + resname2fastacode, fastacode2resname, + (*|), (|*), vnorm, + Element, + assignElement, + atomicNumber, atomicMass, covalentRadius, vanDerWaalsRadius + ) where + +import Bio.PDB.IO(parse, write) +import Bio.PDB.Structure +import Bio.PDB.Iterable +import Bio.PDB.Iterable.Utils +import Bio.PDB.Fasta +import Bio.PDB.Structure.List() +import Bio.PDB.Structure.Vector +import Bio.PDB.Structure.Elements + diff --git a/Bio/PDB/Common.hs b/Bio/PDB/Common.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/Common.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE StandaloneDeriving, BangPatterns #-} +module Bio.PDB.Common(String(..), Vector3(..)) + +where + +import Data.Vector.V3 + +import Prelude hiding(String) + +import qualified Data.ByteString.Char8 as BS +import Control.DeepSeq(NFData(..)) +import Bio.PDB.Util.MissingInstances() + +-- | We use only strict ByteString as strings in PDB parser. +type String = BS.ByteString + +-- -- | Datatype for 3D locations (numbers are in ångströms.) +--instance NFData Vector3 where +-- rnf (Vector3 (x, y, z)) = x `seq` y `seq` z `seq` () + diff --git a/Bio/PDB/EventParser/ExperimentalMethods.hs b/Bio/PDB/EventParser/ExperimentalMethods.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ExperimentalMethods.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | This module contains an enumeration of experimental methods. +module Bio.PDB.EventParser.ExperimentalMethods(ExpMethod(..), mkExpMethod, showExpMethod) +where + +import qualified Data.ByteString.Char8 as BS + +-- | Enumeration of experimental methods occuring in the PDB archive. +data ExpMethod = XRayDiffraction | + FiberDiffraction | + NeutronDiffraction | + ElectronCrystallography | + ElectronMicroscopy | + SolidStateNMR | + SolutionNMR | + SolutionScattering | + OtherExpMethod !BS.ByteString + deriving (Show, Read, Eq, Ord) + +-- | Generates an ExpMethod from words in PDB +mkExpMethod :: [BS.ByteString] -> ExpMethod +mkExpMethod ["X-RAY", "DIFFRACTION"] = XRayDiffraction +mkExpMethod ["FIBER", "DIFFRACTION"] = FiberDiffraction +mkExpMethod ["NEUTRON", "DIFFRACTION"] = NeutronDiffraction +mkExpMethod ["ELECTRON", "CRYSTALLOGRAPHY"] = ElectronCrystallography +mkExpMethod ["ELECTRON", "MICROSCOPY"] = ElectronMicroscopy +mkExpMethod ["SOLID-STATE", "NMR"] = SolidStateNMR +mkExpMethod ["SOLUTION", "NMR"] = SolutionNMR +mkExpMethod ["SOLUTION", "SCATTERING"] = SolutionScattering +mkExpMethod other = OtherExpMethod (BS.unwords other) -- error-like + +-- | Converts an ExpMethod back into text +showExpMethod :: ExpMethod -> BS.ByteString +showExpMethod XRayDiffraction = "X-RAY DIFFRACTION" +showExpMethod FiberDiffraction = "FIBER DIFFRACTION" +showExpMethod NeutronDiffraction = "NEUTRON DIFFRACTION" +showExpMethod ElectronCrystallography = "ELECTRON CRYSTALLOGRAPHY" +showExpMethod ElectronMicroscopy = "ELECTRON MICROSCOPY" +showExpMethod SolidStateNMR = "SOLID-STATE NMR" +showExpMethod SolutionNMR = "SOLUTION NMR" +showExpMethod SolutionScattering = "SOLUTION SCATTERING" +showExpMethod (OtherExpMethod other) = other + diff --git a/Bio/PDB/EventParser/FastParse.hs b/Bio/PDB/EventParser/FastParse.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/FastParse.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE ScopedTypeVariables, MagicHash, BangPatterns #-} +-- | Utility functions for faster parsing using 'Data.ByteString.Internal'. +module Bio.PDB.EventParser.FastParse(strtof, trim, trimFront) +where + +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Internal as BSI +import qualified Data.ByteString.Unsafe as BSU + +--import Char(ord) +import GHC.Base(Char(..), Int(..)) +import GHC.Prim + +-- Why on earth GHC doesn't inline functions like ord?! They should normally compile to no-ops!!! +{-# INLINE ord #-} +ord :: Char -> Int +ord (C# c#) = I# (ord# c#) + +{-# INLINE strtof #-} +strtof :: BS.ByteString -> Maybe Double +strtof bs | BS.null bs = Nothing +strtof bs = case chr of + '-' -> strtof0 True 0 rest -- this allows for "-" == 0.0 + _ | dv >= 0 && dv <= 9 -> strtof0 False dv rest + ' ' -> strtof rest + _ -> Nothing + where chr = BSI.w2c $ BSU.unsafeHead bs + dv = digitValue chr + rest = BSU.unsafeTail bs + +{-# INLINE digitValue #-} +digitValue :: Char -> Int +digitValue !c = ord c - ord '0' + +{-# INLINE final #-} +final :: Bool -> Double -> Maybe Double +final !sign !f = if sign then Just (-f) else Just f + +{-# INLINE strtof0 #-} +strtof0 :: Bool -> Int -> BS.ByteString -> Maybe Double +strtof0 !sign !f !bs | BS.null bs = final sign (fromIntegral f :: Double) +strtof0 sign f bs = case chr of _ | dv >= 0 && dv <= 9 -> strtof0 sign (10 * f + dv) rest + '.' -> strtof1 sign 0 f rest + _ -> Nothing + where chr = BSI.w2c $ BSU.unsafeHead bs + rest = BSU.unsafeTail bs + dv = digitValue chr + +{-# INLINE strtof1 #-} +strtof1 :: Bool -> Int -> Int -> BS.ByteString -> Maybe Double +strtof1 !sign !e !f !bs | BS.null bs = makeDouble sign e f +strtof1 sign e f bs = case chr of + _ | dv >= 0 && dv <= 9 -> strtof1 sign (e+1) (f*10 + dv) rest + ' ' -> fs `seq` checkSpaces fs rest + _ -> Nothing + where chr = BSI.w2c $ BSU.unsafeHead bs + dv = digitValue chr + fs = makeDouble sign e f + rest = BSU.unsafeTail bs + +{-# INLINE makeDouble #-} +makeDouble !sign !e !f = final sign (fromIntegral f * 0.1 ** fromIntegral e) + +{-# INLINE checkSpaces #-} +checkSpaces :: Maybe a -> BS.ByteString -> Maybe a +checkSpaces !result !blanks = if BS.all (==' ') blanks then result else Nothing + +{-# INLINE trimFront #-} +trimFront !s | BS.null s = s +trimFront !s = if BSU.unsafeHead s == 32 -- space + then trimFront $ BSU.unsafeTail s + else s +-- No idea why it is faster than BS.span version? + +{-# INLINE trimRear #-} +trimRear !s | BS.null s = s +trimRear !s = if BSU.unsafeIndex s (BS.length s - 1) == 32 + then trimRear $ butlast s + else s + + +butlast (BSI.PS fp o l) = BSI.PS fp o (l-1) + +trim !s = trimRear $ trimFront s + diff --git a/Bio/PDB/EventParser/HelixTypes.hs b/Bio/PDB/EventParser/HelixTypes.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/HelixTypes.hs @@ -0,0 +1,66 @@ +-- | Module contains enumeration of helix types, and auxiliary functions +-- for converting these into numeric PDB CLASS code. +module Bio.PDB.EventParser.HelixTypes(HelixT, helix2code, code2helix) +where +{-| Enumeration of helix types + +PDB Class number in columns 39-40 for each type of helix in HELIX record: + + (1) Right-handed alpha (default) + + (2) Right-handed omega + + (3) Right-handed pi + + (4) Right-handed gamma + + (5) Right-handed 3 - 10 + + (6) Left-handed alpha + + (7) Left-handed omega + + (8) Left-handed gamma + + (9) 2 - 7 ribbon/helix + +(10) Polyproline + +-} + +data HelixT = RightAlpha | + RightOmega | + RightPi | + RightGamma | + Right3_10 | + LeftAlpha | + LeftOmega | + LeftGamma | + Ribbon2_7 | + Polyproline + deriving (Eq, Ord, Show, Read) + +-- | helix2code converts a 'HelixT' enumeration into an PDB CLASS number. +helix2code RightAlpha = 1 +helix2code RightOmega = 2 +helix2code RightPi = 3 +helix2code RightGamma = 4 +helix2code Right3_10 = 5 +helix2code LeftAlpha = 6 +helix2code LeftOmega = 7 +helix2code LeftGamma = 8 +helix2code Ribbon2_7 = 9 +helix2code Polyproline = 10 + +-- | helix2code converts an PDB CLASS number into a 'HelixT' enumeration. +code2helix 1 = RightAlpha +code2helix 2 = RightOmega +code2helix 3 = RightPi +code2helix 4 = RightGamma +code2helix 5 = Right3_10 +code2helix 6 = LeftAlpha +code2helix 7 = LeftOmega +code2helix 8 = LeftGamma +code2helix 9 = Ribbon2_7 +code2helix 10 = Polyproline + diff --git a/Bio/PDB/EventParser/PDBEventParser.hs b/Bio/PDB/EventParser/PDBEventParser.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/PDBEventParser.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, BangPatterns, NoMonomorphismRestriction #-} +module Bio.PDB.EventParser.PDBEventParser(parsePDBRecords) +where + +-- Parses PDB file format version 3.20 (dated Sept 15, 2008) + +import qualified Data.ByteString.Char8 as BS +import Control.Monad(unless, foldM) + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions +-- Methods parsing individual records: +import Bio.PDB.EventParser.ParseATOM +import Bio.PDB.EventParser.ParseHEADER +import Bio.PDB.EventParser.ParseTITLE +import Bio.PDB.EventParser.ParseREMARK +import Bio.PDB.EventParser.ParseIntRecord +import Bio.PDB.EventParser.ParseREVDAT +import Bio.PDB.EventParser.ParseCONECT +import Bio.PDB.EventParser.ParseSEQRES +import Bio.PDB.EventParser.ParseCRYST1 +import Bio.PDB.EventParser.ParseHELIX +import Bio.PDB.EventParser.ParseSHEET +import Bio.PDB.EventParser.ParseTER +import Bio.PDB.EventParser.ParseMASTER +import Bio.PDB.EventParser.ParseMODRES +import Bio.PDB.EventParser.ParseSEQADV +import Bio.PDB.EventParser.ParseCAVEAT +import Bio.PDB.EventParser.ParseSPLIT +import Bio.PDB.EventParser.ParseJRNL +import Bio.PDB.EventParser.ParseDBREF +import Bio.PDB.EventParser.ParseHETNAM +import Bio.PDB.EventParser.ParseHET +import Bio.PDB.EventParser.ParseFORMUL +import Bio.PDB.EventParser.ParseCISPEP +import Bio.PDB.EventParser.ParseSSBOND +import Bio.PDB.EventParser.ParseLINK +import Bio.PDB.EventParser.ParseSLTBRG +import Bio.PDB.EventParser.ParseHYDBND +import Bio.PDB.EventParser.ParseSITE +import Bio.PDB.EventParser.ParseObsoleting +import Bio.PDB.EventParser.ParseSpecListRecord +import Bio.PDB.EventParser.ParseListRecord +import Bio.PDB.EventParser.ParseMatrixRecord +import Bio.PDB.EventParser.ParseTVECT + +import System.IO.Unsafe --debug + +--------------- {{{ Record parsers + +--------------- }}} Record parsers +--------------- {{{ Main parser: putting it together +--parsePDBLines :: (Monad m) => BS.ByteString -> BS.ByteString -> Int -> m [PDBEvent] +{- | Parses an input stream 'input' with name 'fname' at line 'line_no', and +uses parsed input 'evts' to perform an 'action' on them and accumulator +'acc'. + +Returns the ultimate value of the accumulated results in 'acc' +after all actions are performed in an order consistent with input. +-} +parsePDBLines !fname !input !line_no action acc = + if BS.null input + then return acc + else ( + case line of + -- Most frequent records + a | "ATOM " `BS.isPrefixOf` a -> cont1 $! parseATOM line line_no + a | "HETATM" `BS.isPrefixOf` a -> cont1 $! parseATOM line line_no + a | "ANISOU" `BS.isPrefixOf` a -> cont1 $! parseANISOU line line_no + a | "REMARK" `BS.isPrefixOf` a -> cont1 $! parseREMARK line line_no + a | "SEQRES" `BS.isPrefixOf` a -> cont1 $! parseSEQRES line line_no + a | "CONECT" `BS.isPrefixOf` a -> cont1 $! parseCONECT line line_no + a | "SIGATM" `BS.isPrefixOf` a -> cont1 $! parseATOM line line_no + a | "SIGUIJ" `BS.isPrefixOf` a -> cont1 $! parseANISOU line line_no + -- Delimiters + a | "ENDMDL" `BS.isPrefixOf` a -> cont1 $! return [ENDMDL] + a | "END" `BS.isPrefixOf` a -> cont1 $! return [END] + -- common error in treatment of TER - omitting rest of the record + "TER" -> cont1 $! return [TER { num = (-1), resname = "", chain = ' ', resid = (-1), insCode = ' ' }] + -- proper TER + a | "TER" `BS.isPrefixOf` a -> cont1 $! parseTER line line_no + a | "MASTER" `BS.isPrefixOf` a -> cont1 $! parseMASTER line line_no + -- Secondary structure declarations + a | "HELIX" `BS.isPrefixOf` a -> cont1 $! parseHELIX line line_no + a | "SHEET" `BS.isPrefixOf` a -> cont1 $! parseSHEET line line_no + -- Crystallographic information + a | "SCALE" `BS.isPrefixOf` a -> cont1 $! parseSCALEn line line_no + a | "ORIGX" `BS.isPrefixOf` a -> cont1 $! parseORIGXn line line_no + a | "MTRIX" `BS.isPrefixOf` a -> cont1 $! parseMTRIXn line line_no + a | "CRYST1" `BS.isPrefixOf` a -> cont1 $! parseCRYST1 line line_no + a | "TVECT " `BS.isPrefixOf` a -> cont1 $! parseTVECT line line_no + -- Singular metarecords + a | "DBREF " `BS.isPrefixOf` a -> cont1 $! parseDBREF line line_no + a | "DBREF1" `BS.isPrefixOf` a -> cont2 $! parseDBREF12 (line, line2) line_no + a | "HETNAM" `BS.isPrefixOf` a -> cont1 $! parseHETNAM True line line_no + a | "HETSYN" `BS.isPrefixOf` a -> cont1 $! parseHETNAM False line line_no + a | "HET " `BS.isPrefixOf` a -> cont1 $! parseHET line line_no + a | "FORMUL" `BS.isPrefixOf` a -> cont1 $! parseFORMUL line line_no + a | "CISPEP" `BS.isPrefixOf` a -> cont1 $! parseCISPEP line line_no + a | "SSBOND" `BS.isPrefixOf` a -> cont1 $! parseSSBOND line line_no + a | "LINK " `BS.isPrefixOf` a -> cont1 $! parseLINK line line_no + a | "SLTBRG" `BS.isPrefixOf` a -> cont1 $! parseSLTBRG line line_no + a | "HYDBND" `BS.isPrefixOf` a -> cont1 $! parseHYDBND line line_no + a | "SITE " `BS.isPrefixOf` a -> cont1 $! parseSITE line line_no + a | "MODRES" `BS.isPrefixOf` a -> cont1 $! parseMODRES line line_no + a | "SEQADV" `BS.isPrefixOf` a -> cont1 $! parseSEQADV line line_no + a | "MDLTYP" `BS.isPrefixOf` a -> cont1 $! parseMDLTYP line line_no + a | "EXPDTA" `BS.isPrefixOf` a -> cont1 $! parseEXPDTA line line_no + a | "SOURCE" `BS.isPrefixOf` a -> cont1 $! parseSOURCE line line_no + a | "COMPND" `BS.isPrefixOf` a -> cont1 $! parseCOMPND line line_no + a | "NUMMDL" `BS.isPrefixOf` a -> cont1 $! parseNUMMDL line line_no + a | "MODEL " `BS.isPrefixOf` a -> cont1 $! parseMODEL line line_no + a | "REVDAT" `BS.isPrefixOf` a -> cont1 $! parseREVDAT line line_no + a | "HEADER" `BS.isPrefixOf` a -> cont1 $! parseHEADER line line_no + a | "TITLE " `BS.isPrefixOf` a -> cont1 $! parseTITLE line line_no + a | "AUTHOR" `BS.isPrefixOf` a -> cont1 $! parseAUTHOR line line_no + a | "KEYWDS" `BS.isPrefixOf` a -> cont1 $! parseKEYWDS line line_no + a | "CAVEAT" `BS.isPrefixOf` a -> cont1 $! parseCAVEAT line line_no + a | "OBSLTE" `BS.isPrefixOf` a -> cont1 $! parseOBSLTE line line_no + a | "SPRSDE" `BS.isPrefixOf` a -> cont1 $! parseSPRSDE line line_no + a | "SPLIT " `BS.isPrefixOf` a -> cont1 $! parseSPLIT line line_no + a | "JRNL " `BS.isPrefixOf` a -> cont1 $! parseJRNL line line_no + _ -> cont1 $! return [PDBIgnoredLine line]) + where + cont1 !a = do !evts <- a + !new_acc <- foldM action acc evts + --(nextLine1 `seq` line_no1 `seq` new_acc `seq` + parsePDBLines fname nextLine1 line_no1 action new_acc + cont2 a = do !evts <- a + !new_acc <- foldM action acc evts + parsePDBLines fname nextLine2 line_no2 action acc + (!line, !rest1) = BS.break (=='\n') input + nextLine1 = BS.drop 1 rest1 + (line2, rest2) = BS.break (=='\n') nextLine1 + nextLine2 = BS.drop 1 rest2 + !line_no1 = line_no + 1 + line_no2 = line_no1 + 1 + +--parsePDBRecords :: (Monad m) =>String -> BS.ByteString -> (a -> PDBEvent -> m a) -> a -> m a +-- | Parses a strict ByteString 'contents' named 'fname' and performs 'action' +-- on events given by parsing chunks, returning accumulated results. Accumulator +-- is primed by 'acc'. +parsePDBRecords fname contents action acc = parsePDBLines fname contents 0 action acc + +-- | Checks whether line was ignored as unknown record type +ignoreLine (PDBIgnoredLine _) = False +ignoreLine _ = True + +--------------- }}} Main parser: putting it together diff --git a/Bio/PDB/EventParser/PDBEventPrinter.hs b/Bio/PDB/EventParser/PDBEventPrinter.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/PDBEventPrinter.hs @@ -0,0 +1,278 @@ +{-# LANGUAGE OverloadedStrings, PatternGuards #-} +module Bio.PDB.EventParser.PDBEventPrinter(print, isPrintable) + +where + +import qualified Prelude(String) +import Prelude((++), Bool(True, False), (.), ($), Int, (+), (>), (<), show, Double) +import Text.Printf(hPrintf) +import System.IO(Handle, IO, stderr) +import qualified Data.ByteString.Char8 as BS +import Data.String(IsString) +import Control.Monad(mapM, return) + +import Bio.PDB.EventParser.PDBEvents +import qualified Bio.PDB.EventParser.ExperimentalMethods as ExperimentalMethods +import qualified Data.ByteString.Lazy as L +import Data.Text.Lazy.Encoding(encodeUtf8) +import Data.Text.Encoding (decodeUtf8) +import qualified Data.Text.Lazy as LT +import Data.Text.Lazy.Builder as B +import qualified Data.Text.Format as F +import qualified Data.Text.Buildable as BD + +-- | Prints a PDBEvent to a filehandle. +print :: Handle -> PDBEvent -> IO () +print handle ATOM { no = num, + atomtype = atype, + restype = rtype, + chain = c, + resid = rid, + resins = rins, + altloc = al, + coords = Vector3 x y z, + occupancy = occ, + bfactor = bf, + segid = sid, + elt = e, + charge = ch, + hetatm = isHet + } = do L.hPutStr handle . encodeUtf8 $ F.format "{}{} {}{}{} {}{}{} {}{}{}{}{} {}{}{}\n" args + where + -- ra justifies a ByteString to the right + ra i = F.right i ' ' . decodeUtf8 + -- la justifies anything else (floating point or integer number) to the left + la i = F.left i ' ' + args = (recname, la 5 num, specfmt 4 3 atype, + conv al, ra 3 $ rtype, + conv c, la 4 rid, + conv rins, + ca x, ca y, ca z, pa occ, pa bf, + ra 4 $ sid, ra 2 $ e, ra 2 $ ch) + ca f = la 8 $ F.fixed 3 f -- align coordinate float + pa f = la 6 $ F.fixed 2 f -- align property float + recname = fromText $ if isHet then "HETATM" else "ATOM " + --conv :: Char -> Builder + conv x = fromString [x] + -- specfmt mimics erratic alignment of PDB atom types: up to three characters are justified left, after prefixing by single space. + specfmt i j a = B.fromLazyText . LT.justifyRight i ' ' . LT.justifyLeft j ' ' . B.toLazyText . fromText . decodeUtf8 $ a + +-- TODO: Note that this ANISOU code will be buggy for 4-letter atom codes that happen (rarely.) +print handle ANISOU { no = n, + atomtype = atype, + restype = rtype, + chain = c, + resid = rid, + resins = rins, + altloc = al, + u_1_1 = u11, + u_2_2 = u22, + u_3_3 = u33, + u_1_2 = u12, + u_1_3 = u13, + u_2_3 = u23, + segid = sid, + elt = e, + charge = ch + } = hPrintf handle + "ANISOU%5d %-3s%c%-3s %c%4d%c %7d%7d%7d%7d%7d%7d %-4s%-2s%-2s\n" + n (BS.unpack atype) al (BS.unpack rtype) c rid rins + u11 u22 u33 u12 u13 u23 + (BS.unpack sid) (BS.unpack e) (BS.unpack ch) +print handle SIGUIJ { no = n, + atomtype = atype, + restype = rtype, + chain = c, + resid = rid, + resins = rins, + altloc = al, + u_1_1 = u11, + u_2_2 = u22, + u_3_3 = u33, + u_1_2 = u12, + u_1_3 = u13, + u_2_3 = u23, + segid = sid, + elt = e, + charge = ch + } = hPrintf handle + "SIGUIJ%5d %-3s%c%-3s %c%4d%c %7d%7d%7d%7d%7d%7d %-4s%-2s%-2s\n" + n (BS.unpack atype) al (BS.unpack rtype) c rid rins + u11 u22 u33 u12 u13 u23 + (BS.unpack sid) (BS.unpack e) (BS.unpack ch) +print handle (HEADER { classification = c, + depDate = d, + idCode = i }) = hPrintf handle "HEADER %-40s%9s %4s\n" + (BS.unpack c) + (BS.unpack d) + (BS.unpack i) +print handle MODEL { num=n } = hPrintf handle "MODEL %4d\n" n +print handle END = hPrintf handle "END\n" +print handle ENDMDL = hPrintf handle "ENDMDL\n" +print handle CONECT { atoms=ats } = do hPrintf handle "CONECT" + mapM (hPrintf handle "%5d") ats + hPrintf handle "\n" +print handle TER { num = n , + resname = r , + chain = ch , + resid = resi , + insCode = i } = hPrintf handle + "TER %5d %c%-3s %c%4d\n" n i (BS.unpack r) ch resi +print handle MASTER { numRemark = nr, + numHet = nhet, + numHelix = nhel, + numSheet = nsheet, + numTurn = nturn, + numSite = nsite, + numXform = nxform, + numAts = nats, + numMaster = nmaster, + numConect = ncon, + numSeqres = nseq } = do hPrintf handle "MASTER %5d 0" nr + mapM (hPrintf handle "%5d") + [nhet, nhel, nsheet, + nturn, nsite, nxform, nats, + nmaster, ncon, nseq] + hPrintf handle "\n" +print handle REMARK { num = n, + text = t } = do mapM (hPrintf handle "REMARK %4d %-80s\n" n . + BS.unpack) t + return () +{- KEYWDS { continuation :: !Int, + aList :: ![String] } | + AUTHOR { continuation :: !Int, + aList :: ![String] } | + REMARK { num :: !Int, + text :: ![String] } -} +print handle KEYWDS { continuation = c, + aList = l } = printList handle "KEYWDS" "," c l +print handle AUTHOR { continuation = c, + aList = l } = printList handle "AUTHOR" "," c l +print handle EXPDTA { continuation = c, + expMethods = e } = do mapM (hPrintf handle "EXPDTA %c%-80s\n" + (showContinuation c) . + BS.unpack . + ExperimentalMethods.showExpMethod) e + return () +print handle TITLE { continuation = c, + title = t } = hPrintf handle "TITLE %c%-80s\n" + (showContinuation c) + (contd c $ BS.unpack t) +print handle SEQRES { serial = sn, + chain = ch, + num = n, + resList = l } = do hPrintf handle "SEQRES %3d %c %4d " sn ch n + mapM (hPrintf handle "%3s " . + BS.unpack) l + -- TODO: split when longer than X residues + hPrintf handle "\n" +print handle COMPND { cont = c, + tokens = ts } = printSpecList handle "COMPND" c ts +print handle SOURCE { cont = c, + tokens = ts } = printSpecList handle "SOURCE" c ts +print handle SPLIT { cont = c, + codes = cs } = printList handle "SPLIT " " " c cs +print handle ORIGXn { n = n, + o = vecs, + t = f } = printMatrix handle "ORIGX" n vecs f +print handle SCALEn { n = n, + o = vecs, + t = f } = printMatrix handle "SCALE" n vecs f +print handle CRYST1 { a = av, + b = bv, + c = cv, + alpha = aa, + beta = ba, + gamma = ga, + spcGrp = grp, + zValue = z } = hPrintf handle + "CRYST1 %8.3f %8.3f %8.3f %6.2f %6.2f %6.2f %10s %4d\n" + av bv cv + aa ba ga + (BS.unpack grp) + z +print handle TVECT { serial = sn, + vec = Vector3 a b c } = hPrintf handle "TVECT %4d%10.5f%10.5f%10.5f\n" sn a b c +print handle JRNL { cont = c, + content = contents, + isFirst = aJRNL } = printJRNL contents + where + header :: String + header = if aJRNL then "JRNL " else "REMARK 1 " + [contd] = if c > 0 then show c else " " + printJRNL ((k,v):cs) = do hPrintf handle "%12s%4s %c %s\n" + (BS.unpack header) + (BS.unpack k) + contd + (BS.unpack v) + +-- print errors: +print handle (PDBParseError c r s) = hPrintf stderr "ERROR: In line %d column %d: %s" c r + (BS.unpack s) + +-- print special case for missing... +print handle e = hPrintf stderr "UNIMPLEMENTED: %s\n" + (show e) + +showContinuation 0 = ' ' +showContinuation x | [c] <- show x = c + +contd 0 s = s +contd x s = ' ' : s + +-- | Reports whether a given PDB record is already printable +-- [temporary method, they all should be.] +-- Including errors. +isPrintable ATOM {} = True +isPrintable HEADER {} = True +isPrintable END {} = True +isPrintable ENDMDL {} = True +isPrintable MODEL {} = True +isPrintable CONECT {} = True +isPrintable TER {} = True +isPrintable MASTER {} = True +-- TODO: below +isPrintable AUTHOR {} = True +isPrintable KEYWDS {} = True +--isPrintable JRNL {} = True +isPrintable TITLE {} = True +isPrintable REMARK {} = True +isPrintable EXPDTA {} = True +isPrintable SEQRES {} = True +isPrintable COMPND {} = True +isPrintable SOURCE {} = True +isPrintable SPLIT {} = True +isPrintable ORIGXn {} = True +isPrintable SCALEn {} = True +isPrintable CRYST1 {} = True +isPrintable ANISOU {} = True +isPrintable SIGUIJ {} = True +isPrintable TVECT {} = True +isPrintable JRNL {} = True + +isPrintable (PDBParseError c r s) = True +isPrintable _ = False + +printSpecList handle rectype c ((k, v): ls) = hPrintf handle "%6s %c%-s:%-s;\n" + (BS.unpack rectype) + (showContinuation c) + (contd c $ BS.unpack k) + (BS.unpack v) + +printList :: Handle -> BS.ByteString -> BS.ByteString -> Int -> [BS.ByteString] -> IO () +printList handle label sep c l = hPrintf handle "%6s %c %-80s\n" (BS.unpack label) + (showContinuation c) + str + where str = BS.unpack (BS.intercalate sep l) + +printMatrix :: Handle -> BS.ByteString -> Int -> [Vector3] -> [Double] -> IO () +printMatrix handle ident n [] [] = return () +printMatrix handle ident n (vec:vecs) (f:fs) = do hPrintf handle "%5s%c " (BS.unpack ident) cn + mapM printEntry [a, b, c] + hPrintf handle " %9.5f\n" f + printMatrix handle ident (n+1) vecs fs + where [cn] = show n + printEntry :: Double -> IO () + printEntry f = hPrintf handle "%10.6f" f + Vector3 a b c = vec + diff --git a/Bio/PDB/EventParser/PDBEvents.hs b/Bio/PDB/EventParser/PDBEvents.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/PDBEvents.hs @@ -0,0 +1,270 @@ +-- | 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) diff --git a/Bio/PDB/EventParser/PDBParsingAbstractions.hs b/Bio/PDB/EventParser/PDBParsingAbstractions.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/PDBParsingAbstractions.hs @@ -0,0 +1,510 @@ +{-# LANGUAGE BangPatterns, PatternGuards, ScopedTypeVariables, OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} +{-| Standard building blocks for PDB parser. +-} +module Bio.PDB.EventParser.PDBParsingAbstractions( + -- * Stage 1 parsing - separating columns + trim, parseFields, + unstr, + -- * Stage 2 parsing - parsing typed values from strings + ParsedField(..), + -- ** Optional fields + pSpc, + pInt, pStr, pChr, pDouble, + -- ** Optional fields with default values + dInt, dStr, dChr, dDouble, + -- ** Mandatory fields + mKeyword, + mKeywords, + mSpc, mInt, mStr, mChr, mDouble, + -- * Stage 2.5 parsing - grouping fields into compound values + -- ** Compound types + fgAtom, maybeFgAtom, + fgResidue, maybeFgResidue, + -- ** Extracting lists of typed values or error events + lefts, rights, + liftFgErrs, + maybeList + -- * Stage 3 is making valid 'PDBEvent's (not included in this module.) + ) +where + +import Prelude hiding (String) +import qualified Data.ByteString.Char8 as BS +import Data.Char (isSpace) + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.FastParse(strtof, trim, trimFront) + +--------------- {{{ Parsing abstraction +-- * Parsing abstraction utilities + +--------------- {{{ Stage 1 parsing - dissection by columns +-- ** Stage 1 parsing - dissection by columns +{-# INLINE splitByColumns #-} +-- | Splits a string into substrings by column numbers. +splitByColumns :: String -> -- -- ^ An input String + [Int] -> -- -- ^ An input list of first column numbers for each record entry + [String] -- -- ^ Output list of record entries as strings +splitByColumns !s !cols = split s cols 0 + where + split !s [] _ = [s] -- leftover + split !s (c:cs) !i = let (a, s2) = BS.splitAt (c-i) s in + a:split s2 cs c + +{-# INLINE unstr #-} +-- | Converts a 'ParsedField' containing 'String' into this string or an empty string if nothing was parsed. +unstr :: ParsedField -> String +unstr (IFStr !s) = s +unstr IFNone = "" +--------------- }}} Stage 1 parsing - dissection by columns + + +--------------- {{{ Stage 2 parsing - type conversions +-- ** Stage 2 parsing - type conversions +-- | A common type for shuttling parsed and typed record values. +data ParsedField = IFInt {-# UNPACK #-} !Int | + IFStr {-# UNPACK #-} !String | + IFChar {-# UNPACK #-} !Char | + IFDouble {-# UNPACK #-} !Double | + IFError {-# UNPACK #-} !String | + IFNone + deriving (Eq, Ord, Show, Read) + +-- | Construct an error message by concatenating list of 'Bytestring's +ifError msg = IFError $ BS.concat msg + +-- *** Parsers for optional fields +{-# INLINE pChr #-} +-- | Parser for an optional single-character field, first argument is a name of a field, second is an input. +pChr :: String -> String -> ParsedField +pChr fname s | BS.length s == 1 = IFChar (BS.head s) +pChr fname "" = IFNone +pChr fname s = ifError ["Char field '", fname, "' should have length of 1 - is '", s, "'."] + +{-# INLINE pSpc #-} +-- | Parser for an optional spacing, an argument is an input. +pSpc :: String -> ParsedField +pSpc s | BS.null $ trimFront s = IFNone +pSpc s = ifError ["Spacing expected, but '", s, "' found."] + +-- | Old version of pSpc +-- NOTE: also slower than using new trimFront +pSpcO s | BS.dropWhile (==' ') s == "" = IFNone +pSpcO s = ifError ["Spacing expected, but '", s, "' found."] + +{-# INLINE pInt #-} +-- | Parser for an optional integer field, first argument is a field name, a second argument is an input. +pInt :: String -> String -> ParsedField +pInt fname s | Just (a, r) <- BS.readInt $ trimFront s = if BS.null $ trimFront r + then IFInt a + else pIntErr fname s +pInt fname (trimFront -> "") = IFNone +pInt fname s = pIntErr fname s + +-- | Reports error from pInt. +pIntErr fname s = ifError ["Int field '", fname, + "' cannot be parsed: '", s, "'."] +{-# INLINE pStr #-} +-- | Parser for an optional string field, first argument is a field name, a second argument is an input. +pStr :: String -> String -> ParsedField +pStr fname s = IFStr $ trim s + +{-# INLINE pDouble #-} +-- | Parser for an optional floating-point field, first argument is a field name, a second argument is an input. +pDouble :: String -> String -> ParsedField +pDouble fname (strtof -> Just f) = IFDouble f +pDouble fname (trimFront -> "") = IFNone +pDouble fname s = ifError ["Double cannot be parsed: '", s, "'."] + +-- *** Parsers with default field values +-- | A helper method for converting a parser of an optional field +-- into a parser of an optional field with a default value. +{-# INLINE dConv #-} +dConv :: (t -> t1 -> ParsedField) -> ParsedField -> t -> t1 -> ParsedField +dConv conv def fname s = case conv fname s of + IFNone -> def + other -> other + +{-# INLINE dChr #-} +-- | Parser for an optional single character field with a default value, arguments are: +-- +-- (1) field name +-- +-- (2) default value +-- +-- (3) input +dChr :: String -> Char -> String -> ParsedField +dChr fname def = dConv pChr (IFChar def) fname + +{-# INLINE dInt #-} +-- | Parser for an optional integer field with a default value, arguments are: +-- +-- (1) field name +-- +-- (2) default value +-- +-- (3) input +dInt :: String -> Int -> String -> ParsedField +dInt fname def = dConv pInt (IFInt def) fname + +{-# INLINE dStr #-} +-- | Parser for an optional string field with a default value, arguments are: +-- +-- (1) field name +-- +-- (2) default value +-- +-- (3) input +dStr :: String -> String -> String -> ParsedField +dStr fname def = dConv pStr (IFStr def) fname + +{-# INLINE dDouble #-} +-- | Parser for an optional floating-point field with a default value, arguments are: +-- +-- (1) field name +-- +-- (2) default value +-- +-- (3) input +dDouble :: String -> Double -> String -> ParsedField +dDouble fname def = dConv pDouble (IFDouble def) fname + +-- *** Parsers for mandatory fields +{-# INLINE mandField #-} +-- | Converts an optional field parser into a mandatory field parser that bails on missing input. +-- +-- Arguments are: +-- +-- (1) name of the field type +-- +-- (2) a parser function that takes field name, and input and returns 'ParsedField' +-- +-- A results is a function that takes: +-- +-- (1) field name +-- +-- (2) input +-- +-- and returns a 'ParsedField'. +mandField :: String -> (String -> String -> ParsedField) -> String -> String -> ParsedField +mandField typename ftype fname "" = mandFieldErrMsg typename fname +mandField typename ftype fname s = case ftype fname s of + IFNone -> mandFieldErrMsg typename fname + other -> other + +{-# INLINE mandFieldErrMsg #-} +-- | Return error message when mandatory field is missing. +mandFieldErrMsg typename fname = ifError [typename, " field '", fname, "' is empty or missing!"] + +{-# INLINE mChr #-} +-- | Parser for a mandatory character field with a default value, arguments are: +-- +-- (1) field name +-- +-- (2) input +mChr :: String -> String -> ParsedField +mChr = mandField "Char" pChr +{-# INLINE mDouble #-} +-- | Parser for a mandatory floating-point field with a default value, arguments are: +-- +-- (1) field name +-- +-- (2) input +mDouble :: String -> String -> ParsedField +mDouble = mandField "Double" pDouble +{-# INLINE mStr #-} +-- | Parser for a mandatory string field with a default value, arguments are: +-- +-- (1) field name +-- +-- (2) input +mStr :: String -> String -> ParsedField +mStr = mandField "String" pStr +{-# INLINE mInt #-} +-- | Parser for a mandatory integer field with a default value, arguments are: +-- +-- (1) field name +-- +mInt :: String -> String -> ParsedField +-- (2) input +mInt = mandField "Int" pInt +{-# INLINE mSpc #-} +-- | Parser for a mandatory spacing field, arguments are: +-- +-- (1) number of columns for spacing +-- +-- (2) input +mSpc :: Int -> String -> ParsedField +mSpc l s = if BS.length s == l + then pSpc s + else ifError ["Spacing has different length ", + BS.pack $ show $ BS.length s, + " than expected ", BS.pack $ show l, "."] + +{-# INLINE mKeywords #-} +-- | Parser for a fixed field that can be filled with one of many keywords, arguments are: +-- +-- (1) field name +-- +-- (2) a list of valid keywords +-- +-- (3) input +mKeywords :: String -> [String] -> String -> ParsedField +mKeywords fname kwds s | s `elem` kwds = IFStr s +mKeywords fname kwds s = ifError ["Keyword field '", fname, + "' should contain one of strings: '", + BS.intercalate "', '" kwds, + "' not '", s, "'."] + +{-# INLINE mKeyword #-} +-- | Parser for a fixed single keyword field, arguments are: +-- +-- (1) field name +-- +-- (2) keyword +-- +-- (3) input +mKeyword :: String -> String -> String -> ParsedField +mKeyword fname kwd = mKeywords fname [kwd] + +-- Dissects columns (stage 1) and applies converters (stage 2) +{-# INLINE convertColumns #-} +-- | Dissects columns from stage 1 parsing, and applies converters from stage 2 parsing +-- +-- (1) list of string parsers that return typed 'ParsedField' values +-- +-- (2) list of column numbers that indicate a beginning of each field +-- +-- (3) input +convertColumns :: [String -> ParsedField] -> [Int] -> String -> [ParsedField] +convertColumns convs cols s = map convert (zip convs content) + where + convert (conv, s) = conv s + content = splitByColumns s cols + +{-# INLINE findColumnErrors #-} +-- | Finds IFError values in a list of 'ParsedField' values, and returns +-- a list of error events in case there are any. +-- +-- (1) list of string parsers that return typed 'ParsedField' values +-- +-- (2) list of column numbers that indicate a beginning of each field +-- +-- (3) line number to be injected into error events +-- +-- (4) input +findColumnErrors :: [ParsedField] -> [Int] -> Int -> [PDBEvent] +findColumnErrors fields cols line_no = concatMap findError (zip fields cols) + where + findError (IFError e, c) = [PDBParseError line_no c e] + findError _ = [] + +{-# INLINE parseFields #-} +-- | Uses field declarations that are list of (column number, parser to 'ParsedField', ...) +-- tuples and applies it to a given line of input. +-- +-- Arguments are: +-- +-- (1) field declarations list +-- +-- (2) input line +-- +-- (3) ordinal number of an input line +parseFields fieldDecls line line_no = (fields, errs) + where + fieldTypes = map snd fieldDecls + fieldBounds = map fst fieldDecls + fields :: [ParsedField] = convertColumns fieldTypes fieldBounds line + errs = findColumnErrors fields fieldBounds line_no + +--------------- }}} Stage 2 parsing - type conversions + +--------------- {{{ Stage 2.5 parsing - field groups + +-- ** Stage 2.5 parsing - field grouping + +{-# INLINE nonEmptyIF #-} +-- | Returns if a given 'ParsedField' value _certainly_ represents a missing value. +nonEmptyIF :: ParsedField -> Bool +nonEmptyIF IFNone = False +nonEmptyIF (IFStr "" ) = False +nonEmptyIF _ = True + +{-# INLINE fullIF #-} +-- | Returns if a given 'ParsedField' value _certainly_ represents a present value. +fullIF IFNone = False +fullIF (IFStr s) | BS.all isSpace s = False +fullIF (IFChar ' ') = False +fullIF _ = True + +-- residue description field group +{-# INLINE fgResidue #-} +-- | Merges a set of values that corresponds to a residue description. +-- +-- Arguments are: +-- +-- (1) boolean indicating, if the field group may omit a residue number +-- +-- (2) field group name (description) +-- +-- (3) column number beginning the residue description entries +-- +-- (4) 'ParsedField' containing a three letter residue identifier +-- +-- (5) 'ParsedField' containing a single letter chain identifier +-- +-- (6) 'ParsedField' containing a residue number +-- +-- (7) 'ParsedField' containing a residue insertion code +-- +-- A result is a 'Either' of pair with column number and error message, +-- or 'RESID' value with a residue description. +fgResidue :: Bool -> BS.ByteString -> Int -> ParsedField -> ParsedField -> ParsedField -> ParsedField -> Either (Int, BS.ByteString) RESID +fgResidue delible fname col r c d i = case maybeFgResidue delible fname col r c d i of + Right Nothing -> Left (col, BS.concat [fname, " residue description missing!"]) + Right (Just at) -> Right at + Left (col, s) -> Left (col, s) + +{-# INLINE maybeFgResidue #-} +-- | Merges a set of values that corresponds to an optional residue description. +-- +-- Arguments are: +-- +-- (1) boolean indicating, if the field group may omit a residue number +-- +-- (2) field group name (description) +-- +-- (3) column number beginning the residue description entries +-- +-- (4) 'ParsedField' containing a three letter residue identifier +-- +-- (5) 'ParsedField' containing a single letter chain identifier +-- +-- (6) 'ParsedField' containing a residue number +-- +-- (7) 'ParsedField' containing a residue insertion code +-- +-- A result is a 'Either' of pair with column number and error message, +-- or 'Maybe' 'RESID' value that may contain a residue description. +maybeFgResidue :: Bool -> BS.ByteString -> Int -> ParsedField -> ParsedField -> ParsedField -> ParsedField -> Either (Int, BS.ByteString) (Maybe RESID) +maybeFgResidue delible fname col r c d i + | all nonEmptyIF obligatoryFields = + Right $ Just $ RESID (unr, unc, und, uni) + | any fullIF [r, c, d, i] = + Left + (col, + BS.concat + [fname, " residue descriptions contains fields: ", + BS.pack $ show [r, c, d, i]]) + | otherwise = Right Nothing + where obligatoryFields = if delible then [c, i] else [c, d, i] + IFStr unr = r + IFChar unc = c + IFInt und = d + IFChar uni = i + +{-# INLINE fgAtom #-} +-- | Merges a set of values that correspond to a mandatory atom description. +-- +-- Arguments are: +-- +-- (1) field group name (description) +-- +-- (2) column number beginning the residue description entries +-- +-- (3) 'ParsedField' containing a three letter atom identifier +-- +-- (4) 'ParsedField' containing a three letter residue identifier +-- +-- (5) 'ParsedField' containing a single letter chain identifier +-- +-- (6) 'ParsedField' containing a residue number +-- +-- (7) 'ParsedField' containing a residue insertion code +-- +-- A result is a 'Either' of pair with column number and error message, +-- or 'ATID' value that may contain an atom description. +fgAtom :: BS.ByteString-> Int -> ParsedField-> ParsedField-> ParsedField-> ParsedField-> ParsedField-> Either (Int, BS.ByteString) ATID +fgAtom fname col a r c d i = case maybeFgAtom fname col a r c d i of + Right Nothing -> Left (col, BS.concat [fname, " atom description missing!"]) + Right (Just at) -> Right at + Left (col, s) -> Left (col, s) + +{-# INLINE maybeFgAtom #-} +-- | Merges a set of values that correspond to an optional atom description. +-- +-- Arguments are: +-- +-- (1) field group name (description) +-- +-- (2) column number beginning the residue description entries +-- +-- (3) 'ParsedField' containing a three letter atom identifier +-- +-- (4) 'ParsedField' containing a three letter residue identifier +-- +-- (5) 'ParsedField' containing a single letter chain identifier +-- +-- (6) 'ParsedField' containing a residue number +-- +-- (7) 'ParsedField' containing a residue insertion code +-- +-- A result is a 'Either' of pair with column number and error message, +-- or 'Maybe' 'ATID' value that may contain an atom description. +maybeFgAtom :: BS.ByteString-> Int -> ParsedField-> ParsedField-> ParsedField-> ParsedField-> ParsedField-> Either (Int, BS.ByteString) (Maybe ATID) +maybeFgAtom fname col a r c d i + | all nonEmptyIF [a, r, c, d, i] = + Right $ Just $ ATID (una, unr, unc, und, uni) + | any fullIF [a, r, c, d, i] = + Left + (col, + BS.concat + [fname, " atom descriptions contains fields: ", + BS.pack $ show [a, r, c, d, i]]) + | otherwise = Right Nothing + where IFStr una = a + IFStr unr = r + IFChar unc = c + IFInt und = d + IFChar uni = i + +-- Stage 3 is generation of events - code is separated for each kind of event. + +{-# INLINE lefts #-} +-- | Changes a list of 'Either' values, into a list of all values in 'Left' entries. +lefts :: [Either a b] -> [a] +lefts (Left s:ls) = s:lefts ls +lefts (Right _:ls) = lefts ls +lefts [] = [] + +{-# INLINE liftFgErrs #-} +-- | Extracts Left (column_number, error_message) values from a list of results in a given line, +-- to form 'PDBParseError' events with a given line number, column number and error message. +-- +-- Arguments: +-- +-- (1) line number +-- +-- (2) list of 'Either' (column_number, error_message_string) result values, +-- where 'Left' entries are used to generate error messages. +-- +-- Result is a list of 'PDBEvent' entries that contain 'PDBParseError's (if any.) +liftFgErrs :: Int -> [Either (Int, String) b] -> [PDBEvent] +liftFgErrs line_no errs = map (uncurry $ PDBParseError line_no) (lefts errs) + +{-# INLINE rights #-} +-- | Changes a list of 'Either' values, into a list of all values in 'Right' entries. +rights :: [Either a b] -> [b] +rights (Left _:ls) = rights ls +rights (Right s:ls) = s:rights ls +rights [] = [] +--------------- }}} Stage 2.5 parsing - field groups + +-- | Utility: Changes a list of 'Maybe's to a list of values hidden in 'Just' _ records. +maybeList :: [Maybe a] -> [a] +maybeList [] = [] +maybeList (Nothing:as) = maybeList as +maybeList (Just a :as) = a:maybeList as + +--------------- }}} Parsing abstractions diff --git a/Bio/PDB/EventParser/ParseATOM.hs b/Bio/PDB/EventParser/ParseATOM.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseATOM.hs @@ -0,0 +1,271 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} + +-- | Contains function that parse ATOM and ANISOU records +module Bio.PDB.EventParser.ParseATOM( + parseATOM, + parseANISOU +) where + +import qualified Data.ByteString.Char8 as BS +import Text.Printf(hPrintf) +import Prelude hiding(String) + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions +--------------- {{{ ATOM/HETATM records +{-- +From http://deposit.rcsb.org/adit/docs/pdb_atom_format.html: + 1 - 6 Record name "ATOM " + 7 - 11 Int Atom serial number. +13 - 16 Atom Atom name. +17 Character Alternate location indicator. +18 - 20 Residue name Residue name. +22 Character Chain identifier. +23 - 26 Int Residue sequence number. +27 AChar Code for insertion of residues. +31 - 38 Real(8.3) Orthogonal coordinates for X in Angstroms. +39 - 46 Real(8.3) Orthogonal coordinates for Y in Angstroms. +47 - 54 Real(8.3) Orthogonal coordinates for Z in Angstroms. + +Following is optional for my parser: +55 - 60 Real(6.2) Occupancy. +61 - 66 Real(6.2) Temperature factor (Default = 0.0). + +Following is optional in PDB format? +73 - 76 LString(4) Segment identifier, left-justified. +77 - 78 LString(2) Element symbol, right-justified. +79 - 80 LString(2) Charge on the atom. + +Some programs treat 67-80 as generic "notes" + +Example line +ATOM 282 SG CYS A 40 17.199 10.929 10.237 1.00 7.30 S +--} +-- SHOULD BE ABSTRACTED - but this breaks optimization, and makes code 4x-5x slower +-- List of pairs (ending column, field parser) +--{-# INLINE commonFields #-} +-- fields common to ATOM/HETATM and ANISOU records +{-commonFields keywords middle = + [( 6, mKeywords "Record declaration" keywords), + + -- Atom description + (11, mInt "atom id"), + (16, mStr "atom name"), + (17, mChr "altloc"), + + -- Residue and chain description + (20, mStr "residue name"), -- three letter code + (21, mSpc 1), -- spacing + (22, mChr "chain id"), + (26, mInt "residue number"), + (27, mChr "residue insertion code")] ++ + + middle ++ + + -- Trailing fields optional according to PDB + [(76, pStr "SegId"), + (78, pStr "element"), + (80, pStr "charge") -- useful for MD + ]-} + +--{-# INLINE atomFields #-} +{-atomFields = commonFields ["ATOM ", "HETATM"] [ + -- Coordinates + (38, mDouble "X coordinate"), + (46, mDouble "Y coordinate"), + (54, mDouble "Z coordinate"), + + -- Fields below must be present in a proper PDB entry, + -- but may be absent in theoretical models: + (60, dDouble "occupancy" 1.00), + (66, dDouble "B-factor" 99.99), + (73, pSpc)] -- spacing -} + +{-# INLINE atomFields #-} +atomFields = [ + ( 6, mKeywords "Record declaration" ["ATOM ", "HETATM", "SIGATM"]), + + -- Atom description + (11, mInt "atom id"), + (16, mStr "atom name"), + (17, mChr "altloc"), + + -- Residue and chain description + (20, mStr "residue name"), -- three letter code + (21, mSpc 1), -- spacing + (22, mChr "chain id"), + (26, mInt "residue number"), + (27, mChr "residue insertion code"), + + (38, mDouble "X coordinate"), + (46, mDouble "Y coordinate"), + (54, mDouble "Z coordinate"), + + -- Fields below must be present in a proper PDB entry, + -- but may be absent in theoretical models: + (60, dDouble "occupancy" 1.00), + (66, dDouble "B-factor" 99.99), + --(73, pStr ""), -- Use with GHC 6.12 and earlier to avoid broken optimization: should be pSpc 7 + --(73, pSpc ), -- non-standard, but used by some programs, so we catenate it with SegId field + + (76, pStr "SegId"), + (78, pStr "element"), + (80, pStr "charge")] + +--{- ### INLINE parseATOM #-} -- strangely makes code 7x slower!!! +-- | Parses an ATOM record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +--{-# SPECIALIZE parseATOM :: Bool -> String -> Int -> IO [PDBEvent] #-} +parseATOM :: (Monad m) => String -> Int -> m [PDBEvent] +parseATOM line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields atomFields line line_no + [fRecTag, fAtId, fAtNam, fAltLoc, fResNam, _fSpace, fChain, fResId, fInsid, + fX, fY, fZ, fOcc, fBFact, fSegid, fElt, fCharge] = fields + -- unpack fields + IFStr rectag = fRecTag + IFInt atid = fAtId + IFStr atnam = fAtNam + IFChar altloc = fAltLoc + IFStr resnam = fResNam + IFChar chain = fChain + IFInt resid = fResId + IFChar insid = fInsid + IFDouble x = fX + IFDouble y = fY + IFDouble z = fZ + IFDouble occ = fOcc + IFDouble bFact = fBFact + segid = unstr fSegid + elt = unstr fElt + charge = unstr fCharge + -- assemble record + coords = Vector3 x y z + result = case rectag of + "ATOM " -> ATOM atid atnam resnam chain resid insid altloc coords occ bFact segid elt charge False + "HETATM" -> ATOM atid atnam resnam chain resid insid altloc coords occ bFact segid elt charge True + "SIGATM" -> SIGATM atid atnam resnam chain resid insid altloc coords occ bFact segid elt charge + +--------------- }}} ATOM/HETATM records + +--------------- {{{ ANISOU records +{- +COLUMNS DATA TYPE FIELD DEFINITION +----------------------------------------------------------------- + 1 - 6 Record name "ANISOU" + 7 - 11 Integer serial Atom serial number. +13 - 16 Atom name Atom name. +17 Character altLoc Alternate location indicator +18 - 20 Residue name resName Residue name. +22 Character chainID Chain identifier. +23 - 26 Integer resSeq Residue sequence number. +27 AChar iCode Insertion code. + +29 - 35 Integer u[0][0] U(1,1) +36 - 42 Integer u[1][1] U(2,2) +43 - 49 Integer u[2][2] U(3,3) +50 - 56 Integer u[0][1] U(1,2) +57 - 63 Integer u[0][2] U(1,3) +64 - 70 Integer u[1][2] U(2,3) + +77 - 78 LString(2) element Element symbol, right-justified. +79 - 80 LString(2) charge Charge on the atom. +-} + +--{-# INLINE anisouFields #-} +{-anisouFields = commonFields ["ANISOU"] [ + (29, mSpc 2), + (35, mInt "U(1,1)"), + (42, mInt "U(2,2)"), + (49, mInt "U(3,3)"), + (56, mInt "U(1,2)"), + (63, mInt "U(1,3)"), + (70, mInt "U(2,3)"), + (76, mSpc 6)]-} + +{-# INLINE anisouFields #-} +anisouFields = [ + ( 6, mKeywords "Record declaration" ["ANISOU", "SIGUIJ"]), + + -- Atom description + (11, mInt "atom id"), + (16, mStr "atom name"), + (17, mChr "altloc"), + + -- Residue and chain description + (20, mStr "residue name"), -- three letter code + (21, mSpc 1), -- spacing + (22, mChr "chain id"), + (26, mInt "residue number"), + (27, mChr "residue insertion code"), + + (29, mSpc 2), + (35, mInt "U(1,1)"), + (42, mInt "U(2,2)"), + (49, mInt "U(3,3)"), + (56, mInt "U(1,2)"), + (63, mInt "U(1,3)"), + (70, mInt "U(2,3)"), + (75, pSpc ), -- use pStr "" with GHC<=6.12 to avoid broken optimization + + (76, pStr "SegId"), + (78, pStr "element"), + (80, pStr "charge")] + + +{-# INLINE parseANISOU #-} +-- | Parses an ANISOU record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseANISOU :: (Monad m) => String -> Int -> m [PDBEvent] +parseANISOU line line_no = return $ if errs == [] then result `seq` [result] else errs + where + -- parse + (fields, errs) = parseFields anisouFields line line_no + [fRecTag, fAtId, fAtNam, fAltLoc, fResNam, _fSpace, fChain, fResId, fInsid, + _, fU_1_1, fU_2_2, fU_3_3, fU_1_2, fU_1_3, fU_2_3, _, + fSegid, fElt, fCharge] = fields + -- unpack fields + IFStr rectag = fRecTag + IFInt atid = fAtId + IFStr atnam = fAtNam + IFChar altloc = fAltLoc + IFStr resnam = fResNam + IFChar chain = fChain + IFInt resid = fResId + IFChar insid = fInsid + IFInt u_1_1 = fU_1_1 + IFInt u_2_2 = fU_2_2 + IFInt u_3_3 = fU_3_3 + IFInt u_1_2 = fU_1_2 + IFInt u_1_3 = fU_1_3 + IFInt u_2_3 = fU_2_3 + segid = unstr fSegid + elt = unstr fElt + charge = unstr fCharge + -- assemble record + cons = case rectag of + "ANISOU" -> ANISOU + "SIGUIJ" -> SIGUIJ + result = cons atid atnam + resnam chain resid insid altloc + u_1_1 u_2_2 u_3_3 u_1_2 u_1_3 u_2_3 + segid elt charge + +--------------- }}} ANISOU records diff --git a/Bio/PDB/EventParser/ParseCAVEAT.hs b/Bio/PDB/EventParser/ParseCAVEAT.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseCAVEAT.hs @@ -0,0 +1,59 @@ +{---# LANGUAGE PatternGuards #-} +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} + +-- | Parsing CAVEAT records. +module Bio.PDB.EventParser.ParseCAVEAT(parseCAVEAT) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ CAVEAT records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +--------------------------------------------------------------------------------------- + 1 - 6 Record name "CAVEAT" + 9 - 10 Continuation continuation Allows concatenation of multiple records. +12 - 15 IDcode idCode PDB ID code of this entry. +20 - 79 String comment Free text giving the reason for the CAVEAT. +--} + +{-# INLINE caveatFields #-} +caveatFields = [(6, mKeyword "record header" "CAVEAT"), + (8, mSpc 2 ), + (10, dInt "continuation" 0 ), + (11, mSpc 1 ), + (15, mStr "PDB entry id code" ), + (19, mSpc 4 ), + (79, mStr "comment" )] + +-- | Parses a CAVEAT record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +parseCAVEAT :: (Monad m) => String -> Int -> m [PDBEvent] +-- Result is a monad action returning a list of 'PDBEvent's. +parseCAVEAT line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields caveatFields line line_no + [fRec, _, fCont, _, fPDBId, _, fComment] = fields + IFInt cont = fCont + IFStr pdbid = fPDBId + IFStr comment = fComment + + -- unpack fields + result = CAVEAT cont pdbid comment + +--------------- }}} CAVEAT records + diff --git a/Bio/PDB/EventParser/ParseCISPEP.hs b/Bio/PDB/EventParser/ParseCISPEP.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseCISPEP.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, BangPatterns #-} + +-- | Parsing a CISPEP record. +module Bio.PDB.EventParser.ParseCISPEP(parseCISPEP) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ CISPEP records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +------------------------------------------------------------------------- + 1 - 6 Record name "CISPEP" + 8 - 10 Integer serNum Record serial number. +12 - 14 LString(3) pep1 Residue name. +16 Character chainID1 Chain identifier. +18 - 21 Integer seqNum1 Residue sequence number. +22 AChar icode1 Insertion code. +26 - 28 LString(3) pep2 Residue name. +30 Character chainID2 Chain identifier. +32 - 35 Integer seqNum2 Residue sequence number. +36 AChar icode2 Insertion code. +44 - 46 Integer modNum Identifies the specific model. +54 - 59 Real(6.2) measure Angle measurement in degrees. +--} + +{-# INLINE cispepFields #-} +cispepFields = [(6, mKeyword "record header" "CISPEP" ), + (7, mSpc 1 ), + (10, mInt "record serial number" ), + (11, mSpc 1 ), + (14, mStr "residue name in first peptide" ), + (15, mSpc 1 ), + (16, mChr "chain id" ), + (17, mSpc 1 ), + (21, mInt "residue sequence number" ), + (22, mChr "insertion code" ), + (25, mSpc 3 ), + (28, mStr "residue name in second peptide" ), + (29, mSpc 1 ), + (30, mChr "chain id" ), + (31, mSpc 1 ), + (35, mInt "residue sequence number" ), + (36, mChr "insertion code" ), + (43, pSpc ), + (46, dInt "model identifier" 1 ), + (53, pSpc ), + (59, pDouble "angle measurement" )] + +-- | Parses a CISPEP record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseCISPEP :: (Monad m) => String -> Int -> m [PDBEvent] +parseCISPEP line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + errs = fErrs ++ fgErrs + (fields, fErrs) = parseFields cispepFields line line_no + [fRec, _, fSerial, _, + fResname1, _, fChain1, _, fResnum1, fInsCode1, _, + fResname2, _, fChain2, _, fResnum2, fInsCode2, _, + fModNum, _, fAngle] = fields + IFInt serial = fSerial + IFInt modnum = fModNum + angle = case fAngle of + IFDouble !f -> Just f + IFNone -> Nothing + + fgRes1 = fgResidue False "residue 1" 14 fResname1 fChain1 fResnum1 fInsCode1 + fgRes2 = fgResidue False "residue 2" 28 fResname2 fChain2 fResnum2 fInsCode2 + fgErrs = liftFgErrs line_no [fgRes1, fgRes2] + [res1, res2] = rights [fgRes1, fgRes2] + + -- unpack fields + result = CISPEP serial res1 res2 modnum angle + +--------------- }}} CISPEP/CISPEPSYN records + diff --git a/Bio/PDB/EventParser/ParseCONECT.hs b/Bio/PDB/EventParser/ParseCONECT.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseCONECT.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} + +-- | Parsing CONECT records. +module Bio.PDB.EventParser.ParseCONECT(parseCONECT) +where + +import qualified Data.ByteString.Char8 as BS +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ CONECT records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +---------------------------------------------------------------------------------- + 1 - 6 Record name "CONECT" + 7 - 11 Int serial Atom serial number +12 - 16 Int serial Serial number of bonded atom +17 - 21 Int serial Serial number of bonded atom +22 - 26 Int serial Serial number of bonded atom +27 - 31 Int serial Serial number of bonded atom +--} + +{-# INLINE conectFields #-} +conectFields = [(6, mKeyword "record header" "CONECT"), + (11, mInt "atom serial number" ), + (16, mInt "atom serial number" ), + (21, pInt "atom serial number" ), + (26, pInt "atom serial number" ), + (31, pInt "atom serial number" )] + +{-# INLINE intList #-} +intList (IFInt i:ls) = i:intList ls +intList (IFNone :ls) = intList ls +intList [] = [] + +-- | Parses a CONECT record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseCONECT :: (Monad m) => BS.ByteString -> Int -> m [PDBEvent] +parseCONECT line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields conectFields line line_no + [fRec, fS1, fS2, fS3, fS4, fS5] = fields + serials = intList [fS1, fS2, fS3, fS4, fS5] + -- unpack fields + result = CONECT { atoms = serials } + +--------------- }}} CONECT records + diff --git a/Bio/PDB/EventParser/ParseCRYST1.hs b/Bio/PDB/EventParser/ParseCRYST1.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseCRYST1.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Parsing CRYST1 records. +module Bio.PDB.EventParser.ParseCRYST1(parseCRYST1) +where + +import qualified Data.ByteString.Char8 as BS +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ CRYST1 records +{-- +COLUMNS DATA TYPE CONTENTS +-------------------------------------------------------------------------------- + 1 - 6 Record name "CRYST1" + 7 - 15 Real(9.3) a (Angstroms) +16 - 24 Real(9.3) b (Angstroms) +25 - 33 Real(9.3) c (Angstroms) +34 - 40 Real(7.2) alpha (degrees) +41 - 47 Real(7.2) beta (degrees) +48 - 54 Real(7.2) gamma (degrees) +56 - 66 LString Space group +67 - 70 Integer Z value +--} + +crystFields = [(6, mKeyword "record header" "CRYST1"), + (7, mSpc 1), + (15, mDouble "a" ), + (24, mDouble "b" ), + (33, mDouble "c" ), + (40, mDouble "alpha" ), + (47, mDouble "beta" ), + (54, mDouble "gamma" ), + (55, mSpc 1), + (66, mStr "space group" ), + (70, mInt "Z value" )] + +-- | Parses a CRYST1 record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +{-# SPECIALIZE parseCRYST1 :: BS.ByteString -> Int -> IO [PDBEvent] #-} +parseCRYST1 :: (Monad m) => BS.ByteString -> Int -> m [PDBEvent] +parseCRYST1 line line_no = return $ if errs == [] + then [result] + else errs--} + where + -- parse + (fields, errs) = parseFields crystFields line line_no + [fRec, fSpc1, fA, fB, fC, fAlpha, fBeta, fGamma, fSpc2, fSpcGrp, fZValue] = fields + -- unpack fields + IFDouble a = fA + IFDouble b = fB + IFDouble c = fC + IFDouble alpha = fAlpha + IFDouble beta = fBeta + IFDouble gamma = fGamma + IFStr spcGrp = fSpcGrp + IFInt zValue = fZValue + result = CRYST1 a b c alpha beta gamma spcGrp zValue + +--------------- }}} CRYST1 records + diff --git a/Bio/PDB/EventParser/ParseDBREF.hs b/Bio/PDB/EventParser/ParseDBREF.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseDBREF.hs @@ -0,0 +1,237 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, BangPatterns #-} + +-- Parsing cross-references to other databases. +module Bio.PDB.EventParser.ParseDBREF(parseDBREF, parseDBREF12) +where + +import qualified Data.ByteString.Char8 as BS +import Data.Char(ord,chr) +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ DBREF records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +----------------------------------------------------------------------------------- + 1 - 6 Record name "DBREF " + 8 - 11 IDcode idCode ID code of this entry. +13 Character chainID Chain identifier. +15 - 18 Integer seqBegin Initial sequence number of the + PDB sequence segment. +19 AChar insertBegin Initial insertion code of the + PDB sequence segment. +21 - 24 Integer seqEnd Ending sequence number of the + PDB sequence segment. +25 AChar insertEnd Ending insertion code of the + PDB sequence segment. +27 - 32 LString database Sequence database name. +34 - 41 LString dbAccession Sequence database accession code. +43 - 54 LString dbIdCode Sequence database identification code. +56 - 60 Integer dbseqBegin Initial sequence number of the + database seqment. +61 AChar idbnsBeg Insertion code of initial residue of the + segment, if PDB is the reference. +63 - 67 Integer dbseqEnd Ending sequence number of the + database segment. +68 AChar dbinsEnd Insertion code of the ending residue of + the segment, if PDB is the reference. + +Database name (columns 27 – 32) +---------------------------------------------------------------------- +GenBank GB +Protein Data Bank PDB +UNIPROT UNP +Norine NORINE + +--} + +-- | Fields of a DBREF record. +dbrefFields = [( 6, mKeyword "record id" "DBREF "), + ( 7, mSpc 1), + (11, mStr "id code"), + (12, mSpc 1), + (13, mChr "chain id"), + (14, mSpc 1), + (18, mInt "initial sequence number of PDB sequence segment"), + (19, mChr "initial insertion code of the PDB sequence segment"), + (20, mSpc 1), + (24, mInt "ending sequence number of the PDB sequence segment"), + (25, mChr "ending insertion code of the PDB sequence segment"), + (26, mSpc 1), + (32, mStr "sequence database name"), + (33, mSpc 1), + (41, mStr "sequence database accession code"), + (42, mSpc 1), + (54, mStr "sequence database identification code"), + (55, mSpc 1), + (60, mInt "initial sequence number of the database segment"), + (61, dChr "insertion code of initial residue of the sequence, if PDB is the reference" ' '), + (62, mSpc 1), + (67, mInt "ending sequence number of the database segment"), + (68, dChr "insertion code of the ending residue of the segment, if PDB is the reference" ' ')] + +-- | Parses a DBREF record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +{-# SPECIALIZE parseDBREF :: BS.ByteString -> Int -> IO [PDBEvent] #-} +parseDBREF :: (Monad m) => BS.ByteString -> Int -> m [PDBEvent] +parseDBREF line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields dbrefFields line line_no + [fRec, _, fIdCode, _, fChain, _, fIniSeqNumPDB, fIniInsCodePDB, _, + fEndSeqNumPDB, fEndInsCodePDB, _, + fSeqDbName, _, fSeqDbAccCode, _, fSeqDbIdCode, _, fIniSeqNumInDb, + fIniInsCodeInPDBRef, _, fEndSeqNumInDb, fEndInsCodeInPDBRef] = fields + -- unpack fields + IFStr idCode = fIdCode + IFChar chain = fChain + IFInt iniSeqNumPDB = fIniSeqNumPDB + IFChar iniInsCodePDB = fIniInsCodePDB + IFInt endSeqNumPDB = fEndSeqNumPDB + IFChar endInsCodePDB = fEndInsCodePDB + IFStr seqDbName = fSeqDbName + IFStr seqDbAccCode = fSeqDbAccCode + IFStr seqDbIdCode = fSeqDbIdCode + IFInt iniSeqNumInDb = fIniSeqNumInDb + IFChar iniInsCodeInPDBRef = fIniInsCodeInPDBRef + IFInt endSeqNumInDb = fEndSeqNumInDb + IFChar endInsCodeInPDBRef = fEndInsCodeInPDBRef + + result = DBREF idCode chain iniSeqNumPDB iniInsCodePDB endSeqNumPDB endInsCodePDB seqDbName seqDbAccCode seqDbIdCode iniSeqNumInDb iniInsCodeInPDBRef endSeqNumInDb endInsCodeInPDBRef + + +-- DBREF1/2 is just DBREF split into two lines, when accession number is too long +{- +COLUMNS DATA TYPE FIELD DEFINITION +----------------------------------------------------------------------------------- + 1 - 6 Record name "DBREF1" + 8 - 11 IDcode idCode ID code of this entry. +13 Character chainID Chain identifier. +15 - 18 Integer seqBegin Initial sequence number of the + PDB sequence segment, right justified. +19 AChar insertBegin Initial insertion code of the + PDB sequence segment. +21 - 24 Integer seqEnd Ending sequence number of the + PDB sequence segment, right justified. +25 AChar insertEnd Ending insertion code of the + PDB sequence segment. +27 - 32 LString database Sequence database name. +48 - 67 LString dbIdCode Sequence database identification code, + left justified. + +DBREF2 + +COLUMNS DATA TYPE FIELD DEFINITION +----------------------------------------------------------------------------------- + 1 - 6 Record name "DBREF2" + 8 - 11 IDcode idCode ID code of this entry. +13 Character chainID Chain identifier. +19 - 40 LString dbAccession Sequence database accession code, + left justified. +46 - 55 Integer seqBegin Initial sequence number of the + Database segment, right justified. +58 - 67 Integer seqEnd Ending sequence number of the + Database segment, right justified. + +We assume that they occur in consecutive lines. +-} +-- | List of fields in DBREF1 line +dbref1Fields = [( 6, mKeyword "record id" "DBREF1"), + ( 7, mSpc 1), + (11, mStr "id code"), + (12, mSpc 1), + (13, mChr "chain id"), + (14, mSpc 1), + (18, mInt "initial sequence number of PDB sequence segment"), + (19, mChr "initial insertion code of the PDB sequence segment"), + (20, mSpc 1), + (24, mInt "ending sequence number of the PDB sequence segment"), + (25, mChr "ending insertion code of the PDB sequence segment"), + (26, mSpc 1), + (32, mStr "sequence database name"), + (47, mSpc 15), + (67, mStr "sequence database identification code")] + +-- | List of fields in DBREF2 line. +dbref2Fields = [( 6, mKeyword "record id" "DBREF2"), + ( 7, mSpc 1), + (11, mStr "id code"), + (12, mSpc 1), + (13, mChr "chain id"), + (18, mSpc 5), + (40, mStr "sequence database accession code"), + (45, mSpc 5), + (55, mInt "initial sequence number of the database segment"), + (58, mSpc 3), + (67, mInt "ending sequence number of the database segment")] + +-- | Checks agreement between DBREF1 and DBREF2. +checkEqs line_no [] = [] +checkEqs line_no ((a, b, col_no):eqs) = if trim a /= trim b + then + PDBParseError line_no col_no + (BS.intercalate "" + ["Fields of consecutive ", + "DBREF1/DBREF2 records don't agree: '", + a, "' /= '", b, "'."]): rest + else + rest + where rest = checkEqs line_no eqs + + +-- | Parses a pair of DBREF1 and DBREF2 records. +-- +-- Arguments: +-- +-- (1) two input lines as a tuple +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +{-# SPECIALIZE parseDBREF12 :: (BS.ByteString, BS.ByteString) -> Int -> IO [PDBEvent] #-} +parseDBREF12 :: (Monad m) => (BS.ByteString, BS.ByteString) -> Int -> m [PDBEvent] +parseDBREF12 (!line1, !line2) !line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields1, errs1) = parseFields dbref1Fields line1 line_no + (fields2, errs2) = parseFields dbref2Fields line2 (line_no + 1) + errs = errs1 ++ errs2 ++ mergeErrs + [fRec1, _, fIdCode1, _, fChain1, _, fIniSeqNumPDB, fIniInsCodePDB, _, + fEndSeqNumPDB, fEndInsCodePDB, _, + fSeqDbName, _, fSeqDbIdCode] = fields1 + [fRec2, _, fIdCode2, _, fChain2, _, fSeqDbAccCode, _, fIniSeqNumInDb, + _, fEndSeqNumInDb] = fields2 + -- unpack fields + IFStr idCode1 = fIdCode1 + IFStr idCode2 = fIdCode1 + IFChar chain1 = fChain1 + IFChar chain2 = fChain2 + IFInt iniSeqNumPDB = fIniSeqNumPDB + IFChar iniInsCodePDB = fIniInsCodePDB + IFInt endSeqNumPDB = fEndSeqNumPDB + IFChar endInsCodePDB = fEndInsCodePDB + IFStr seqDbName = fSeqDbName + IFStr seqDbAccCode = fSeqDbAccCode + IFStr seqDbIdCode = fSeqDbIdCode + IFInt iniSeqNumInDb = fIniSeqNumInDb + IFInt endSeqNumInDb = fEndSeqNumInDb + mergeErrs = checkEqs (line_no + 1) [(idCode1, idCode2, 11), + (BS.singleton chain1, BS.singleton chain2, 13)] + + result = DBREF idCode1 chain1 iniSeqNumPDB iniInsCodePDB endSeqNumPDB endInsCodePDB + seqDbName seqDbAccCode seqDbIdCode iniSeqNumInDb ' ' endSeqNumInDb ' ' + +--------------- }}} DBREF records + diff --git a/Bio/PDB/EventParser/ParseFORMUL.hs b/Bio/PDB/EventParser/ParseFORMUL.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseFORMUL.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} + +-- | Parsing FORMUL records. +module Bio.PDB.EventParser.ParseFORMUL(parseFORMUL) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ FORMUL records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +----------------------------------------------------------------------- + 1 - 6 Record name "FORMUL" + 9 - 10 Integer compNum Component number. +13 - 15 LString(3) formulID Het identifier. +17 - 18 Integer continuation Continuation number. +19 Character asterisk "*" for water. +20 - 70 String text Chemical formula. +--} + +{-# INLINE formulFields #-} +formulFields = [(6, mKeyword "record header" "FORMUL"), + (8, mSpc 2 ), + (10, mInt "component number" ), + (12, mSpc 2 ), + (15, mStr "hetero group identifier" ), + (16, mSpc 1 ), + (18, dInt "continuation" 0 ), + (19, mChr "asterisk for water" ), + (70, mStr "chemical formula" )] + +-- | Parses a FORMUL record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseFORMUL :: (Monad m) => String -> Int -> m [PDBEvent] +parseFORMUL line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + errs = fErrs ++ watErr + (fields, fErrs) = parseFields formulFields line line_no + [fRec, _, fCompNum, _, fHetId, _, fCont, fAsterisk, fFormula] = fields + IFInt compNum = fCompNum + IFStr hetId = fHetId + IFInt cont = fCont + IFChar asterisk = fAsterisk + IFStr formula = fFormula + + watErr = if asterisk `elem` " *" + then [] + else [PDBParseError line_no 19 $ + BS.concat ["Expecting asterisk for water or space, but found: '", + BS.pack [asterisk], "'."]] + isWater = asterisk == '*' + + -- unpack fields + result = FORMUL compNum hetId cont isWater [formula] + +--------------- }}} FORMUL/FORMULSYN records + diff --git a/Bio/PDB/EventParser/ParseHEADER.hs b/Bio/PDB/EventParser/ParseHEADER.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseHEADER.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Parsing HEADER records. +module Bio.PDB.EventParser.ParseHEADER(parseHEADER) +where + +import qualified Data.ByteString.Char8 as BS +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + +--------------- {{{ HEADER records +{-- + 1 - 6 Record name "HEADER" + +11 - 50 String(40) classification Classifies the molecule(s). +51 - 59 Date depDate Deposition date. This is the date the + coordinates were received at the PDB. + +63 - 66 IDcode idCode This identifier is unique within the PDB. +--} + +headerFields = [(6, mKeyword "header" "HEADER"), + (10, mSpc 4 ), + (50, dStr "classification" "" ), + (59, dStr "depDate" "" ), + (62, mSpc 3 ), + (66, dStr "idCode" "" )] + +-- | Parses a HEADER record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseHEADER :: (Monad m) => BS.ByteString -> Int -> m [PDBEvent] +parseHEADER line line_no = return $ if errs == [] then [result] else errs + where + -- parse + (fields, errs) = parseFields headerFields line line_no + [fRec, fSpc1, fClass, fDepDate, fSpc2, fIdCode] = fields + -- unpack fields + IFStr clas = fClass + IFStr depDate = fDepDate + IFStr idCode = fIdCode + result = HEADER { classification = clas, + depDate = depDate, + idCode = idCode } +--------------- }}} HEADER records + diff --git a/Bio/PDB/EventParser/ParseHELIX.hs b/Bio/PDB/EventParser/ParseHELIX.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseHELIX.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Parsing HELIX records. +module Bio.PDB.EventParser.ParseHELIX(parseHELIX) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.HelixTypes +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ HELIX records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +----------------------------------------------------------------------------------- + 1 - 6 Record name "HELIX " + 8 - 10 Integer serNum Serial number of the helix. This starts + at 1 and increases incrementally. +12 - 14 LString(3) helixID Helix identifier. In addition to a serial + number, each helix is given an + alphanumeric character helix identifier. +16 - 18 Residue name initResName Name of the initial residue. +20 Character initChainID Chain identifier for the chain containing + this helix. +22 - 25 Integer initSeqNum Sequence number of the initial residue. +26 AChar initICode Insertion code of the initial residue. +28 - 30 Residue name endResName Name of the terminal residue of the helix. +32 Character endChainID Chain identifier for the chain containing + this helix. +34 - 37 Integer endSeqNum Sequence number of the terminal residue. +38 AChar endICode Insertion code of the terminal residue. +39 - 40 Integer helixClass Helix class (see below). +41 - 70 String comment Comment about this helix. +72 - 76 Integer length Length of this helix. +--} + +helixFields = [(6, mKeyword "record header" "HELIX " ), + (7, mSpc 1 ), + (10, mInt "serial number" ), + (11, mSpc 1 ), + (14, mStr "helix id" ), + (15, mSpc 1 ), + (18, mStr "initial residue name" ), + (19, mSpc 1 ), + (20, mChr "initial chain id" ), + (21, mSpc 1 ), + (25, mInt "initial residue serial number"), + (26, mChr "initial insertion code" ), + (27, mSpc 1 ), + (30, mStr "end residue name" ), + (31, mSpc 1 ), + (32, mChr "end chain id" ), + (33, mSpc 1 ), + (37, mInt "end residue serial number" ), + (38, mChr "end residue insertion code" ), + (40, mInt "helix class" ), + (70, mStr "comment" ), + (72, mSpc 2 ), + (76, mInt "length" )] + +-- | Parses a HET record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseHELIX :: (Monad m) => String -> Int -> m [PDBEvent] +parseHELIX line line_no = --return [Test $ BS.pack $ show $ ((length helixFields)::Int)] + return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, fErrs) = parseFields helixFields line line_no + [fRec, _, fSerial, _, fHelixId, _, + fIniResName, _, fIniChain, _, fIniResId, fIniResIns, _, + fEndResName, _, fEndChain, _, fEndResId, fEndResIns, + fHelixClass, fComment, _, fLength] = fields + -- unpack fields + IFInt serial = fSerial + IFStr helixId = fHelixId + + IFStr iniResName = fIniResName + IFChar iniChain = fIniChain + IFInt iniResId = fIniResId + IFChar iniResIns = fIniResIns + fgIniRes = fgResidue False "initial" line_no fIniResName fIniChain fIniResId fIniResIns + Right iniRes = fgIniRes + + IFStr endResName = fEndResName + IFChar endChain = fEndChain + IFInt endResId = fEndResId + IFChar endResIns = fEndResIns + fgEndRes = fgResidue False "ending" line_no fEndResName fEndChain fEndResId fEndResIns + Right endRes = fgEndRes + + errs = fErrs ++ liftFgErrs line_no [fgEndRes, fgIniRes] + + IFInt helixClass = fHelixClass + IFStr comment = fComment + IFInt len = fLength + -- assuming residue name won't contain spaces... + result = HELIX serial iniRes + endRes + (code2helix helixClass) comment len + +--------------- }}} HELIX records + diff --git a/Bio/PDB/EventParser/ParseHET.hs b/Bio/PDB/EventParser/ParseHET.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseHET.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} + +-- | Parsing of HET records. +module Bio.PDB.EventParser.ParseHET(parseHET) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ HET/HETSYN records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +--------------------------------------------------------------------------------- + 1 - 6 Record name "HET " + 8 - 10 LString(3) hetID Het identifier, right-justified. +13 Character ChainID Chain identifier. +14 - 17 Integer seqNum Sequence number. +18 AChar iCode Insertion code. +21 - 25 Integer numHetAtoms Number of HETATM records for the group + present in the entry. +31 - 70 String text Text describing Het group. +--} + +{-# INLINE hetFields #-} +hetFields = [(6, mKeyword "record header" "HET " ), + (7, mSpc 1 ), + (10, mStr "hetero group identifier" ), + (12, mSpc 2 ), + (13, mChr "chain identifier" ), + (17, mInt "sequence number" ), + (18, mChr "insertion code" ), + (20, mSpc 2 ), + (25, mInt "number of HETATM records per group" ), + (30, pSpc ), + (70, pStr "text describing HET group" )] + +-- | Parses a HET record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseHET :: (Monad m) => String -> Int -> m [PDBEvent] +parseHET line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields hetFields line line_no + [fRec, _, fHetId, _, fChain, fSeqNum, fInsCode, _, fAtmNum, _, fText] = fields + IFStr hetId = fHetId + IFChar chain = fChain + IFInt seqNum = fSeqNum + IFChar insCode = fInsCode + IFInt atmNum = fAtmNum + IFStr text = fText + + -- unpack fields + result = HET hetId chain seqNum insCode atmNum text + +--------------- }}} HET/HETSYN records + diff --git a/Bio/PDB/EventParser/ParseHETNAM.hs b/Bio/PDB/EventParser/ParseHETNAM.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseHETNAM.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} + +-- | Parse HETNAM and HETSYN records +module Bio.PDB.EventParser.ParseHETNAM(parseHETNAM) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ HETNAM/HETSYN records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +---------------------------------------------------------------------------- + 1 - 6 Record name "HETNAM" or "HETSYN" + 9 - 10 Continuation continuation Allows concatenation of multiple records. +12 - 14 LString(3) hetID Het identifier, right-justified. +16 - 70 String text Chemical name. +--} + +{-# INLINE hetnamFields #-} +hetnamFields = [(6, mKeywords "record header" ["HETNAM", "HETSYN"]), + (8, mSpc 2 ), + (10, dInt "continuation" 0 ), + (11, mSpc 1 ), + (14, mStr "Het identifier, right-justified" ), + (15, mSpc 1 ), + (70, mStr "chemical name" )] + +-- | Parses a HETNAM or HETSYN record. +-- +-- Arguments: +-- +-- (1) boolean indicating, if it is HETNAM ('True') or HETSYN ('False') record +-- +-- (2) input line +-- +-- (3) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseHETNAM :: (Monad m) => Bool -> String -> Int -> m [PDBEvent] +parseHETNAM isNameNotSynonym line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields hetnamFields line line_no + [fRec, _, fCont, _, fHetId, _, fName] = fields + IFInt cont = fCont + IFStr hetId = fHetId + IFStr name = fName + + -- unpack fields + result = HETNAM cont hetId name isNameNotSynonym + +--------------- }}} HETNAM/HETSYN records + diff --git a/Bio/PDB/EventParser/ParseHYDBND.hs b/Bio/PDB/EventParser/ParseHYDBND.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseHYDBND.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} + +-- | Parsing hydrogen bond records. +module Bio.PDB.EventParser.ParseHYDBND(parseHYDBND) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ HYDBND records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +--------------------------------------------------------------------------------- + 1 - 6 Record name "HYDBND" +13 - 16 Atom name1 Atom name. +17 Character altLoc1 Alternate location indicator. +18 - 20 Residue name resName1 Residue name. +22 Character Chain1 Chain identifier. +23 - 27 Integer resSeq1 Residue sequence number. +28 AChar ICode1 Insertion code. +30 - 33 Atom nameH Hydrogen atom name. +34 Character altLocH Alternate location indicator. +36 Character ChainH Chain identifier. +37 - 41 Integer resSeqH Residue sequence number. +42 AChar iCodeH Insertion code. +44 - 47 Atom name2 Atom name. +48 Character altLoc2 Alternate location indicator. +49 - 51 Residue name resName2 Residue name. +53 Character chainID2 Chain identifier. +54 - 58 Integer resSeq2 Residue sequence number. +59 AChar iCode2 Insertion code. +60 - 65 SymOP sym1 Symmetry operator for 1st +67 - 72 SymOP sym2 Symmetry operator for 2nd + non-hydrogen atom. +--} + +{-# INLINE hydbndFields #-} +hydbndFields = [(6, mKeyword "record header" "HYDBND" ), + (12, mSpc 6 ), + (16, mStr "first atom name" ), + (17, mChr "alternate location indicator 1" ), + (20, mStr "residue name 1" ), + (21, mSpc 1 ), + (22, mChr "chain identifier 1" ), + (27, mInt "residue 1 sequence number" ), + (28, mChr "insertion code" ), + (29, mSpc 1 ), + (33, mStr "hydrogen atom name" ), + (34, mChr "hydrogen atom alternate location indicator"), + (35, mSpc 1 ), + (36, mChr "hydrogen atom chain identifier" ), + (41, dInt "hydrogen atom residue sequence number" (-1)), + (42, mChr "hydrogen atom insertion code" ), + (43, mSpc 1 ), + (47, mStr "second atom name" ), + (48, mChr "alternate location indicator 2" ), + (51, mStr "residue name 2" ), + (52, mSpc 1 ), + (53, mChr "chain identifier 2" ), + (58, mInt "residue sequence number 2" ), + (59, dChr "insertion code 2" ' ' ), + (65, pStr "symmetry operator for residue 1" ), + (66, pSpc ), + (72, pStr "symmetry operator for residue 2" )] + +-- | Parses a HYDBND record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseHYDBND :: (Monad m) => String -> Int -> m [PDBEvent] +parseHYDBND line line_no = return $ if errs == [] + then [result] + else errs -- return $ [PDBParseError 0 0 $ BS.pack $ show $ Prelude.length fields] + where + -- parse + errs = fErrs ++ fgErrs + (fields, fErrs) = parseFields hydbndFields line line_no + [fRec, _, + fAtomName1, fAltLoc1, fResname1, _, fChain1, fResnum1, fInsCode1, _, + fAtomNameH, fAltLocH, _, fChainH, fResnumH, fInsCodeH, _, + fAtomName2, fAltLoc2, fResname2, _, fChain2, fResnum2, fInsCode2, + fSymOp1, _, fSymOp2] = fields + IFChar altloc1 = fAltLoc1 + IFChar altlocH = fAltLocH + IFChar altloc2 = fAltLoc2 + IFStr symOp1 = fSymOp1 + IFStr symOp2 = fSymOp2 + + fgErrs = liftFgErrs line_no [fgAtom1, fgAtomH, fgAtom2] + fgAtom1 = fgAtom "first atom of HYDBND" 16 fAtomName1 fResname1 fChain1 fResnum1 fInsCode1 + fgAtomH = fgAtom "hydrogen atom of HYDBND" 33 fAtomName1 fResname1 fChainH fResnumH fInsCodeH + fgAtom2 = fgAtom "second atom of HYDBND" 47 fAtomName1 fResname1 fChain2 fResnum2 fInsCode2 + [atom1, atomH, atom2] = rights [fgAtom1, fgAtomH, fgAtom2] + + -- unpack fields + result = HYDBND atom1 altloc1 atomH altlocH atom2 altloc2 symOp1 symOp2 + +--------------- }}} HYDBND records + diff --git a/Bio/PDB/EventParser/ParseIntRecord.hs b/Bio/PDB/EventParser/ParseIntRecord.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseIntRecord.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoMonomorphismRestriction #-} + +-- | Parsing of records with a single integer value: NUMMDL and MODEL. +module Bio.PDB.EventParser.ParseIntRecord(parseNUMMDL,parseMODEL) +where + +import Prelude hiding (String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ NUMMDL or MODEL records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +------------------------------------------------------------------------------------ + 1 - 6 Record name "NUMMDL" or "MODEL " +11 - 14 Int modelNumber Number of models. +--} + +nummdlFields = [(6, mKeywords "record header" ["NUMMDL", "MODEL "]), + (10, mSpc 4 ), + (80, mInt "number" )] + +-- | Parses a record with a single integer. +-- +-- Arguments: +-- +-- (1) constructor +-- +-- (2) input line +-- +-- (3) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseIntRecord :: (Monad m) => (Int -> PDBEvent) -> String -> Int -> m [PDBEvent] +parseIntRecord cons line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields nummdlFields line line_no + [fRec, fSpc, fNumber] = fields + -- unpack fields + IFInt num = fNumber + result = cons num + +-- | Parses a NUMMDL record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseNUMMDL :: (Monad m) => String -> Int -> m [PDBEvent] +parseNUMMDL = parseIntRecord NUMMDL + +-- | Parses a MODEL record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseMODEL :: (Monad m) => String -> Int -> m [PDBEvent] +parseMODEL = parseIntRecord MODEL + +--------------- }}} NUMMDL or MODEL records + diff --git a/Bio/PDB/EventParser/ParseJRNL.hs b/Bio/PDB/EventParser/ParseJRNL.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseJRNL.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Parsing of records with journal references. +module Bio.PDB.EventParser.ParseJRNL(parseJRNL, parseREMARK1) +where + +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ JRNL records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +------------------------------------------------------------------------------- + 1 - 6 Record name "REMARK" +10 LString(1) "1" +13 - 16 LString(4) "AUTH" +17 - 18 Continuation continuation Allows a long list of authors. +20 - 79 List authorList List of the authors. +--} + +titleFields = [(10, mKeywords "record header" ["JRNL ", + "REMARK 1"] ), + (12, mSpc 2 ), + (16, mKeywords "subrecord header" ["AUTH", "TITL", + "REF ", "REFN", + "PUBL", "PMID", + "DOI ", "EDIT"]), -- EDIT is from old (2.2) file format description + (18, dInt "continuation" 0 ), + (19, mSpc 1 ), + (80, mStr "content" )] + +{-# SPECIALIZE parseJRNL :: BS.ByteString -> Int -> IO [PDBEvent] #-} +-- | Parses a JRNL or REMARK 1 record that contains a journal reference. +-- +-- Arguments: +-- +-- (1) boolean indicating, if it is first reference for a structure (JRNL) +-- or any other (REMARK 1.) +-- +-- (2) input line +-- +-- (3) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseJournalRef :: (Monad m) => Bool -> BS.ByteString -> Int -> m [PDBEvent] +parseJournalRef isFirst line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields titleFields line line_no + [fRec, _, fSubrec, fCont, _, fContent] = fields + -- unpack fields + IFStr subrec = fSubrec + IFInt cont = fCont + IFStr content = fContent + result = JRNL cont [(subrec, content)] isFirst + +-- | Parses a JRNL record that contains a journal reference. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseJRNL :: (Monad m) => BS.ByteString -> Int -> m [PDBEvent] +parseJRNL = parseJournalRef True + +-- | Parses a REMARK 1 record that contains a journal reference. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseREMARK1 :: (Monad m) => BS.ByteString -> Int -> m [PDBEvent] +parseREMARK1 = parseJournalRef False + +-- NOTE: consecutive "JRNL" records should be merged into a single multiline entry with SUCH method +--mergeTitle :: [PDBEvent] -> m [PDBEvent] + +--------------- }}} JRNL records + diff --git a/Bio/PDB/EventParser/ParseLINK.hs b/Bio/PDB/EventParser/ParseLINK.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseLINK.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} + +-- | Parsing LINK records. +module Bio.PDB.EventParser.ParseLINK(parseLINK) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ LINK records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +------------------------------------------------------------------------------------ + 1 - 6 Record name "LINK " +13 - 16 Atom name1 Atom name. +17 Character altLoc1 Alternate location indicator. +18 - 20 Residue name resName1 Residue name. +22 Character chainID1 Chain identifier. +23 - 26 Integer resSeq1 Residue sequence number. +27 AChar iCode1 Insertion code. +43 - 46 Atom name2 Atom name. +47 Character altLoc2 Alternate location indicator. +48 - 50 Residue name resName2 Residue name. +52 Character chainID2 Chain identifier. +53 - 56 Integer resSeq2 Residue sequence number. +57 AChar iCode2 Insertion code. +60 - 65 SymOP sym1 Symmetry operator atom 1. +67 - 72 SymOP sym2 Symmetry operator atom 2. +74 – 78 Real(5.2) Length Link distance +--} + +{-# INLINE linkFields #-} +linkFields = [(6, mKeyword "record header" "LINK " ), + (12, mSpc 6 ), + (16, mStr "atom name" ), + (17, mChr "alternate location indicator 1" ), + (20, mStr "residue name 1" ), + (21, mSpc 1 ), + (22, mChr "chain id 1" ), + (26, mInt "residue sequence number 1" ), + (27, mChr "insertion code 1" ), + (42, mSpc 15 ), + (46, mStr "atom name 1" ), + (47, mChr "alternate location indicator 2" ), + (50, mStr "residue name 2" ), + (51, mSpc 1 ), + (52, mChr "chain id 2" ), + (56, mInt "residue sequence number 2" ), + (57, mChr "insertion code 2" ), + (59, mSpc 2 ), + (65, mStr "symmetry operator for atom 1" ), + (66, mSpc 1 ), + (72, mStr "symmetry operator for atom 2" ), + (73, mSpc 1 ), + (78, pDouble "link distance" )] + +-- | Parses a LINK record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseLINK :: (Monad m) => String -> Int -> m [PDBEvent] +parseLINK line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + errs = if fErrs == [] then fgErrs else fErrs + (fields, fErrs) = parseFields linkFields line line_no + [fRec, _, + fAtName1, fAltLoc1, fResname1, _, fChain1, fResnum1, fInsCode1, _, + fAtName2, fAltLoc2, fResname2, _, fChain2, fResnum2, fInsCode2, _, + fSymOp1, _, fSymOp2, _, fLinkDist] = fields + IFChar altloc1 = fAltLoc1 + IFChar altloc2 = fAltLoc2 + IFStr symop1 = fSymOp1 + IFStr symop2 = fSymOp2 + linkdist = case fLinkDist of + IFDouble ld -> Just ld + IFNone -> Nothing + + fgAt1 = fgAtom "atom 1" 16 fAtName1 fResname1 fChain1 fResnum1 fInsCode1 + fgAt2 = fgAtom "atom 2" 26 fAtName2 fResname2 fChain2 fResnum2 fInsCode2 + fgErrs = liftFgErrs line_no [fgAt1, fgAt2] + [at1, at2] = rights [fgAt1, fgAt2] + + -- unpack fields + result = LINK at1 altloc1 at2 altloc2 symop1 symop2 linkdist + +--------------- }}} LINK/LINKSYN records + diff --git a/Bio/PDB/EventParser/ParseListRecord.hs b/Bio/PDB/EventParser/ParseListRecord.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseListRecord.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +-- Parsing of records that contain simple list of values: KEYWDS, AUTHOR, MDLTYP, EXPDTA. +module Bio.PDB.EventParser.ParseListRecord(parseKEYWDS,parseAUTHOR,parseMDLTYP,parseEXPDTA) +where + +import Prelude hiding (String) + +import qualified Data.ByteString.Char8 as BS + +-- Output data structure +import Bio.PDB.EventParser.PDBEvents hiding (String) +import qualified Bio.PDB.EventParser.ExperimentalMethods as ExperimentalMethods + +-- Helper methods +import Bio.PDB.EventParser.PDBParsingAbstractions + + +-- | String type used all over the library. +type String = BS.ByteString + +--------------- {{{ List containing records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +---------------------------------------------------------------------------------- + 1 - 6 Record name "AUTHOR", "KEYWDS", "MDLTYP" or "EXPDTA" + 9 - 10 Continuation continuation Allows concatenation of multiple records. +11 - 80 String title Title of the experiment. +--} + +-- | Fields of the KEYWDS, AUTHOR, EXPDTA and MDLTYP records. +listFields = [(6, mKeywords "record header" ["KEYWDS", + "AUTHOR", + "EXPDTA", + "MDLTYP"]), + (8, mSpc 2 ), + (10, dInt "continuation" 0 ), + (80, pStr "list" )] + +-- | Parses a record that contains a list of values. +-- +-- Arguments: +-- +-- (1) a matrix constructor +-- +-- (2) a separator characteristic for this type of record +-- +-- (3) input line +-- +-- (4) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseListRecord :: (Monad m) =>(Int -> [String] -> PDBEvent)-> Char-> String-> Int-> m [PDBEvent] +parseListRecord cons sep line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields listFields line line_no + [fRec, fSpc, fCont, fList] = fields + -- unpack fields + IFInt cont = fCont + IFStr aList = fList + words = map trim $ BS.split sep aList + result :: PDBEvent = cons cont words + +-- | Parses a KEYWDS record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseKEYWDS :: (Monad m) => String -> Int -> m [PDBEvent] +parseKEYWDS = parseListRecord KEYWDS ',' + +-- | Parses a AUTHOR record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseAUTHOR :: (Monad m) => String -> Int -> m [PDBEvent] +parseAUTHOR = parseListRecord AUTHOR ',' + +-- | Parses a EXPDTA record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseEXPDTA :: (Monad m) => String -> Int -> m [PDBEvent] +parseEXPDTA = parseListRecord mkEXPDTA ';' + where mkEXPDTA cont aList = EXPDTA cont $ map (ExperimentalMethods.mkExpMethod . + BS.words) aList +-- | Parses a MDLTYP record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseMDLTYP :: (Monad m) => String -> Int -> m [PDBEvent] +parseMDLTYP = parseListRecord MDLTYP ';' + +-- NOTE: Consecutive AUTHOR and KEYWDS records should be merged. +--------------- }}} List containing records + diff --git a/Bio/PDB/EventParser/ParseMASTER.hs b/Bio/PDB/EventParser/ParseMASTER.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseMASTER.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Parsing MASTER records. +module Bio.PDB.EventParser.ParseMASTER(parseMASTER) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ MASTER records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +---------------------------------------------------------------------------------- + 1 - 6 Record name "MASTER" +11 - 15 Integer numRemark Number of REMARK records +16 - 20 Integer "0" +21 - 25 Integer numHet Number of HET records +26 - 30 Integer numHelix Number of HELIX records +31 - 35 Integer numSheet Number of SHEET records +36 - 40 Integer numTurn deprecated +41 - 45 Integer numSite Number of SITE records +46 - 50 Integer numXform Number of coordinate transformation + records (ORIGX+SCALE+MTRIX) +51 - 55 Integer numCoord Number of atomic coordinate records + records (ATOM+HETATM) +56 - 60 Integer numTer Number of MASTER records +61 - 65 Integer numConect Number of CONECT records +66 - 70 Integer numSeq Number of SEQRES records +--} + + +{-# INLINE masterFields #-} +-- | Fields of the MASTER record +masterFields :: [(Int, String -> ParsedField)] +masterFields = [(6, mKeyword "record header" "MASTER" ), + (10, mSpc 4 ), + (15, mInt "number of REMARK records" ), + (20, mInt "" ), + (25, mInt "number of HET records" ), + (30, mInt "number of HELIX records" ), + (35, mInt "number of SHEET records" ), + (40, pInt "number of TURN records" ), -- deprecated + (45, mInt "number of SITE records" ), + (50, mInt "number of coordinate transform records (ORIGX, SCALE,MTRIX)"), + (55, mInt "number of atomic coordinate records (ATOM, HETATM)"), + (60, mInt "number of MASTER records" ), + (65, mInt "number of CONECT records" ), + (70, mInt "number of SEQRES records" )] + + +-- | Parses a MASTER record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a mionad action returning a list of 'PDBEvent's. +parseMASTER line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields masterFields line line_no + [fRec, _, fNumRemark, fZero, fNumHet, fNumHelix, fNumSheet, fNumTurn, + fNumSite, fNumXform, fNumAts, fNumMaster, fNumConect, fNumSeqres] = fields + IFInt numRemark = fNumRemark + IFInt 0 = fZero + IFInt numHet = fNumHet + IFInt numHelix = fNumHelix + IFInt numSheet = fNumSheet + IFInt numTurn = fNumTurn + IFInt numSite = fNumSite + IFInt numXform = fNumXform + IFInt numAts = fNumAts + IFInt numMaster = fNumMaster + IFInt numConect = fNumConect + IFInt numSeqres = fNumSeqres + + -- unpack fields + result = MASTER numRemark numHet numHelix numSheet numTurn + numSite numXform numAts numMaster numConect + numSeqres + +--------------- }}} MASTER records + diff --git a/Bio/PDB/EventParser/ParseMODRES.hs b/Bio/PDB/EventParser/ParseMODRES.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseMODRES.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Parsing of residue modification records (MODRES). +module Bio.PDB.EventParser.ParseMODRES(parseMODRES) +where + +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ MODRES records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +-------------------------------------------------------------------------------- + 1 - 6 Record name "MODRES" + 8 - 11 IDcode idCode ID code of this entry. +13 - 15 Residue name resName Residue name used in this entry. +17 Character chainID Chain identifier. +19 - 22 Integer seqNum Sequence number. +23 AChar iCode Insertion code. +25 - 27 Residue name stdRes Standard residue name. +30 - 70 String comment Description of the residue modification. +--} + +modresFields = [(6, mKeyword "record header" "MODRES" ), + (7, mSpc 1 ), + (11, mStr "PDB code" ), + (12, mSpc 1 ), + (15, dStr "modified residue name" " "), + (16, mSpc 1 ), + (17, mChr "chain id" ), + (18, mSpc 1 ), + (22, mInt "sequence number" ), + (23, mChr "insertion code" ), + (24, mSpc 1 ), + (27, dStr "standard residue name" " "), + (70, mStr "comment" )] + +-- | Parses a MODRES record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +{-# SPECIALIZE parseMODRES :: BS.ByteString -> Int -> IO [PDBEvent] #-} +parseMODRES :: (Monad m) => BS.ByteString -> Int -> m [PDBEvent] +parseMODRES line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, fErrs) = parseFields modresFields line line_no + [fRec, _, fPdbCode, _, fModRes, _, fChain, _, fSeqNum, fInsCode, _, fStdRes, fComment] = fields + -- unpack fields + IFStr pdbcode = fPdbCode + IFStr stdres = fStdRes + IFStr comment = fComment + + errs = if fErrs == [] then fgErrs else fErrs + fgRes = fgResidue True "modified" 15 fModRes fChain fSeqNum fInsCode + fgErrs = liftFgErrs line_no [fgRes] + Right res = fgRes + + --result = MODRES pdbcode res stdres comment + result = PDBIgnoredLine $ BS.pack $ show (fModRes, fSeqNum, fChain, fInsCode) + + +-- NOTE: consecutive "MODRES" records should be merged into a single multiline entry with SUCH method +--mergeTitle :: [PDBEvent] -> m [PDBEvent] + +--------------- }}} MODRES records + diff --git a/Bio/PDB/EventParser/ParseMatrixRecord.hs b/Bio/PDB/EventParser/ParseMatrixRecord.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseMatrixRecord.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Parsing of records on scale (SCALEn), origin (ORIGXn) and transformation (MTRIXn.) +module Bio.PDB.EventParser.ParseMatrixRecord(parseSCALEn, parseORIGXn, parseMTRIXn) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS +import Control.Exception(assert) + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ Matrix records (SCALEn, ORIGXn, MTRIXn) +{-- +COLUMNS DATA TYPE FIELD DEFINITION +---------------------------------------------------------------------------------- + 1 - 6 Record name "SCALE[123]", "ORIGX[123]" or "MTRIX[123]" +11 - 20 Real(10.6) o[n][1] +21 - 30 Real(10.6) o[n][2] +31 - 40 Real(10.6) o[n][3] +46 - 55 Real(10.5) t[n] +60 Integer 1 if coordinates for the related molecule are present; + otherwise, blank. + only +--} + +titleFields = [(5, mKeywords "record header" ["SCALE", "ORIGX", "TVECT", "MTRIX"]), + (6, mInt "recno" ), + (7, mSpc 1 ), + (10, dInt "serial number" 0 ), + (20, mDouble "o[n][1]" ), + (30, mDouble "o[n][2]" ), + (40, mDouble "o[n][3]" ), + (45, mSpc 5 ), + (55, mDouble "t[n]" ), + (59, pSpc ), + (60, dInt "related molecule present?" 0 )] + +-- | Parses a single line with matrix or vector information. +-- +-- Arguments: +-- +-- (1) record constructor: SCALEn, ORIGXn, MTRIXn +-- +-- (2) input line +-- +-- (3) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseMatrixRecord :: (Monad m) =>(Int -> Bool -> Int -> [Vector3] -> [Double] -> PDBEvent)-> String-> Int-> m [PDBEvent] +parseMatrixRecord cons line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields titleFields line line_no + [fRec, fRecNo, _, fSerial, fo1, fo2, fo3, fSpc2, ft, fSpc3, fRelMol] = fields + -- unpack fields + IFInt serial = fSerial + IFInt n = fRecNo + IFDouble o1 = fo1 + IFDouble o2 = fo2 + IFDouble o3 = fo3 + IFDouble t = ft + IFInt relMol = fRelMol + result = cons serial (relMol==1) n [Vector3 o1 o2 o3] [t] + +-- | Parses a SCALEn record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseSCALEn :: (Monad m) => String -> Int -> m [PDBEvent] +parseSCALEn = parseMatrixRecord (\s _ -> assert (s==0) SCALEn) + +-- | Parses a ORIGXn record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseORIGXn :: (Monad m) => String -> Int -> m [PDBEvent] +parseORIGXn = parseMatrixRecord (\s _ -> assert (s==0) ORIGXn) + +-- | Parses a MTRIXn record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseMTRIXn :: (Monad m) => String -> Int -> m [PDBEvent] +parseMTRIXn = parseMatrixRecord MTRIXn + +-- NOTE: consecutive "TITLE" records should be merged into a single multiline entry with SUCH method +--mergeMatrixRecords :: [PDBEvent] -> m [PDBEvent] + +--------------- }}} Matrix records + diff --git a/Bio/PDB/EventParser/ParseObsoleting.hs b/Bio/PDB/EventParser/ParseObsoleting.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseObsoleting.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoMonomorphismRestriction #-} + +-- | Parsing information about obsoleted entries: OBSLTE and SPRSDE. +module Bio.PDB.EventParser.ParseObsoleting(parseOBSLTE,parseSPRSDE) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ Obsoleting records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +--------------------------------------------------------------------------------------- + 1 - 6 Record name "OBSLTE" or "SPRSDE" + 9 - 10 Continuation continuation Allows concatenation of multiple records +12 - 20 Date repDate Date that this entry was replaced. +22 - 25 IDcode idCode ID code of this entry. +32 - 35 IDcode rIdCode ID code of entry that replaced this one. +37 - 40 IDcode rIdCode ID code of entry that replaced this one. +42 - 45 IDcode rIdCode ID code of entry that replaced this one. +47 - 50 IDcode rIdCode ID code of entry that replaced this one. +52 - 55 IDcode rIdCode ID code of entry that replaced this one. +57 - 60 IDcode rIdCode ID code of entry that replaced this one. +62 - 65 IDcode rIdCode ID code of entry that replaced this one. +67 - 70 IDcode rIdCode ID code of entry that replaced this one. +72 - 75 IDcode rIdCode ID code of entry that replaced this one. +--} + +{-# INLINE obsoletingFields #-} +obsoletingFields = [(6, mKeywords "record header" ["OBSLTE", "SPRSDE"]), + (8, mSpc 2 ), + (10, dInt "continuation" 0 ), + (11, mSpc 1 ), + (20, mStr "date" ), + (21, mSpc 1 ), + (25, mStr "PDB code of this entry" ), + (31, mSpc 6 ), + (75, mStr "PDB codes of relevant entries" )] + + +-- | Parses an OBSLTE or SPRSDE record: +-- +-- Arguments: +-- +-- (1) a PDBEvent constructor: +-- +-- * OBSLTE or +-- +-- * SPRSDE +-- +-- (2) input line +-- +-- (3) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseObsoleting cons line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields obsoletingFields line line_no + [fRec, _, fCont, _, fDate, _, fThisEntry, _, fOtherEntries] = fields + IFInt cont = fCont + IFStr date = fDate + IFStr thisEntry = fThisEntry + IFStr otherEntries = fOtherEntries + pdbids = filter (/="") $ BS.split ' ' otherEntries + + -- unpack fields + result = cons cont date thisEntry pdbids + +-- | Parses a OBSLTE record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseOBSLTE :: (Monad m) => String -> Int -> m [PDBEvent] +parseOBSLTE = parseObsoleting OBSLTE + +-- | Parses a SPRSDE record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseSPRSDE :: (Monad m) => String -> Int -> m [PDBEvent] +parseSPRSDE = parseObsoleting SPRSDE + +--------------- }}} Obsoleting records + diff --git a/Bio/PDB/EventParser/ParseREMARK.hs b/Bio/PDB/EventParser/ParseREMARK.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseREMARK.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Parse a generic REMARK record. +module Bio.PDB.EventParser.ParseREMARK(parseREMARK) +where + +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions +import Bio.PDB.EventParser.ParseJRNL(parseREMARK1) -- supplementary references follow JRNL record format! + + +--------------- {{{ REMARK records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +---------------------------------------------------------------------------------- +COLUMNS DATA TYPE FIELD DEFINITION +-------------------------------------------------------------------------------------- + 1 - 6 Record name "REMARK" + 8 - 10 Int remarkNum Remark number. It is not an error for + remark n to exist in an entry when + remark n-1 does not. +12 - 70 LString empty Left as white space in first line + of each new remark. +--} + +remarkFields = [(6, mKeyword "record header" "REMARK"), + (7, mSpc 1 ), + (10, dInt "remark number" 0 ), + (11, pSpc ), + (80, pStr "text" )] + +-- | Parses a _generic_ REMARK record: +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseREMARK :: (Monad m) => BS.ByteString -> Int -> m [PDBEvent] +parseREMARK line line_no = + if errs == [] + then (if (num == 1) && + not (BS.all (==' ') text) && + not ("REFERENCE" `BS.isPrefixOf` text) + then parseREMARK1 line line_no + else return [result]) + else return errs + where + -- parse + (fields, errs) = parseFields remarkFields line line_no + [fRec, fSpc1, fNum, fSpc2, fText] = fields + -- unpack fields + IFInt num = fNum + IFStr text = fText + result = REMARK { num = num, + text = [text] } + +-- NOTE: consecutive "REMARK" records should be merged into a single multiline entry with SUCH method +--mergeTitle :: [PDBEvent] -> m [PDBEvent] + +--------------- }}} REMARK records + diff --git a/Bio/PDB/EventParser/ParseREVDAT.hs b/Bio/PDB/EventParser/ParseREVDAT.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseREVDAT.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Parse a REVDAT record (structure revision data.) +module Bio.PDB.EventParser.ParseREVDAT(parseREVDAT) +where + +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ REVDAT records +{-- +OLUMNS DATA TYPE FIELD DEFINITION +------------------------------------------------------------------------------------- + 1 - 6 Record name "REVDAT" + 8 - 10 Int modNum Modification number. +11 - 12 Continuation continuation Allows concatenation of multiple records. +14 - 22 Date modDate Date of modification (or release for + new entries) in DD-MMM-YY format. This is + not repeated on continued lines. +24 - 27 IDCode modId ID code of this entry. This is not repeated on + continuation lines. +32 Int modType An integer identifying the type of + modification. For all revisions, the + modification type is listed as 1 +40 - 45 LString(6) record Modification detail. +47 - 52 LString(6) record Modification detail. +54 - 59 LString(6) record Modification detail. +61 - 66 LString(6) record Modification detail. + +--} + +revdatFields = [(6, mKeyword "record header" "REVDAT" ), + (7, mSpc 1 ), + (10, mInt "modification number" ), + (12, dInt "continuation" 0 ), + (13, mSpc 1 ), + (22, mStr "modification date" ), + (23, mSpc 1 ), + (27, pStr "modification id" ), + (31, mSpc 4 ), + (32, dInt "modification type" 0 ), + (39, pSpc ), + (45, pStr "modification detail 1" ), + (46, pSpc ), + (52, pStr "modification detail 2" ), + (53, pSpc ), + (59, pStr "modification detail 3" ), + (60, pSpc ), + (66, pStr "modification detail 4" )] + +{-# INLINE pStrList #-} +pStrList [] = [] +pStrList (IFStr "":ls) = pStrList ls +pStrList (IFStr s :ls) = s:pStrList ls + +{-# INLINE strListErrs #-} +strListErrs line (_:cols) (IFStr _:ls) = strListErrs line cols ls +strListErrs line (_:cols) (IFNone :ls) = strListErrs line cols ls +strListErrs line [] [] = [] +strListErrs line (c:cols) (x :ls) = PDBParseError line c + (BS.concat ["Expecting list of strings, got ", + BS.pack (show x)]) : strListErrs line cols ls + +-- | Parses a REVDAT record: +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseREVDAT :: (Monad m) => BS.ByteString -> Int -> m [PDBEvent] +parseREVDAT line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs1) = parseFields revdatFields line line_no + errs = errs1 ++ strListErrs line_no [45, 52, 59, 66] strModList + [fRec, fSpc1, fModNum, fCont, fSpc2, fModDat, fSpc3, fModId, fSpc4, fModTyp, + fSpc5, fModDet1, fSpc6, fModDet2, fSpc7, fModDet3, fSpc8, fModDet4] = fields + -- unpack fields + IFInt modNum = fModNum + IFInt cont = fCont + IFStr modDat = fModDat + IFStr modId = fModId + IFInt modTyp = fModTyp + strModList = [fModDet1, fModDet2, fModDet3, fModDet4] + modList = filter (not . BS.null) $ pStrList strModList + result = REVDAT { modNum = modNum, + cont = cont, + modDat = modDat, + modId = modId, + modTyp = modTyp, + details = modList + } + +-- NOTE: consecutive "REVDAT" records should be merged into a single multiline entry with SUCH method +--mergeTitle :: [PDBEvent] -> m [PDBEvent] + +--------------- }}} REVDAT records + diff --git a/Bio/PDB/EventParser/ParseSEQADV.hs b/Bio/PDB/EventParser/ParseSEQADV.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseSEQADV.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} + +-- | Parsing a SEQADV record. +module Bio.PDB.EventParser.ParseSEQADV(parseSEQADV) +where + +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ SEQADV records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +----------------------------------------------------------------- + 1 - 6 Record name "SEQADV" + 8 - 11 IDcode idCode ID code of this entry. +13 - 15 Residue name resName Name of the PDB residue in conflict. +17 Character chainID PDB chain identifier. +19 - 22 Integer seqNum PDB sequence number. +23 AChar iCode PDB insertion code. +25 - 28 LString database +30 - 38 LString dbIdCode Sequence database accession number. +40 - 42 Residue name dbRes Sequence database residue name. +44 - 48 Integer dbSeq Sequence database sequence number. +50 - 70 LString conflict Conflict comment. +--} + +titleFields = [(6, mKeyword "record header" "SEQADV" ), + (7, mSpc 1), + (11, mStr "PDB id" ), + (12, mSpc 1), + (15, mStr "residue name" ), + (16, mSpc 1), + (17, mChr "chain id" ), + (18, mSpc 1), + (22, dInt "sequence number" (-1)), + (23, mChr "insertion code" ), + (24, mSpc 1), + (28, mStr "database" ), + (29, mSpc 1), + (38, mStr "sequence database accession code" ), + (39, mSpc 1), + (42, mStr "sequence database residue name" ), + (43, mSpc 1), + (48, dInt "sequence database sequence number" (-1)), + (49, mSpc 1), + (70, mStr "conflict comment" )] + +{-# SPECIALIZE parseSEQADV :: BS.ByteString -> Int -> IO [PDBEvent] #-} +-- | Parses a SEQADV record: +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseSEQADV :: (Monad m) => BS.ByteString -> Int -> m [PDBEvent] +parseSEQADV line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, fErrs) = parseFields titleFields line line_no + [fRec, _, fPdbid, _, fResname, _, fChain, _, fSeqNum, fInsCode, _, fDb, + _, fAccCode, _, fDbResname, _, fDbSeqNum, _, fComment] = fields + -- unpack fields + IFStr pdbid = fPdbid + IFStr db = fDb + IFStr acccode = fAccCode + IFStr dbresname = fDbResname + mDbseqnum = case fSeqNum of + IFInt seqnum -> Just seqnum + IFNone -> Nothing + IFStr comment = fComment + + errs = if fErrs == [] then fgErrs else fErrs + fgRes = maybeFgResidue False "modified residue" 15 fResname fChain fSeqNum fInsCode + fgErrs = liftFgErrs line_no [fgRes] + Right res = fgRes + + result = SEQADV pdbid res + db acccode dbresname mDbseqnum + comment + +--------------- }}} SEQADV records + diff --git a/Bio/PDB/EventParser/ParseSEQRES.hs b/Bio/PDB/EventParser/ParseSEQRES.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseSEQRES.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Parsing a SEQRES record. +module Bio.PDB.EventParser.ParseSEQRES(parseSEQRES) +where + +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ SEQRES records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +---------------------------------------------------------------------------------- +COLUMNS DATA TYPE FIELD DEFINITION +------------------------------------------------------------------------------------- + 1 - 6 Record name "SEQRES" + 8 - 10 Int serNum Serial number of the SEQRES record for the + current chain. Starts at 1 and increments + by one each line. Reset to 1 for each chain. +WARNING: As seen in 3JYV - serial number spans from 7th column!!! +12 Character chainID Chain identifier. This may be any single + legal character, including a blank which is + is used if there is only one chain. +14 - 17 Int numRes Number of residues in the chain. + This value is repeated on every record. +20 - 22 Residue name resName Residue name. +24 - 26 Residue name resName Residue name. +28 - 30 Residue name resName Residue name. +32 - 34 Residue name resName Residue name. +36 - 38 Residue name resName Residue name. +40 - 42 Residue name resName Residue name. +44 - 46 Residue name resName Residue name. +48 - 50 Residue name resName Residue name. +52 - 54 Residue name resName Residue name. +56 - 58 Residue name resName Residue name. +60 - 62 Residue name resName Residue name. +64 - 66 Residue name resName Residue name. +68 - 70 Residue name resName Residue name. +--} + +seqresFields = [(6, mKeyword "record header" "SEQRES"), + (7, mSpc 1), + (10, mInt "serial number"), + (11, mSpc 1), + (12, mChr "chain id"), + (13, mSpc 1), + (17, mInt "number of residues"), + (70, pStr "residues")] + +splitResidues resStr = if BS.null resStr + then [] + else res:splitResidues rest2 + where + (res, rest) = BS.splitAt 3 resStr + (" ", rest2) = BS.splitAt 1 rest + + +-- | Parses a SEQRES record: +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseSEQRES :: (Monad m) => BS.ByteString -> Int -> m [PDBEvent] +parseSEQRES line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields seqresFields line line_no + [fRec, fSpc1, fSerial, fSpc2, fChain, fSpc3, fNum, fRes] = fields + -- unpack fields + IFInt serial = fSerial + IFChar chain = fChain + IFInt num = fNum + IFStr residues = fRes + resList = filter (not . BS.null) (BS.split ' ' residues) + -- assuming residue name won't contain spaces... + result = SEQRES serial chain num resList + +-- NOTE: consecutive "SEQRES" records should be merged into a single multiline entry with SUCH method +--mergeTitle :: [PDBEvent] -> m [PDBEvent] + +--------------- }}} SEQRES records + diff --git a/Bio/PDB/EventParser/ParseSHEET.hs b/Bio/PDB/EventParser/ParseSHEET.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseSHEET.hs @@ -0,0 +1,160 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} + +-- | Parsing a SHEET record. +module Bio.PDB.EventParser.ParseSHEET(parseSHEET) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.StrandSense +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ SHEET records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +------------------------------------------------------------------------------------- + 1 - 6 Record name "SHEET " + 8 - 10 Integer strand Strand number which starts at 1 for each + strand within a sheet and increases by one. +12 - 14 LString(3) sheetID Sheet identifier. +15 - 16 Integer numStrands Number of strands in sheet. +18 - 20 Residue name initResName Residue name of initial residue. +22 Character initChainID Chain identifier of initial residue + in strand. +23 - 26 Integer initSeqNum Sequence number of initial residue + in strand. +27 AChar initICode Insertion code of initial residue + in strand. +29 - 31 Residue name endResName Residue name of terminal residue. +33 Character endChainID Chain identifier of terminal residue. +34 - 37 Integer endSeqNum Sequence number of terminal residue. +38 AChar endICode Insertion code of terminal residue. +39 - 40 Integer sense Sense of strand with respect to previous + strand in the sheet. 0 if first strand, + 1 if parallel,and -1 if anti-parallel. +42 - 45 Atom curAtom Registration. Atom name in current strand. +46 - 48 Residue name curResName Registration. Residue name in current strand +50 Character curChainId Registration. Chain identifier in + current strand. +51 - 54 Integer curResSeq Registration. Residue sequence number + in current strand. +55 AChar curICode Registration. Insertion code in + current strand. +57 - 60 Atom prevAtom Registration. Atom name in previous strand. +61 - 63 Residue name prevResName Registration. Residue name in + previous strand. +65 Character prevChainId Registration. Chain identifier in + previous strand. +66 - 69 Integer prevResSeq Registration. Residue sequence number + in previous strand. +70 AChar prevICode Registration. Insertion code in + previous strand. + +--} + +helixFields = [(6, mKeyword "record header" "SHEET " ), + (7, mSpc 1 ), + (10, mInt "strand" ), + (11, mSpc 1 ), + (14, mStr "sheet id" ), + (16, mInt "number of strands" ), + (17, mSpc 1 ), + (20, mStr "initial residue name" ), + (21, mSpc 1 ), + (22, mChr "initial residue chain id" ), + (26, mInt "initial residue serial number" ), + (27, mChr "initial insertion code" ), + (28, mSpc 1 ), + (31, mStr "end residue name" ), + (32, mSpc 1 ), + (33, mChr "end residue chain id" ), + (37, mInt "end residue serial number" ), + (38, mChr "end insertion code" ), + (40, mInt "sense with respect to previous strand" ), + (41, pSpc ), + (45, pStr "current atom name" ), + (48, pStr "current residue name" ), + (49, pSpc ), + (50, pChr "current chain id" ), + (54, pInt "current residue serial number" ), + (55, pChr "current residue insertion code" ), + (56, pSpc ), + (60, pStr "atom name in previous strand" ), + (63, pStr "residue name in previous strand" ), + (64, pSpc ), + (65, pChr "chain id in previous strand" ), + (69, pInt "residue serial number in previous strand"), + (70, pChr "insertion code in previous strand" )] + +-- | Parses a SHEET record: +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseSHEET :: (Monad m) => String -> Int -> m [PDBEvent] +parseSHEET line line_no = --return [Test $ BS.pack $ show $ ((length helixFields)::Int)] + return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, fErrs) = parseFields helixFields line line_no + [fRec, _, fStrandId, _, fSheetId, fNumStrands, _, + fIniResName, _, fIniChain, fIniResId, fIniResIns, _, + fEndResName, _, fEndChain, fEndResId, fEndResIns, + fSense, _, + fCurAtomName, fCurResName, _, fCurChain, fCurResId, fCurResIns, _, + fPrevAtomName, fPrevResName, _, fPrevChain, fPrevResId, fPrevResIns] = fields + -- unpack fields + IFInt strandId = fStrandId + IFStr sheetId = fSheetId + + IFInt numStrands = fNumStrands + + IFStr iniResName = fIniResName + IFChar iniChain = fIniChain + IFInt iniResId = fIniResId + IFChar iniResIns = fIniResIns + fgIniRes = fgResidue False "initial" 20 fIniResName fIniChain fIniResId fIniResIns + Right iniRes = fgIniRes + + IFStr endResName = fEndResName + IFChar endChain = fEndChain + IFInt endResId = fEndResId + IFChar endResIns = fEndResIns + fgEndRes = fgResidue False "end" 31 fEndResName fEndChain fEndResId fEndResIns + Right endRes = fgEndRes + + IFInt iSense = fSense + sense = case iSense of + ( 0) -> Nothing + ( 1) -> Just Parallel + (-1) -> Just Antiparallel + + fgCurAtom = maybeFgAtom "current" 45 fCurAtomName fCurResName fCurChain fCurResId fCurResIns + fgPrevAtom = maybeFgAtom "previous" 60 fPrevAtomName fPrevResName fPrevChain fPrevResId fPrevResIns + + fgErrs = liftFgErrs line_no [fgCurAtom, fgPrevAtom] ++ + liftFgErrs line_no [fgIniRes, fgEndRes ] + + Right curAtom = fgCurAtom + Right prevAtom = fgPrevAtom + + errs = fErrs ++ fgErrs + + -- assuming residue name won't contain spaces... + result = SHEET strandId sheetId numStrands sense + iniRes + endRes + curAtom + prevAtom + +--------------- }}} SHEET records + diff --git a/Bio/PDB/EventParser/ParseSITE.hs b/Bio/PDB/EventParser/ParseSITE.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseSITE.hs @@ -0,0 +1,126 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} + +-- | Parsing a SITE record. +module Bio.PDB.EventParser.ParseSITE(parseSITE) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ SITE records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +--------------------------------------------------------------------------------- + 1 - 6 Record name "SITE " + 8 - 10 Integer seqNum Sequence number. +12 - 14 LString(3) siteID Site name. +16 - 17 Integer numRes Number of residues that compose the site. +19 - 21 Residue name resName1 Residue name for first residue that + creates the site. +23 Character chainID1 Chain identifier for first residue of site. +24 - 27 Integer seq1 Residue sequence number for first residue + of the site. +28 AChar iCode1 Insertion code for first residue of the site. +30 - 32 Residue name resName2 Residue name for second residue that + creates the site. +34 Character chainID2 Chain identifier for second residue of + the site. +35 - 38 Integer seq2 Residue sequence number for second + residue of the site. +39 AChar iCode2 Insertion code for second residue + of the site. +41 - 43 Residue name resName3 Residue name for third residue that + creates the site. +45 Character chainID3 Chain identifier for third residue + of the site. +46 - 49 Integer seq3 Residue sequence number for third + residue of the site. +50 AChar iCode3 Insertion code for third residue + of the site. +52 - 54 Residue name resName4 Residue name for fourth residue that + creates the site. +56 Character chainID4 Chain identifier for fourth residue + of the site. +57 - 60 Integer seq4 Residue sequence number for fourth + residue of the site. +61 AChar iCode4 Insertion code for fourth residue + of the site. +--} + +{-# INLINE siteFields #-} +siteFields = [(6, mKeyword "record header" "SITE " ), + (7, mSpc 1 ), + (10, mInt "record serial number" ), + (11, mSpc 1 ), + (14, mStr "site id" ), + (15, mSpc 1 ), + (17, mInt "number of residues" ), + (18, mSpc 1 ), + (21, mStr "residue name 1" ), + (22, mSpc 1 ), + (23, mChr "chain id 1" ), + (27, mInt "residue sequence number 1" ), + (28, mChr "insertion code 1" ), + (29, pSpc ), + (32, pStr "residue name 2" ), + (33, pSpc ), + (34, pChr "chain id 2" ), + (38, pInt "residue sequence number 2" ), + (39, pChr "insertion code 2" ), + (40, pSpc ), + (43, pStr "residue name 3" ), + (44, pSpc ), + (45, pChr "chain id 3" ), + (49, pInt "residue sequence number 3" ), + (50, pChr "insertion code 3" ), + (51, pSpc ), + (54, pStr "residue name 4" ), + (55, pSpc ), + (56, pChr "chain id 4" ), + (60, pInt "residue sequence number 4" ), + (61, pChr "insertion code 4" )] + +-- | Parses a SITE record: +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseSITE :: (Monad m) => String -> Int -> m [PDBEvent] +parseSITE line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + errs = if fErrs == [] then fgErrs else fErrs + (fields, fErrs) = parseFields siteFields line line_no + [fRec, _, fSerial, _, fSiteId, _, fNumRes, _, + fResname1, _, fChain1, fResnum1, fInsCode1, _, + fResname2, _, fChain2, fResnum2, fInsCode2, _, + fResname3, _, fChain3, fResnum3, fInsCode3, _, + fResname4, _, fChain4, fResnum4, fInsCode4] = fields + IFInt serial = fSerial + IFStr siteid = fSiteId + IFInt numres = fNumRes + fgRes1 = fgResidue False "residue 1" 21 fResname1 fChain1 fResnum1 fInsCode1 + fgRes2 = maybeFgResidue False "residue 2" 32 fResname2 fChain2 fResnum2 fInsCode2 + fgRes3 = maybeFgResidue False "residue 3" 43 fResname3 fChain3 fResnum3 fInsCode3 + fgRes4 = maybeFgResidue False "residue 4" 54 fResname4 fChain4 fResnum4 fInsCode4 + + residues = rights [fgRes1] ++ maybeList (rights [fgRes2, fgRes3, fgRes4]) + + fgErrs = liftFgErrs line_no [fgRes1] ++ + liftFgErrs line_no [fgRes2, fgRes3, fgRes4] + + -- unpack fields + result = SITE serial siteid numres residues + +--------------- }}} SITE records + diff --git a/Bio/PDB/EventParser/ParseSLTBRG.hs b/Bio/PDB/EventParser/ParseSLTBRG.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseSLTBRG.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} + +-- | Parsing of SLTBRG records. +module Bio.PDB.EventParser.ParseSLTBRG(parseSLTBRG) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ SLTBRG records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +--------------------------------------------------------------------------------- + 1 - 6 Record name "SLTBRG" +13 - 16 Atom atom1 First atom name. +17 Character altLoc1 Alternate location indicator. +18 - 20 Residue name resName1 Residue name. +22 Character chainID1 Chain identifier. +23 - 26 Integer resSeq1 Residue sequence number. +27 AChar iCode1 Insertion code. +43 - 46 Atom atom2 Second atom name. +47 Character altLoc2 Alternate location indicator. +48 - 50 Residue name resName2 Residue name. +52 Character chainID2 Chain identifier. +53 - 56 Integer resSeq2 Residue sequence number. +57 AChar iCode2 Insertion code. +60 - 65 SymOP sym1 Symmetry operator for 1st atom. +67 - 72 SymOP sym2 Symmetry operator for 2nd atom. +--} + +{-# INLINE sltbrgFields #-} +sltbrgFields = [(6, mKeyword "record header" "SLTBRG" ), + (12, mSpc 6 ), + (16, mStr "first atom name" ), + (17, mChr "alternate location indicator 1" ), + (20, mStr "residue name 1" ), + (21, mSpc 1 ), + (22, mChr "chain identifier 1" ), + (26, mInt "residue 1 sequence number" ), + (27, mChr "insertion code" ), + (42, mSpc 15 ), + (46, mStr "second atom name" ), + (47, mChr "alternate location indicator 2" ), + (50, mStr "residue name 2" ), + (51, mSpc 1 ), + (52, mChr "chain identifier 2" ), + (56, mInt "residue sequence number 2" ), + (57, mChr "insertion code 2" ), + (59, pSpc ), + (65, pStr "symmetry operator for residue 1" ), + (66, pSpc ), + (72, pStr "symmetry operator for residue 2" )] + +-- | Parses a SLTBRG record: +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseSLTBRG :: (Monad m) => String -> Int -> m [PDBEvent] +parseSLTBRG line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + errs = fErrs ++ fgErrs + (fields, fErrs) = parseFields sltbrgFields line line_no + [fRec, _, + fAtomName1, fAltLoc1, fResname1, _, fChain1, fResnum1, fInsCode1, _, + fAtomName2, fAltLoc2, fResname2, _, fChain2, fResnum2, fInsCode2, _, + fSymOp1, _, fSymOp2] = fields + IFChar altloc1 = fAltLoc1 + IFChar altloc2 = fAltLoc2 + IFStr symOp1 = fSymOp1 + IFStr symOp2 = fSymOp2 + + fgErrs = liftFgErrs line_no [fgAtom1, fgAtom2] + fgAtom1 = fgAtom "first residue of SLTBRG" 16 fAtomName1 fResname1 fChain1 fResnum1 fInsCode1 + fgAtom2 = fgAtom "second residue of SLTBRG" 46 fAtomName1 fResname1 fChain2 fResnum2 fInsCode2 + [atom1, atom2] = rights [fgAtom1, fgAtom2] + + -- unpack fields + result = SLTBRG atom1 altloc1 atom2 altloc2 symOp1 symOp2 + +--------------- }}} SLTBRG records + diff --git a/Bio/PDB/EventParser/ParseSPLIT.hs b/Bio/PDB/EventParser/ParseSPLIT.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseSPLIT.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Parsing SPLIT records. +module Bio.PDB.EventParser.ParseSPLIT(parseSPLIT) +where + +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ SPLIT records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +---------------------------------------------------------------------------------- + 1 - 6 Record name "SPLIT " + 9 - 10 Continuation continuation Allows concatenation of multiple records. +12 - 15 IDcode idCode ID code of related entry. +17 - 20 IDcode idCode ID code of related entry. +22 - 25 IDcode idCode ID code of related entry. +27 – 30 IDcode idCode ID code of related entry. +32 - 35 IDcode idCode ID code of related entry. +37 - 40 IDcode idCode ID code of related entry. +42 - 45 IDcode idCode ID code of related entry. +47 - 50 IDcode idCode ID code of related entry. +52 - 55 IDcode idCode ID code of related entry. +57 - 60 IDcode idCode ID code of related entry. +62 - 65 IDcode idCode ID code of related entry. +67 - 70 IDcode idCode ID code of related entry. +72 - 75 IDcode idCode ID code of related entry. +77 - 80 IDcode idCode ID code of related entry. +--} + +titleFields = [(6, mKeyword "record header" "SPLIT "), + (8, mSpc 2), + (10, dInt "continuation" 0), + (80, pStr "PDB id codes needed for whole complex")] + +{-# SPECIALIZE parseSPLIT :: BS.ByteString -> Int -> IO [PDBEvent] #-} +-- | Parses a SPLIT record: +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseSPLIT :: (Monad m) => BS.ByteString -> Int -> m [PDBEvent] +parseSPLIT line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields titleFields line line_no + [fRec, fSpc, fCont, fCodeString] = fields + -- unpack fields + IFInt cont = fCont + IFStr codeString = fCodeString + codes = filter (/="") $ BS.split ' ' codeString + + result = SPLIT cont codes + +-- NOTE: consecutive "SPLIT" records should be merged into a single multiline entry with SUCH method + +--------------- }}} SPLIT records + diff --git a/Bio/PDB/EventParser/ParseSSBOND.hs b/Bio/PDB/EventParser/ParseSSBOND.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseSSBOND.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} +-- | Parsing SSBOND records. +module Bio.PDB.EventParser.ParseSSBOND(parseSSBOND) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ SSBOND records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +-------------------------------------------------------------------------------- + 1 - 6 Record name "SSBOND" + 8 - 10 Integer serNum Serial number. +12 - 14 LString(3) "CYS" Residue name. +16 Character chainID1 Chain identifier. +18 - 21 Integer seqNum1 Residue sequence number. +22 AChar icode1 Insertion code. +26 - 28 LString(3) "CYS" Residue name. +30 Character chainID2 Chain identifier. +32 - 35 Integer seqNum2 Residue sequence number. +36 AChar icode2 Insertion code. +60 - 65 SymOP sym1 Symmetry operator for residue 1. +67 - 72 SymOP sym2 Symmetry operator for residue 2. +74 – 78 Real(5.2) Length Disulfide bond distance +--} + +{-# INLINE ssbondFields #-} +ssbondFields = [(6, mKeyword "record header" "SSBOND" ), + (7, mSpc 1 ), + (10, mInt "record serial number" ), + (11, mSpc 1 ), + (14, mKeyword "residue name 1" "CYS" ), + (15, mSpc 1 ), + (16, mChr "chain id 1" ), + (17, mSpc 1 ), + (21, mInt "residue sequence number 1" ), + (22, mChr "insertion code" ), + (25, mSpc 3 ), + (28, mKeyword "residue name 2" "CYS" ), + (29, mSpc 1 ), + (30, mChr "chain id 2" ), + (31, mSpc 1 ), + (35, mInt "residue sequence number 2" ), + (36, mChr "insertion code 2" ), + (59, pSpc ), + (65, pStr "symmetry operator for residue 1" ), + (66, pSpc ), + (72, pStr "symmetry operator for residue 2" ), + (78, dDouble "disulfide bond length" 2.05 )] + +-- | Parses a SSBOND record: +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseSSBOND :: (Monad m) => String -> Int -> m [PDBEvent] +parseSSBOND line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + errs = fErrs ++ fgErrs + (fields, fErrs) = parseFields ssbondFields line line_no + [fRec, _, fSerial, _, + fResname1, _, fChain1, _, fResnum1, fInsCode1, _, + fResname2, _, fChain2, _, fResnum2, fInsCode2, _, + fSymOp1, _, fSymOp2, fBondLen] = fields + IFInt serial = fSerial + IFStr symOp1 = fSymOp1 + IFStr symOp2 = fSymOp2 + IFDouble bondLen = fBondLen + + fgErrs = liftFgErrs line_no [fgRes1, fgRes2] + fgRes1 = fgResidue False "first residue of SSBOND" 14 (IFStr "CYS") fChain1 fResnum1 fInsCode1 + fgRes2 = fgResidue False "second residue of SSBOND" 28 (IFStr "CYS") fChain2 fResnum2 fInsCode2 + [res1, res2] = rights [fgRes1, fgRes2] + + -- unpack fields + result = SSBOND serial res1 res2 symOp1 symOp2 bondLen + +--------------- }}} SSBOND records + diff --git a/Bio/PDB/EventParser/ParseSpecListRecord.hs b/Bio/PDB/EventParser/ParseSpecListRecord.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseSpecListRecord.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, NoMonomorphismRestriction #-} + +-- | Parsing of <> type of records: COMPND and SOURCE. +module Bio.PDB.EventParser.ParseSpecListRecord(parseCOMPND, parseSOURCE) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ SpecListRecord records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +---------------------------------------------------------------------------------- + 1 - 6 Record name "COMPND" + 8 - 10 Continuation continuation Allows concatenation of multiple records. +11 - 80 Specification compound Description of the molecular components. + list +--} +-- TODO: Parse value types in COMPND records + +{-# INLINE specListRecordFields #-} +specListRecordFields = [ + (6, mKeywords "record header" ["SOURCE", "COMPND"]), + (7, mSpc 1 ), + (10, dInt "continuation" 0 ), + (80, mStr "specification list" )] + +{-# INLINE parseSpecListRecord #-} +-- NOTE: SpecLists need to be parsed after merging!!! +--{-# SPECIALIZE parseSpecListRecord :: String -> Int -> IO [PDBEvent] #-} +parseSpecListRecord cons line line_no = return $ + if errs /= [] + then errs + else [result] + where + -- parse + errs :: [PDBEvent] + errs = if fErrs /= [] then fErrs else pErrs + (fields, fErrs) = parseFields specListRecordFields line line_no + [fRec, _, fCont, fSpecList] = fields + IFInt cont = fCont + IFStr specListString = fSpecList + + -- unpack fields + result = cons cont entries + entries = map entry preEntries + preEntries = map (BS.split ':') . + filter (/= "") $ ';' `BS.split` specListString + entry [a, b] = (a, b) + entry [ b] = ("", b) -- NOTE: continuation of previous entry + pErrs :: [PDBEvent] + pErrs = concatMap checkEntry preEntries + checkEntry :: [String] -> [PDBEvent] + checkEntry [_, _] = [] + checkEntry [ _] = [] + checkEntry entry = [PDBParseError line_no 11 {- column where speclist begins -} $ + ("Cannot parse specification list fragment: " `BS.append` + ( BS.pack . show $ entry))] + +-- | Parses a COMPND record: +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseCOMPND :: (Monad m) => String -> Int -> m [PDBEvent] +parseCOMPND = parseSpecListRecord COMPND + +-- | Parses a SOURCE record: +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +-- +-- NOTE: SOURCE record values are always Strings +parseSOURCE :: (Monad m) => String -> Int -> m [PDBEvent] +parseSOURCE = parseSpecListRecord SOURCE + +--------------- }}} SpecListRecord records diff --git a/Bio/PDB/EventParser/ParseTER.hs b/Bio/PDB/EventParser/ParseTER.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseTER.hs @@ -0,0 +1,66 @@ +{---# LANGUAGE PatternGuards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Parsing of TER records. +module Bio.PDB.EventParser.ParseTER(parseTER) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ TER records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +------------------------------------------------------------------------- + 1 - 6 Record name "TER " + 7 - 11 Integer serial Serial number. +18 - 20 Residue name resName Residue name. +22 Character chainID Chain identifier. +23 - 26 Integer resSeq Residue sequence number. +27 AChar iCode Insertion code. + +--} + +{-# INLINE terFields #-} +terFields = [(6, mKeyword "record header" "TER "), + (11, mInt "atom serial number" ), + (17, mSpc 6 ), + (20, mStr "residue name" ), + (21, mSpc 1 ), + (22, mChr "chain identifier" ), + (26, mInt "residue number" ), + (27, dChr "insertion code" ' ')] -- omitted if empty by some programs + +-- | Parses a TER record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseTER :: (Monad m) => String -> Int -> m [PDBEvent] +parseTER line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields terFields line line_no + [fRec, fNum, _, fResName, _, fChain, fResId, fInsCode] = fields + IFInt num = fNum + IFStr resname = fResName + IFChar chain = fChain + IFInt resid = fResId + IFChar insCode = fInsCode + + -- unpack fields + result = TER num resname chain resid insCode + +--------------- }}} TER records + diff --git a/Bio/PDB/EventParser/ParseTITLE.hs b/Bio/PDB/EventParser/ParseTITLE.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseTITLE.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Parse a TITLE record. +module Bio.PDB.EventParser.ParseTITLE(parseTITLE) +where + +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ TITLE records +{-- +COLUMNS DATA TYPE FIELD DEFINITION +---------------------------------------------------------------------------------- + 1 - 6 Record name "TITLE " + 9 - 10 Continuation continuation Allows concatenation of multiple records. +11 - 80 String title Title of the experiment. +--} + +titleFields = [(6, mKeyword "record header" "TITLE "), + (8, mSpc 2), + (10, dInt "continuation" 0), +-- (10, pInt "continuation"), + (80, pStr "title")] + +{-# SPECIALIZE parseTITLE :: BS.ByteString -> Int -> IO [PDBEvent] #-} +-- | Parses a TITLE record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseTITLE :: (Monad m) => BS.ByteString -> Int -> m [PDBEvent] +parseTITLE line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields titleFields line line_no + [fRec, fSpc, fCont, fTitle] = fields + -- unpack fields + IFInt cont = fCont + IFStr title = fTitle + result = TITLE { continuation = cont, + title = title } + +-- NOTE: consecutive "TITLE" records should be merged into a single multiline entry with SUCH method +--mergeTitle :: [PDBEvent] -> m [PDBEvent] + +--------------- }}} TITLE records + diff --git a/Bio/PDB/EventParser/ParseTVECT.hs b/Bio/PDB/EventParser/ParseTVECT.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/ParseTVECT.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} +-- | Parses TVECT records. +module Bio.PDB.EventParser.ParseTVECT(parseTVECT) +where + +import Prelude hiding(String) +import qualified Data.ByteString.Char8 as BS + +import Bio.PDB.EventParser.PDBEvents +import Bio.PDB.EventParser.PDBParsingAbstractions + + +--------------- {{{ TVECT records +{-- +As described on: +http://deposit.rcsb.org/adit/docs/pdb_atom_format.html#TVECT +[This record is not in official PDB file format description v3.20!] + +COLUMNS DATA TYPE CONTENTS +-------------------------------------------------------------------------------- + 1 - 6 Record name "TVECT " + 8 - 10 Integer Serial number +11 - 20 Real(10.5) t[1] +21 - 30 Real(10.5) t[2] +31 - 40 Real(10.5) t[3] +41 - 70 String Text comment +--} + +titleFields = [( 6, mKeyword "record header" "TVECT "), + ( 7, mSpc 1 ), + (10, dInt "serial number" 0 ), + (20, mDouble "t[n][1]" ), + (30, mDouble "t[n][2]" ), + (40, mDouble "t[n][3]" ), + (70, pStr "comment" )] + +-- | Parses a TVECT record. +-- +-- Arguments: +-- +-- (1) input line +-- +-- (2) input line number +-- +-- Result is a monad action returning a list of 'PDBEvent's. +parseTVECT :: (Monad m) => String -> Int -> m [PDBEvent] +parseTVECT line line_no = return $ if errs == [] + then [result] + else errs + where + -- parse + (fields, errs) = parseFields titleFields line line_no + [fRec, _, fSerial, ft1, ft2, ft3, fComment] = fields + -- unpack fields + IFInt serial = fSerial + IFDouble t1 = ft1 + IFDouble t2 = ft2 + IFDouble t3 = ft3 + result = TVECT serial $ Vector3 t1 t2 t3 + +-- NOTE: consecutive "TVECT" records should be merged into a single multiline entry with SUCH method +--mergeTVECTRecords :: [PDBEvent] -> m [PDBEvent] + +--------------- }}} TVECT records + diff --git a/Bio/PDB/EventParser/StrandSense.hs b/Bio/PDB/EventParser/StrandSense.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/EventParser/StrandSense.hs @@ -0,0 +1,8 @@ +{-| Module with enumeration of beta-strand senses. -} +module Bio.PDB.EventParser.StrandSense(StrandSenseT(Parallel, Antiparallel)) +where + +{-| Enumeration of beta-strand sense. -} +data StrandSenseT = Parallel | + Antiparallel + deriving (Eq, Ord, Show, Read) diff --git a/Bio/PDB/Fasta.hs b/Bio/PDB/Fasta.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/Fasta.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} + +module Bio.PDB.Fasta(resname2fastacode, fastacode2resname , + defaultResname, defaultFastaCode , + fastaSequence, fastaGappedSequence, + fastaRecord, fastaGappedRecord ) where + +import Bio.PDB.Iterable as Iter +import Bio.PDB.Structure as PDB +import Data.Map as Map + +-- | Standard nucleic acid codes +codebook_nucleic_acids = [ + -- RNA codes + ("A", 'A'), + ("C", 'C'), + ("G", 'G'), + ("U", 'U'), + ("I", 'I'), + -- DNA codes + ("DA", 'A'), + ("DG", 'G'), + ("DC", 'C'), + ("DT", 'T'), + ("DI", 'I'), + -- incorrect name for thymine (instead of DT) + ("T", 'T') + ] + +-- | List of all correspondences between FASTA 1-letter codes, and PDB 3-letter codes. +codebook = codebook_nucleic_acids ++ codebook_protein + +-- | Standard protein codes +codebook_standard_protein = [ + ("ALA", 'A'), + ("CYS", 'C'), + ("ASP", 'D'), + ("GLU", 'E'), + ("PHE", 'F'), + + ("GLY", 'G'), + ("HIS", 'H'), + ("ILE", 'I'), + ("LYS", 'K'), + ("LEU", 'L'), + + ("MET", 'M'), + ("ASN", 'N'), + ("PRO", 'P'), + ("GLN", 'Q'), + ("ARG", 'R'), + + ("SER", 'S'), + ("THR", 'T'), + ("VAL", 'V'), + ("TRP", 'W'), + ("TYR", 'Y')] + +-- | List of both standard and non-standard protein codes. +codebook_protein = codebook_standard_protein ++ [ + -- Protein codes (common variants) + ("MSE", 'M')] -- selenomethionine + +-- | Dictionary of translations from all 3-letter PDB codes into 1-letter FASTA aminoacid codes. +resname2fastacodeDictionary = Map.fromList codebook + +-- | Dictionary of translations from 1-letter FASTA aminoacid (standard +-- protein) codes into 3-letter PDB codes. +fastacode2resnameDictionary = Map.fromList . Prelude.map (\(a, b) -> (b, a)) $ codebook_standard_protein + +-- | Three-letter PDB code for an unknown type of residue. +defaultResname = "UNK" + +-- | One-letter aminoacid code for an unknown type of residue. +defaultFastaCode = 'X' + +-- | Dictionary mapping three-letter PDB residue code to a single-letter FASTA code. +resname2fastacode resname = Map.findWithDefault defaultFastaCode resname resname2fastacodeDictionary + +-- | Dictionary mapping single-letter FASTA standard aminoacid code to a PDB residue name +fastacode2resname code = Map.findWithDefault defaultResname code fastacode2resnameDictionary + +-- | Converts a `Bio.PDB.Structure.Residue` into a one character aminoacid code. +res2code :: Residue -> Char +res2code r = resname2fastacode . resName $ r + +-- | Converts an `Iterable` yielding `Residue`s into a list of aminoacid one-character codes. +fastaSequence :: (Iterable a Residue) => a -> [Char] +fastaSequence = Iter.ifoldr (\a b -> res2code a : b) [] + +-- | Converts an `Iterable` yielding `Residue`s into a list of aminoacid one-character codes. +fastaGappedSequence :: (Iterable a Residue) => a -> [Char] +fastaGappedSequence = concat . scan2 insertGaps projectAA . Iter.ifoldr (\a b -> (resSeq a, res2code a) : b) [] + where + projectAA (i, aa) = [aa] + insertGaps (i, _ ) (j, aa) = ['-' | _ <- [2..j-i]] ++ [aa] + +-- | Scans a list and applies first argument to all consecutive pairs, +-- and second argument to the beginning or `lone wolf`, mapping to +-- a list of the same length. +scan2 f g [] = [] +scan2 f g (b:bs) = g b:scan2' b bs + where scan2' b (c:cs) = f b c:scan2' c cs + scan2' b [] = [] + +-- | Convert a filename and Chain into a text of FASTA format record. +-- First argument tells if we want gaps included. +fastaRecord' :: Bool -> [Char] -> Chain -> [Char] +fastaRecord' withGaps ident c = ">" ++ header ++ "\n" ++ fastaSeq c + where + header = if chainId c == ' ' + then ident + else ident ++ "|" ++ [chainId c] + fastaSeq = if withGaps then fastaSequence else fastaGappedSequence + +fastaRecord = fastaRecord' False +fastaGappedRecord = fastaRecord' True + + diff --git a/Bio/PDB/IO.hs b/Bio/PDB/IO.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/IO.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Bio.PDB.IO(parse, write) where + +import qualified Control.Exception(catch) +import Control.Exception.Base(SomeException) +import System.IO hiding(writeFile) +import Prelude hiding(String,writeFile) +import Bio.PDB.EventParser.PDBParsingAbstractions +import Bio.PDB.Structure.List as L +import qualified Bio.PDB.StructurePrinter as PDBSP +import Control.Monad(when) + +import Bio.PDB.EventParser.PDBEvents(PDBEvent(PDBParseError, PDBIgnoredLine)) +--import qualified Bio.PDB.EventParser.PDBEventPrinter as PDBEventPrinter +import qualified Bio.PDB.StructureBuilder(parse) +import qualified Bio.PDB.Structure + +import qualified Data.ByteString.Char8 as BS +import Bio.PDB.IO.OpenAnyFile +import Control.DeepSeq + +type String = BS.ByteString + +-- Until I get a newer version of Control.DeepSeq: +force x = x `deepseq` x + +parse :: String -> IO (Maybe Bio.PDB.Structure.Structure) +parse filename = do input <- Bio.PDB.IO.OpenAnyFile.readFile $ BS.unpack filename + (do (structure, errs) <- return $ Bio.PDB.StructureBuilder.parse filename input + mapM_ (showError filename) (L.toList errs) + structure `deepseq` return $ Just $ structure + `Control.Exception.catch` + (exceptionHandler filename)) + +exceptionHandler :: String -> SomeException -> IO (Maybe a) +exceptionHandler filename e = do printError $ [filename, ":", BS.pack $ show e] + return Nothing + +printError msg = BS.hPutStrLn System.IO.stderr $ BS.concat msg + +showError filename (PDBParseError line_no col_no msg) = + printError $ [filename, ":", BS.pack $ show line_no, ":", BS.pack $ show col_no, "\t", msg] +showError filename (PDBIgnoredLine line) = + printError $ [filename, ": IGNORED ", line] + +-- | Write structure to a .pdb file. (NOT YET IMPLEMENTED) +write :: Bio.PDB.Structure.Structure -> String -> IO () +write structure fname = writeFile (BS.unpack fname) $ \h -> PDBSP.write h structure + diff --git a/Bio/PDB/IO/OpenAnyFile.hs b/Bio/PDB/IO/OpenAnyFile.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/IO/OpenAnyFile.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE OverloadedStrings, CPP #-} + +-- | Opening and reading a either normal or gzipped file in an efficient way - +-- either using strict 'ByteString' or mmap + +module Bio.PDB.IO.OpenAnyFile(readFile, writeFile) + +where + +import Prelude hiding (readFile, writeFile) +import System.Directory (doesFileExist, getPermissions, Permissions(..)) +import System.IO.Error (userError, IOError) +import System.IO (withFile, IOMode(..)) +-- if we have zlib: +import qualified Codec.Compression.GZip as GZip +import qualified Data.ByteString.Lazy as BSL +import qualified Control.Exception as Exc + +-- if we have bzlib +--import qualified Codec.Compression.BZip as BZip + +-- if we have MMap: +#ifdef HAVE_MMAP +import System.IO.Posix.MMap(unsafeMMapFile) +#endif + +-- otherwise: +import qualified Data.ByteString.Char8 as BS + +readFile fname = do r <- isReadable fname + if r + then + readFile' fname + else + throwNotFound fname + +readFile' fname = do content <- simpleRead fname + let r = (let codec = getCodec fname content + in BS.concat $ BSL.toChunks $ codec $ BSL.fromChunks [content]) + return r + +throwNotFound :: String -> IO a +throwNotFound fname = ioError $ userError $ concat ["Cannot read ", show fname, "!"] + +getCodec fname c | (".gz" `BS.isSuffixOf` BS.pack fname) || + (".Z" `BS.isSuffixOf` BS.pack fname) = GZip.decompressWith (gzipParams c) +--getCodec fname c | (".bz2" `BS.isSuffixOf` (BS.pack fname)) = BZip.decompressWith (bzipParams c) -- DOESN'T WORK!!! +getCodec fname c | otherwise = id + +gzipParams c = GZip.DecompressParams GZip.defaultWindowBits (fromIntegral (BS.length c * 5)) +#ifndef OLD_ZLIB + Nothing +#endif + -- Upper bound: compression rate never exceeded 4.7 for big test files. + +--bzipParams c = BZip.DecompressParams BZip.DefaultMemoryLevel (fromIntegral (BS.length c * 7 + 4*1024*1024)) -- Upper bound: compression rate never exceeded 6.7 for big test files + 4MiB buffering. + +isReadable fname = do exists <- doesFileExist fname + if exists + then do perms <- getPermissions fname + return $! readable perms + else return False + +#ifndef HAVE_MMAP +simpleRead fname = BS.readFile fname +#else +simpleRead fname = unsafeMMapFile fname `Exc.catch` \e -> do reportError (e :: IOError) + BS.readFile fname + where + reportError e = do putStrLn $ concat [show e, "while trying to mmap('", fname, "')"] +#endif + +writeFile fname writer = do withFile fname WriteMode $ writer + return () diff --git a/Bio/PDB/InstantiateIterable.hs b/Bio/PDB/InstantiateIterable.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/InstantiateIterable.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, NoMonomorphismRestriction #-} +module Bio.PDB.InstantiateIterable(Iterable(..) , + gen_iterable , + self_iterable , + trans_iterable) where + +import qualified Bio.PDB.Structure.List as L +import Language.Haskell.TH.Syntax +import Control.Monad.Identity(runIdentity,foldM) +import Data.List(foldl') + +class Iterable a b where + imapM :: (Monad m) => (b -> m b) -> a -> m a + imap :: (b -> b) -> a -> a + imap f e = runIdentity $ imapM (\b -> return $ f b) e + ifoldM :: (Monad m) => (c -> b -> m c) -> c -> a -> m c + ifoldr :: (b -> c -> c) -> c -> a -> c + ifoldl :: (c -> b -> c) -> c -> a -> c + ifoldl' :: (c -> b -> c) -> c -> a -> c + ilength :: b -> a -> Int -- NOTE: b is 'dummy' type argument to satisfy Iterable a b constraint + +-- | Generates a direct instance of iterable between $typA and $typB with +-- given names of getter and setter, so that: +-- $getter :: $typA -> $typB +-- $setter :: $typB -> $typA -> $typA +gen_iterable typA typB getter setter = + [d| instance Iterable $(typA) $(typB) where + imapM f a = + do b' <- L.mapM f ( $(getter) a) + return $ $(setter) a b' + ifoldM f e a = do r <- L.foldM f e ( $(getter) a) + return r + ifoldr f e a = L.foldr f e ( $(getter) a) + ifoldl f e a = L.foldl f e ( $(getter) a) + ifoldl' f e a = L.foldl' f e ( $(getter) a) + ilength d a = L.length ( $(getter) a) + |] + +-- | Generates convenience function for iterating over a single object. +self_iterable typA = + [d| instance Iterable $(typA) $(typA) where + imapM f a = f a + ifoldM f e a = f e a + ifoldr f e a = f a e + ifoldl f e a = f e a + ifoldl' f e a = f e a + ilength d a = 1 + |] +--self_iterable typA = gen_iterable typA typA [e| id |] [e| L.singleton |] + +-- This works: +-- ilength a = L.length ( $(getter) a) + +-- | Generates a transitive instance of `Iterable` between $typA and $typC, +-- assuming existence of `Iterable` $typA $typB, and `Iterable` $typB $typC. +trans_iterable typA typB typC = + [d| instance Iterable $(typA) $(typC) where + imapM f a = (imapM :: (Monad m) => ( $(typB) -> m $(typB) ) -> $(typA) -> m $(typA) ) (imapM f) a + imap f a = (imap :: ( $(typB) -> $(typB) ) -> $(typA) -> $(typA) ) (imap f) a + ifoldM f e a = (ifoldM :: (Monad m) => (c -> $(typB) -> m c) -> c -> $(typA) -> m c ) (ifoldM f) e a + ifoldr f e a = (ifoldr :: ($(typB) -> c -> c) -> c -> $(typA) -> c ) (\bb cc -> ifoldr f cc bb) e a + ifoldl f e a = (ifoldl :: (c -> $(typB) -> c) -> c -> $(typA) -> c ) (ifoldl f) e a + ifoldl' f e a = (ifoldl' :: (c -> $(typB) -> c) -> c -> $(typA) -> c ) (ifoldl' f) e a + ilength _ a = (ifoldl' :: (c -> $(typB) -> c) -> c -> $(typA) -> c ) (\a b-> a + ilength (undefined :: $(typC)) b) 0 a + |] +-- How to make this work: +-- ilength a = (ifoldl' :: (Int -> $(typB) -> Int) -> Int -> $(typA) -> Int ) (\i b -> i+(ilength :: Iterable $(typB) $(typC) => $(typB) -> Int) b) 0 a + diff --git a/Bio/PDB/Iterable.hs b/Bio/PDB/Iterable.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/Iterable.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, OverlappingInstances, TemplateHaskell, FlexibleContexts #-} +module Bio.PDB.Iterable(Iterable(..)) where + +import Bio.PDB.Structure.List as L +import Bio.PDB.Structure +import Control.Monad.Identity +import Control.Monad(foldM) + +import Bio.PDB.InstantiateIterable + +$(gen_iterable [t| Structure |] [t| Model |] [e| models |] [e| (\s m -> s { models = m }) |] ) + +$(gen_iterable [t| Model |] [t| Chain |] [e| chains |] [e| (\s m -> s { chains = m }) |] ) + +$(gen_iterable [t| Chain |] [t| Residue |] [e| residues |] [e| (\s m -> s { residues = m }) |] ) + +$(gen_iterable [t| Residue |] [t| Atom |] [e| atoms |] [e| (\s m -> s { atoms = m }) |] ) + +$(self_iterable [t| Structure |] ) +$(self_iterable [t| Model |] ) +$(self_iterable [t| Chain |] ) +$(self_iterable [t| Residue |] ) +$(self_iterable [t| Atom |] ) + +$(trans_iterable [t| Structure |] [t| Model |] [t| Chain |] ) +$(trans_iterable [t| Structure |] [t| Model |] [t| Residue |] ) +$(trans_iterable [t| Structure |] [t| Model |] [t| Atom |] ) + +$(trans_iterable [t| Model |] [t| Chain |] [t| Residue |] ) +$(trans_iterable [t| Model |] [t| Chain |] [t| Atom |] ) + +$(trans_iterable [t| Chain |] [t| Residue |] [t| Atom |] ) + diff --git a/Bio/PDB/Iterable/Utils.hs b/Bio/PDB/Iterable/Utils.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/Iterable/Utils.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-} +module Bio.PDB.Iterable.Utils(firstModel, + numAtoms, + numResidues, + numChains, + numModels) +where + +import Bio.PDB.Structure +import Bio.PDB.Iterable + +firstModel :: (Iterable a Model) => a -> Maybe Model +firstModel = ifoldr (\m _ -> Just m) Nothing + +-- GHC BUG: I see no reason, why such a function has to have explicit type decl +numAtoms :: Iterable a Atom => a -> Int +numAtoms = ilength (undefined :: Atom) + +numResidues :: Iterable a Residue => a -> Int +numResidues = ilength (undefined :: Residue) + +numChains :: Iterable a Chain => a -> Int +numChains = ilength (undefined :: Chain) + +numModels :: Iterable a Model => a -> Int +numModels = ilength (undefined :: Model) + diff --git a/Bio/PDB/Structure.hs b/Bio/PDB/Structure.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/Structure.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE BangPatterns, DisambiguateRecordFields #-} +module Bio.PDB.Structure(String, + vdot, vnorm, vproj, vperpend, vperpends, vdihedral, (*|), (|*), + Structure(..), Model(..), Chain(..), Residue(..), Atom(..)) + +where + +import Prelude hiding(String) +import Bio.PDB.EventParser.PDBEvents(String, Vector3(..)) -- extract to a separate module? +import Control.DeepSeq +--import Data.Derive.NFData +import Bio.PDB.Structure.List as L +import Bio.PDB.Structure.Vector + +-- | Structure holds all data parsed from a single PDB entry +data Structure = Structure { -- remarks :: [Map String String] + models :: L.List Model + } deriving (Eq, Show) + +instance NFData Structure where + rnf m = rnf (models m) `seq` () + +{-- Using DERIVE would be so much simpler, but also more difficult to get working on GHC-7.4 (for now) +deriving instance NFData Structure +deriving instance NFData Model +deriving instance NFData Chain +deriving instance NFData Residue +deriving instance NFData Atom +--} + +-- | PDB entry may contain multiple models, with slight differences in coordinates etc. +data Model = Model { modelId :: !Int, + chains :: L.List Chain + } deriving (Eq, Show) + +instance NFData Model where + rnf m = modelId m `seq` rnf (chains m) `seq` () + +-- | Single linear polymer chain of protein, or nucleic acids +data Chain = Chain { chainId :: !Char, + residues :: L.List Residue + } deriving (Eq, Show) + +instance NFData Chain where + rnf m = chainId m `seq` rnf (residues m) `seq` () + +-- | Residue groups all atoms assigned to the same aminoacid or nucleic acid base within a polymer chain. +data Residue = Residue { resName :: !String, + resSeq :: !Int, + atoms :: L.List Atom, + + insCode :: !Char + -- ss :: SSType + } deriving (Eq, Show) + +instance NFData Residue where + rnf r = rnf (atoms r) `seq` () +{- TODO: +data SSType = SSHelix HelixType | + SSStrand StrandType StrandSense + -} +-- TODO: LINKs (default and added) + +-- | Single atom position +-- | NOTE: disordered atoms are now reported as multiplicates +data Atom = Atom { atName :: !String, + atSerial :: !Int, + coord :: !Vector3, + + bFactor :: !Double, + occupancy :: !Double, + element :: !String, + segid :: !String, + charge :: !String, + hetatm :: !Bool + } deriving (Eq, Show) + +-- constructor is strict in all arguments... +instance NFData Atom where diff --git a/Bio/PDB/Structure/Elements.hs b/Bio/PDB/Structure/Elements.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/Structure/Elements.hs @@ -0,0 +1,554 @@ +{-# LANGUAGE OverloadedStrings, BangPatterns #-} +module Bio.PDB.Structure.Elements(Element(..), + -- Finding element for a given atom + assignElement, + -- Guessing element name from atom name (for standard residues only.) + guessElement, + -- properties of elements + atomicNumber, atomicMass, covalentRadius, vanDerWaalsRadius) where + +import Prelude hiding (error, String) +import Data.ByteString.Char8 as BS +import System.IO.Unsafe(unsafePerformIO) +import System.IO(stderr) +import Bio.PDB.Structure(Atom(..)) + +-- ^ Basic elemental parameters as suggested by CSD. + +-- | TODO: May be better as a newtype, and make sure that other modules use this declaration +type Element = BS.ByteString + +-- | Internal method that reports error to stderr, and return given default value. +defaulting e defaultValue = unsafePerformIO $ do BS.hPutStrLn stderr $ BS.concat e + return defaultValue + +-- | Atomic number of a given element +{-# INLINE atomicNumber #-} +{-# INLINE atomicMass #-} +{-# INLINE covalentRadius #-} +{-# INLINE vanDerWaalsRadius #-} +atomicNumber :: Element -> Int +atomicNumber "C" = 6 +atomicNumber "N" = 7 +atomicNumber "O" = 8 +atomicNumber "P" = 15 +atomicNumber "S" = 16 +atomicNumber "H" = 1 +atomicNumber "AC" = 89 +atomicNumber "AG" = 47 +atomicNumber "AL" = 13 +atomicNumber "AM" = 95 +atomicNumber "AR" = 18 +atomicNumber "AS" = 33 +atomicNumber "AT" = 85 +atomicNumber "AU" = 79 +atomicNumber "B" = 5 +atomicNumber "BA" = 56 +atomicNumber "BE" = 4 +atomicNumber "BH" = 107 +atomicNumber "BI" = 83 +atomicNumber "BK" = 97 +atomicNumber "BR" = 35 +atomicNumber "CA" = 20 +atomicNumber "CD" = 48 +atomicNumber "CE" = 58 +atomicNumber "CF" = 98 +atomicNumber "CL" = 17 +atomicNumber "CM" = 96 +atomicNumber "CO" = 27 +atomicNumber "CR" = 24 +atomicNumber "CS" = 55 +atomicNumber "CU" = 29 +atomicNumber "DB" = 105 +atomicNumber "DS" = 110 +atomicNumber "DY" = 66 +atomicNumber "ER" = 68 +atomicNumber "ES" = 99 +atomicNumber "EU" = 63 +atomicNumber "F" = 9 +atomicNumber "FE" = 26 +atomicNumber "FM" = 100 +atomicNumber "FR" = 87 +atomicNumber "GA" = 31 +atomicNumber "GD" = 64 +atomicNumber "GE" = 32 +atomicNumber "HE" = 2 +atomicNumber "HF" = 72 +atomicNumber "HG" = 80 +atomicNumber "HO" = 67 +atomicNumber "HS" = 108 +atomicNumber "I" = 53 +atomicNumber "IN" = 49 +atomicNumber "IR" = 77 +atomicNumber "K" = 19 +atomicNumber "KR" = 36 +atomicNumber "LA" = 57 +atomicNumber "LI" = 3 +atomicNumber "LR" = 103 +atomicNumber "LU" = 71 +atomicNumber "MD" = 101 +atomicNumber "MG" = 12 +atomicNumber "MN" = 25 +atomicNumber "MO" = 42 +atomicNumber "MT" = 109 +atomicNumber "NA" = 11 +atomicNumber "NB" = 41 +atomicNumber "ND" = 60 +atomicNumber "NE" = 10 +atomicNumber "NI" = 28 +atomicNumber "NO" = 102 +atomicNumber "NP" = 93 +atomicNumber "OS" = 76 +atomicNumber "PA" = 91 +atomicNumber "PB" = 82 +atomicNumber "PD" = 46 +atomicNumber "PM" = 61 +atomicNumber "PO" = 84 +atomicNumber "PR" = 59 +atomicNumber "PT" = 78 +atomicNumber "PU" = 94 +atomicNumber "RA" = 88 +atomicNumber "RB" = 37 +atomicNumber "RE" = 75 +atomicNumber "RF" = 104 +atomicNumber "RH" = 45 +atomicNumber "RN" = 86 +atomicNumber "RU" = 44 +atomicNumber "SB" = 51 +atomicNumber "SC" = 21 +atomicNumber "SE" = 34 +atomicNumber "SG" = 106 +atomicNumber "SI" = 14 +atomicNumber "SM" = 62 +atomicNumber "SN" = 50 +atomicNumber "SR" = 38 +atomicNumber "TA" = 73 +atomicNumber "TB" = 65 +atomicNumber "TC" = 43 +atomicNumber "TE" = 52 +atomicNumber "TH" = 90 +atomicNumber "TI" = 22 +atomicNumber "TL" = 81 +atomicNumber "TM" = 69 +atomicNumber "U" = 92 +atomicNumber "V" = 23 +atomicNumber "W" = 74 +atomicNumber "XE" = 54 +atomicNumber "Y" = 39 +atomicNumber "YB" = 70 +atomicNumber "ZN" = 30 +atomicNumber "ZR" = 40 +atomicNumber x = defaulting ["Unknown atomic number for element:", BS.pack $ show x] 0 + +covalentRadius "AC" = 2.15 +covalentRadius "AG" = 1.45 +covalentRadius "AL" = 1.21 +covalentRadius "AM" = 1.80 +covalentRadius "AR" = 1.51 +covalentRadius "AS" = 1.21 +covalentRadius "AT" = 1.21 +covalentRadius "AU" = 1.36 +covalentRadius "B" = 0.83 +covalentRadius "BA" = 2.15 +covalentRadius "BE" = 0.96 +covalentRadius "BH" = 1.50 +covalentRadius "BI" = 1.48 +covalentRadius "BK" = 1.54 +covalentRadius "BR" = 1.21 +covalentRadius "C" = 0.68 +covalentRadius "CA" = 1.76 +covalentRadius "CD" = 1.44 +covalentRadius "CE" = 2.04 +covalentRadius "CF" = 1.83 +covalentRadius "CL" = 0.99 +covalentRadius "CM" = 1.69 +covalentRadius "CO" = 1.26 +covalentRadius "CR" = 1.39 +covalentRadius "CS" = 2.44 +covalentRadius "CU" = 1.32 +covalentRadius "DB" = 1.50 +covalentRadius "DS" = 1.50 +covalentRadius "DY" = 1.92 +covalentRadius "ER" = 1.89 +covalentRadius "ES" = 1.50 +covalentRadius "EU" = 1.98 +covalentRadius "F" = 0.64 +covalentRadius "FE" = 1.52 +covalentRadius "FM" = 1.50 +covalentRadius "FR" = 2.60 +covalentRadius "GA" = 1.22 +covalentRadius "GD" = 1.96 +covalentRadius "GE" = 1.17 +covalentRadius "H" = 0.23 +covalentRadius "HE" = 1.50 +covalentRadius "HF" = 1.75 +covalentRadius "HG" = 1.32 +covalentRadius "HO" = 1.92 +covalentRadius "HS" = 1.50 +covalentRadius "I" = 1.40 +covalentRadius "IN" = 1.42 +covalentRadius "IR" = 1.41 +covalentRadius "K" = 2.03 +covalentRadius "KR" = 1.50 +covalentRadius "LA" = 2.07 +covalentRadius "LI" = 1.28 +covalentRadius "LR" = 1.50 +covalentRadius "LU" = 1.87 +covalentRadius "MD" = 1.50 +covalentRadius "MG" = 1.41 +covalentRadius "MN" = 1.61 +covalentRadius "MO" = 1.54 +covalentRadius "MT" = 1.50 +covalentRadius "N" = 0.68 +covalentRadius "NA" = 1.66 +covalentRadius "NB" = 1.64 +covalentRadius "ND" = 2.01 +covalentRadius "NE" = 1.50 +covalentRadius "NI" = 1.24 +covalentRadius "NO" = 1.50 +covalentRadius "NP" = 1.90 +covalentRadius "O" = 0.68 +covalentRadius "OS" = 1.44 +covalentRadius "P" = 1.05 +covalentRadius "PA" = 2.00 +covalentRadius "PB" = 1.46 +covalentRadius "PD" = 1.39 +covalentRadius "PM" = 1.99 +covalentRadius "PO" = 1.40 +covalentRadius "PR" = 2.03 +covalentRadius "PT" = 1.36 +covalentRadius "PU" = 1.87 +covalentRadius "RA" = 2.21 +covalentRadius "RB" = 2.20 +covalentRadius "RE" = 1.51 +covalentRadius "RF" = 1.50 +covalentRadius "RH" = 1.42 +covalentRadius "RN" = 1.50 +covalentRadius "RU" = 1.46 +covalentRadius "S" = 1.02 +covalentRadius "SB" = 1.39 +covalentRadius "SC" = 1.70 +covalentRadius "SE" = 1.22 +covalentRadius "SG" = 1.50 +covalentRadius "SI" = 1.20 +covalentRadius "SM" = 1.98 +covalentRadius "SN" = 1.39 +covalentRadius "SR" = 1.95 +covalentRadius "TA" = 1.70 +covalentRadius "TB" = 1.94 +covalentRadius "TC" = 1.47 +covalentRadius "TE" = 1.47 +covalentRadius "TH" = 2.06 +covalentRadius "TI" = 1.60 +covalentRadius "TL" = 1.45 +covalentRadius "TM" = 1.90 +covalentRadius "U" = 1.96 +covalentRadius "V" = 1.53 +covalentRadius "W" = 1.62 +covalentRadius "XE" = 1.50 +covalentRadius "Y" = 1.90 +covalentRadius "YB" = 1.87 +covalentRadius "ZN" = 1.22 +covalentRadius "ZR" = 1.75 +covalentRadius x = defaulting ["Unknown covalent radius for element:", BS.pack $ show x] 0.0 + + +-- | Atomic mass of a given element in g/mol +atomicMass :: Element -> Double +atomicMass "C" = 12.011 +atomicMass "N" = 14.007 +atomicMass "O" = 15.999 +atomicMass "P" = 30.974 +atomicMass "S" = 32.066 +atomicMass "H" = 1.008 +atomicMass "AC" = 227.000 +atomicMass "AG" = 107.868 +atomicMass "AL" = 26.982 +atomicMass "AM" = 243.000 +atomicMass "AR" = 39.948 +atomicMass "AS" = 74.922 +atomicMass "AT" = 210.000 +atomicMass "AU" = 196.967 +atomicMass "B" = 10.811 +atomicMass "BA" = 137.327 +atomicMass "BE" = 9.012 +atomicMass "BH" = 264.000 +atomicMass "BI" = 208.980 +atomicMass "BK" = 247.000 +atomicMass "BR" = 79.904 +atomicMass "CA" = 40.078 +atomicMass "CD" = 112.411 +atomicMass "CE" = 140.116 +atomicMass "CF" = 251.000 +atomicMass "CL" = 35.453 +atomicMass "CM" = 247.000 +atomicMass "CO" = 58.933 +atomicMass "CR" = 51.996 +atomicMass "CS" = 132.905 +atomicMass "CU" = 63.546 +atomicMass "DB" = 262.000 +atomicMass "DS" = 271.000 +atomicMass "DY" = 162.500 +atomicMass "ER" = 167.260 +atomicMass "ES" = 252.000 +atomicMass "EU" = 151.964 +atomicMass "F" = 18.998 +atomicMass "FE" = 55.845 +atomicMass "FM" = 257.000 +atomicMass "FR" = 223.000 +atomicMass "GA" = 69.723 +atomicMass "GD" = 157.250 +atomicMass "GE" = 72.610 +atomicMass "HE" = 4.003 +atomicMass "HF" = 178.490 +atomicMass "HG" = 200.590 +atomicMass "HO" = 164.930 +atomicMass "HS" = 269.000 +atomicMass "I" = 126.904 +atomicMass "IN" = 114.818 +atomicMass "IR" = 192.217 +atomicMass "K" = 39.098 +atomicMass "KR" = 83.800 +atomicMass "LA" = 138.906 +atomicMass "LI" = 6.941 +atomicMass "LR" = 262.000 +atomicMass "LU" = 174.967 +atomicMass "MD" = 258.000 +atomicMass "MG" = 24.305 +atomicMass "MN" = 54.938 +atomicMass "MO" = 95.940 +atomicMass "MT" = 268.000 +atomicMass "NA" = 22.991 +atomicMass "NB" = 92.906 +atomicMass "ND" = 144.240 +atomicMass "NE" = 20.180 +atomicMass "NI" = 58.693 +atomicMass "NO" = 259.000 +atomicMass "NP" = 237.000 +atomicMass "OS" = 190.230 +atomicMass "PA" = 231.036 +atomicMass "PB" = 207.200 +atomicMass "PD" = 106.420 +atomicMass "PM" = 145.000 +atomicMass "PO" = 210.000 +atomicMass "PR" = 140.908 +atomicMass "PT" = 195.078 +atomicMass "PU" = 244.000 +atomicMass "RA" = 226.000 +atomicMass "RB" = 85.468 +atomicMass "RE" = 186.207 +atomicMass "RF" = 261.000 +atomicMass "RH" = 102.906 +atomicMass "RN" = 222.000 +atomicMass "RU" = 101.070 +atomicMass "SB" = 121.760 +atomicMass "SC" = 44.956 +atomicMass "SE" = 78.960 +atomicMass "SG" = 266.000 +atomicMass "SI" = 28.086 +atomicMass "SM" = 150.360 +atomicMass "SN" = 118.710 +atomicMass "SR" = 87.620 +atomicMass "TA" = 180.948 +atomicMass "TB" = 158.925 +atomicMass "TC" = 98.000 +atomicMass "TE" = 127.600 +atomicMass "TH" = 232.038 +atomicMass "TI" = 47.867 +atomicMass "TL" = 204.383 +atomicMass "TM" = 168.934 +atomicMass "U" = 238.029 +atomicMass "V" = 50.942 +atomicMass "W" = 183.840 +atomicMass "XE" = 131.290 +atomicMass "Y" = 88.906 +atomicMass "YB" = 173.040 +atomicMass "ZN" = 65.390 +atomicMass "ZR" = 91.224 +atomicMass x = defaulting ["Unknown atomic mass for element:", BS.pack $ show x] 0.0 + +-- | Van der Waals radius of the given element +vanDerWaalsRadius :: Element -> Double +vanDerWaalsRadius "C" = 1.70 +vanDerWaalsRadius "N" = 1.55 +vanDerWaalsRadius "O" = 1.52 +vanDerWaalsRadius "P" = 1.80 +vanDerWaalsRadius "S" = 1.80 +vanDerWaalsRadius "AC" = 2.00 +vanDerWaalsRadius "AG" = 1.72 +vanDerWaalsRadius "AL" = 2.00 +vanDerWaalsRadius "AM" = 2.00 +vanDerWaalsRadius "AR" = 1.88 +vanDerWaalsRadius "AS" = 1.85 +vanDerWaalsRadius "AT" = 2.00 +vanDerWaalsRadius "AU" = 1.66 +vanDerWaalsRadius "B" = 2.00 +vanDerWaalsRadius "BA" = 2.00 +vanDerWaalsRadius "BE" = 2.00 +vanDerWaalsRadius "BH" = 2.00 +vanDerWaalsRadius "BI" = 2.00 +vanDerWaalsRadius "BK" = 2.00 +vanDerWaalsRadius "BR" = 1.85 +vanDerWaalsRadius "CA" = 2.00 +vanDerWaalsRadius "CD" = 1.58 +vanDerWaalsRadius "CE" = 2.00 +vanDerWaalsRadius "CF" = 2.00 +vanDerWaalsRadius "CL" = 1.75 +vanDerWaalsRadius "CM" = 2.00 +vanDerWaalsRadius "CO" = 2.00 +vanDerWaalsRadius "CR" = 2.00 +vanDerWaalsRadius "CS" = 2.00 +vanDerWaalsRadius "CU" = 1.40 +vanDerWaalsRadius "DB" = 2.00 +vanDerWaalsRadius "DS" = 2.00 +vanDerWaalsRadius "DY" = 2.00 +vanDerWaalsRadius "ER" = 2.00 +vanDerWaalsRadius "ES" = 2.00 +vanDerWaalsRadius "EU" = 2.00 +vanDerWaalsRadius "F" = 1.47 +vanDerWaalsRadius "FE" = 2.00 +vanDerWaalsRadius "FM" = 2.00 +vanDerWaalsRadius "FR" = 2.00 +vanDerWaalsRadius "GA" = 1.87 +vanDerWaalsRadius "GD" = 2.00 +vanDerWaalsRadius "GE" = 2.00 +vanDerWaalsRadius "H" = 1.09 +vanDerWaalsRadius "HE" = 1.40 +vanDerWaalsRadius "HF" = 2.00 +vanDerWaalsRadius "HG" = 1.55 +vanDerWaalsRadius "HO" = 2.00 +vanDerWaalsRadius "HS" = 2.00 +vanDerWaalsRadius "I" = 1.98 +vanDerWaalsRadius "IN" = 1.93 +vanDerWaalsRadius "IR" = 2.00 +vanDerWaalsRadius "K" = 2.75 +vanDerWaalsRadius "KR" = 2.02 +vanDerWaalsRadius "LA" = 2.00 +vanDerWaalsRadius "LI" = 1.82 +vanDerWaalsRadius "LR" = 2.00 +vanDerWaalsRadius "LU" = 2.00 +vanDerWaalsRadius "MD" = 2.00 +vanDerWaalsRadius "MG" = 1.73 +vanDerWaalsRadius "MN" = 2.00 +vanDerWaalsRadius "MO" = 2.00 +vanDerWaalsRadius "MT" = 2.00 +vanDerWaalsRadius "NA" = 2.27 +vanDerWaalsRadius "NB" = 2.00 +vanDerWaalsRadius "ND" = 2.00 +vanDerWaalsRadius "NE" = 1.54 +vanDerWaalsRadius "NI" = 1.63 +vanDerWaalsRadius "NO" = 2.00 +vanDerWaalsRadius "NP" = 2.00 +vanDerWaalsRadius "OS" = 2.00 +vanDerWaalsRadius "PA" = 2.00 +vanDerWaalsRadius "PB" = 2.02 +vanDerWaalsRadius "PD" = 1.63 +vanDerWaalsRadius "PM" = 2.00 +vanDerWaalsRadius "PO" = 2.00 +vanDerWaalsRadius "PR" = 2.00 +vanDerWaalsRadius "PT" = 1.72 +vanDerWaalsRadius "PU" = 2.00 +vanDerWaalsRadius "RA" = 2.00 +vanDerWaalsRadius "RB" = 2.00 +vanDerWaalsRadius "RE" = 2.00 +vanDerWaalsRadius "RF" = 2.00 +vanDerWaalsRadius "RH" = 2.00 +vanDerWaalsRadius "RN" = 2.00 +vanDerWaalsRadius "RU" = 2.00 +vanDerWaalsRadius "SB" = 2.00 +vanDerWaalsRadius "SC" = 2.00 +vanDerWaalsRadius "SE" = 1.90 +vanDerWaalsRadius "SG" = 2.00 +vanDerWaalsRadius "SI" = 2.10 +vanDerWaalsRadius "SM" = 2.00 +vanDerWaalsRadius "SN" = 2.17 +vanDerWaalsRadius "SR" = 2.00 +vanDerWaalsRadius "TA" = 2.00 +vanDerWaalsRadius "TB" = 2.00 +vanDerWaalsRadius "TC" = 2.00 +vanDerWaalsRadius "TE" = 2.06 +vanDerWaalsRadius "TH" = 2.00 +vanDerWaalsRadius "TI" = 2.00 +vanDerWaalsRadius "TL" = 1.96 +vanDerWaalsRadius "TM" = 2.00 +vanDerWaalsRadius "U" = 1.86 +vanDerWaalsRadius "V" = 2.00 +vanDerWaalsRadius "W" = 2.00 +vanDerWaalsRadius "XE" = 2.16 +vanDerWaalsRadius "Y" = 2.00 +vanDerWaalsRadius "YB" = 2.00 +vanDerWaalsRadius "ZN" = 1.39 +vanDerWaalsRadius "ZR" = 2.00 +vanDerWaalsRadius e = defaulting ["Do not know van der Waals radius of", BS.pack $ show e] 0.0 + +assignElement :: Atom -> Element +assignElement at = case element at of + "" -> guessElement . atName $ at + code -> code + +guessElement :: BS.ByteString -> Element +guessElement "C" = "C" +guessElement "C1'" = "C" +guessElement "C2" = "C" +guessElement "C2'" = "C" +guessElement "C3'" = "C" +guessElement "C4" = "C" +guessElement "C4'" = "C" +guessElement "C5" = "C" +guessElement "C5'" = "C" +guessElement "C6" = "C" +guessElement "C8" = "C" +guessElement "CA" = "C" +guessElement "CB" = "C" +guessElement "CD" = "C" +guessElement "CD1" = "C" +guessElement "CD2" = "C" +guessElement "CE" = "C" +guessElement "CE1" = "C" +guessElement "CE2" = "C" +guessElement "CE3" = "C" +guessElement "CG" = "C" +guessElement "CG1" = "C" +guessElement "CG2" = "C" +guessElement "CH2" = "C" +guessElement "CZ" = "C" +guessElement "CZ2" = "C" +guessElement "CZ3" = "C" +guessElement "N" = "N" +guessElement "N1" = "N" +guessElement "N2" = "N" +guessElement "N3" = "N" +guessElement "N4" = "N" +guessElement "N6" = "N" +guessElement "N7" = "N" +guessElement "N9" = "N" +guessElement "ND1" = "N" +guessElement "ND2" = "N" +guessElement "NE" = "N" +guessElement "NE1" = "N" +guessElement "NE2" = "N" +guessElement "NH1" = "N" +guessElement "NH2" = "N" +guessElement "NZ" = "N" +guessElement "O" = "O" +guessElement "O2" = "O" +guessElement "O2'" = "O" +guessElement "O3'" = "O" +guessElement "O4" = "O" +guessElement "O4'" = "O" +guessElement "O5'" = "O" +guessElement "O6" = "O" +guessElement "OD1" = "O" +guessElement "OD2" = "O" +guessElement "OE1" = "O" +guessElement "OE2" = "O" +guessElement "OG" = "O" +guessElement "OG1" = "O" +guessElement "OH" = "O" +guessElement "OP1" = "O" +guessElement "OP2" = "O" +guessElement "OXT" = "O" +guessElement "P" = "P" +guessElement "SD" = "S" +guessElement "SG" = "S" +guessElement _ = "" -- not a standard residue of protein or nucleic acid diff --git a/Bio/PDB/Structure/List.hs b/Bio/PDB/Structure/List.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/Structure/List.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE MagicHash, NoMonomorphismRestriction, CPP #-} +module Bio.PDB.Structure.List(List(..), TempList, + initialNew, new, add, finalize, tempLength, empty, last, + singleton, + map, mapM, foldl, foldl', foldr, foldM, filter, length, + defaultSize, residueVectorSize, chainVectorSize, + toList, vimap, (!) + ) where + +--import Prelude(Int,Num(..),Monad(..)) +import Prelude hiding (length, filter, drop, take, init, tail, mapM, splitAt, map, mapM, foldl, foldr, last) +import qualified Data.Vector.Mutable as M +import qualified Data.Vector as V +import Control.Monad(when) +import Control.DeepSeq(NFData(..)) +import Control.Monad.State.Strict(lift) +import Data.STRef as ST + +-- | Type alias for a immutable sequence of elements. +type List a = V.Vector a + +-- | Type alias for a mutable sequence of elements. +data TempList m a = TempList {-# Unpack #-} !(ST.STRef m Int) !(ST.STRef m (M.MVector m a)) + +--instance Show (TempList m a) where +-- showsPrec p (TempList i v) s = Prelude.concat ["TempList ", show i, " ..."] + +-- | Empty vector. +empty = V.empty + +-- | Vector with a single element +singleton= V.singleton + +#ifdef DEFINE_NFDATA_VECTOR +-- It is defined in newer versions of vector package. +instance NFData (V.Vector a) where +#endif + +instance NFData (TempList m a) where + rnf t@(TempList i v) = i `seq` v `seq` () + +-- Defined in Data.Vector +--instance Show (M.MVector a) where +-- showsPrec v = shows $ V.fromList v + +-- | Create a new mutable vector. +new i = lift $ initialNew i + +-- | Allocate initial space for a new mutable vector. +initialNew i = do v <- M.new i + s <- ST.newSTRef 0 + vs <- ST.newSTRef v + return $! TempList s vs + +-- | Length of mutable vector. +tempLength (TempList s v) = lift $ readSTRef s + +-- | Default initial size of a mutable vector for residue contents. +residueVectorSize = 23 -- most PDB atoms per residue seem to be in RNA + +-- | Default initial size of a mutable vector for chain contents. +chainVectorSize = 150 -- we don't really expect it to be much shorter..., average is 300, but PDB contains more small proteins of course + +-- | Default initial size of a mutable vector for structure contents. +defaultSize = 4 -- Not much point in allocating less than this... + +-- | Appends an element to a mutable vector. +add (TempList s vs) a = lift $ do i <- readSTRef s + v <- readSTRef vs + when (i < 0) $ fail "Negative STRef" + let j = i + 1 + l = M.length v + v' <- if (j > l) + then do nV <- M.grow v j + writeSTRef vs nV + return nV + else return v + M.write v' i a + ST.modifySTRef s (+1) + return () + +-- | Finalizes a mutable vector, and returns immutable vector. +-- [Does it shrink allocated space?] +finalize (TempList s vs) = lift $ do i <- readSTRef s + when (i < 0) $ fail "Negative STRef" + v <- readSTRef vs + v' <- V.unsafeFreeze v + writeSTRef s (-1) + -- Can I? || writeSTRef vs undefined || + return $! V.slice 0 i v' + + +-- | `foldl` on immutable vectors. +foldl = V.foldl + +-- | `foldl'` on immutable vectors. +foldl' = V.foldl' + +-- | `foldr` on immutable vectors. +foldr = V.foldr + +-- | `map` on immutable vectors. +map = V.map + +-- | `filter` on immutable vectors. +filter = V.filter + +-- | `mapM` on immutable vectors. +mapM = V.mapM + +-- | `foldM` on immutable vectors. +foldM = V.foldM + +-- | `length` on immutable vectors. +length = V.length + +-- | `last` on immutable vectors. +last = V.last + +-- | Conversion of an immutable vector to list. +toList = V.toList + +-- | `map` on immutable vectors. +vimap = V.imap + +-- | Indexing of an immutable vector. +(!) = (V.!) + diff --git a/Bio/PDB/Structure/Vector.hs b/Bio/PDB/Structure/Vector.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/Structure/Vector.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE NoMonomorphismRestriction, BangPatterns #-} +module Bio.PDB.Structure.Vector(Vec3D(..), + unpackVec3D, + vnormalise, vdot, (*|), (|*), + vzip, vmap, + vnorm, vproj, vperpend, vperpends, vdihedral) where + +import qualified Data.Vector.Class as C +import Data.Vector.V3 +import Data.List(foldl') +import Test.QuickCheck + +-- ^ This module wraps 3D vector operations, and adds missing ones. Also hides a "Vector" class + +-- | Defines type alias for position and translation vectors in PDB structures. +type Vec3D = Vector3 + +-- | Unpacks an abstract 3D vector into a triple of Doubles. +unpackVec3D :: Vec3D -> (Double, Double, Double) +unpackVec3D (Vector3 x y z) = (x, y, z) + +-- | Maps an operation that modifies a Double onto a 3D vector. +{-# INLINE vmap #-} +vmap :: (Double -> Double) -> Vec3D -> Vec3D +vmap = C.vmap + +-- | Maps an operation on a pair of Doubles onto a pair of 3D vectors +-- coordinatewise. +vzip :: (Double -> Double -> Double) -> Vec3D -> Vec3D -> Vec3D +vzip = C.vzip + +-- | Normalises to a unit vector in the same direction as input. +{-# INLINE vnormalise #-} +vnormalise :: Vec3D -> Vec3D +vnormalise = C.vnormalise + +-- | Computes a dot product of two 3D vectors. +{-# INLINE vdot #-} +vdot :: Vec3D -> Vec3D -> Double +vdot = C.vdot + +{-# INLINE vnorm #-} +-- | 2-norm of a vector (also called a magnitude or length.) +vnorm :: Vec3D -> Double +vnorm = C.vmag + +{-# INLINE vdihedral #-} +-- | Compute dihedral between three bond vectors using spherical angle formula. +vdihedral :: Vec3D -> Vec3D -> Vec3D -> Double +vdihedral !a !b !c = (atan2 (vnorm b * (a `vdot` (b `vcross` c))) + ((a `vcross` b) `vdot` (b `vcross` c)) ) + +-- | Scalar product. (`*` indicates side on which one can put a scalar.) +{-# INLINE (*|) #-} +(*|) :: Double -> Vec3D -> Vec3D +(*|) = (C.*|) + +-- | Scalar product. (`*` indicates side on which one can put a scalar.) +{-# INLINE (|*) #-} +(|*) :: Vec3D -> Double -> Vec3D +(|*) = (C.|*) + +{-# INLINE vproj #-} +-- | Finds a vector component of the first vector that is a projection onto direction of second vector. +vproj v w = vmap (*scale) uw + where + uw = vnormalise w + scale = v `vdot` uw + +{-# INLINE vperpend #-} +-- | Returns a component of the vector v that is perpendicular to w. +vperpend v w = v - (v `vproj` w) + + +-- | Finds a component of the vector v that is perpendicular to all vectors in a list. +vperpends v ws = foldl' vperpend v ws + +instance Arbitrary Vector3 where + arbitrary = do a <- arbitrary + b <- arbitrary + c <- arbitrary + return $ Vector3 a b c + + + diff --git a/Bio/PDB/StructureBuilder.hs b/Bio/PDB/StructureBuilder.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/StructureBuilder.hs @@ -0,0 +1,272 @@ +{-# LANGUAGE BangPatterns, DisambiguateRecordFields, MultiParamTypeClasses, NamedFieldPuns, FlexibleContexts, OverloadedStrings, PatternGuards, RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} -- for convenient debugging +{-# OPTIONS_GHC -fspec-constr-count=2 #-} +module Bio.PDB.StructureBuilder(parse) + +where + +import Prelude hiding (String) +import qualified Data.ByteString.Char8 as BS hiding (reverse) +import qualified Control.Monad.ST as ST +import Control.Monad.State.Strict as State +import Control.Monad(when) +import Data.STRef as STRef + +import Bio.PDB.EventParser.PDBEvents(PDBEvent(..), RESID(..)) +import qualified Bio.PDB.EventParser.PDBEventParser(parsePDBRecords) +import Bio.PDB.Structure +import Bio.PDB.Structure.List as L + +-- NOTE: t is existential 'phantom' type to keep ST effects from escaping +type ParsingMonad t a = State.StateT (BState t) (ST.ST t) a + +-- TODO: with option of online reporting of errors? + +-- Parses PDB records given as ByteString, given filename fileContents and a monadic +-- action to be executed for each PDB event. +-- parsePDBRec :: (Monad m) => String -> String -> (() -> PDBEvent -> m ()) -> () -> m () +parsePDBRec :: String -> String -> (() -> PDBEvent -> ParsingMonad t ()) -> () -> ParsingMonad t () +parsePDBRec = Bio.PDB.EventParser.PDBEventParser.parsePDBRecords + +--parse :: (State.MonadState BState m) => String -> String -> m (Structure, [PDBEvent]) +-- | Given filename, and contents, parses a whole PDB file, returning a monadic action +-- | with a tuple of (Structure, [PDBEvent]), where the list of events contains all +-- | parsing or construction errors. +parse fname contents = ST.runST $ do initial <- initializeState + (s, e) <- State.evalStateT parsing initial + return $! (s :: Structure, e :: L.List PDBEvent) + where parsing = do parsePDBRec fname contents (\() !ev -> parseStep ev) () + closeStructure + s <- State.gets currentStructure + e <- State.gets errors + e' <- L.finalize e + return (s, e') + +-- | Record holding a current state of the structure record builder. +data BState s = BState { currentResidue :: Maybe Residue, + currentModel :: Maybe Model, + currentChain :: Maybe Chain, + currentStructure :: Structure, + residueContents :: L.TempList s Atom, + chainContents :: L.TempList s Residue, + modelContents :: L.TempList s Chain, + structureContents :: L.TempList s Model, + errors :: L.TempList s PDBEvent, + line_no :: STRef.STRef s Int + } + +-- | Initial state of the structure record builder. +initializeState :: ST.ST t (BState t) +initializeState = do r <- L.initialNew L.residueVectorSize + c <- L.initialNew L.chainVectorSize + m <- L.initialNew 1 + s <- L.initialNew 1 + e <- L.initialNew 100 + l <- STRef.newSTRef 1 + return $ BState { currentResidue = Nothing, + currentModel = Nothing, + currentChain = Nothing, + currentStructure = Structure { models = L.empty }, + residueContents = r, + chainContents = c, + modelContents = m, + structureContents = s, + errors = e, + line_no = l } +-- | Checks that a residue with a given identification tuple is current, +-- | or if not, then closes previous residue (if present), +-- | and marks a new ,,current'' residue in a state of builder. +checkResidue :: Bio.PDB.EventParser.PDBEvents.RESID -> ParsingMonad t () +checkResidue (RESID (newName, newChain, newResseq, newInsCode)) = + do checkChain newChain + res <- State.gets currentResidue + when (residueChanged res) $ do closeResidue + l <- L.new L.residueVectorSize + State.modify $! createResidue l + where + residueChanged Nothing = True + residueChanged (Just (Residue { resName = oldResName, + resSeq = oldResSeq, + insCode = oldInsCode, + atoms = _atoms })) = + (oldResName, oldResSeq, oldInsCode) /= (newName, newResseq, newInsCode) + createResidue l st = st { currentResidue = Just newResidue, + residueContents = l } + newResidue = Bio.PDB.Structure.Residue { resName = newName, + resSeq = newResseq, + insCode = newInsCode, + atoms = L.empty } + +-- | Checks that a chain with a given identification character is current, +-- | and if not, creates one. Also checks that we have any model in which +-- | to assign the chain. +checkChain :: Char -> ParsingMonad t () +checkChain name = do checkModel + curChain <- State.gets currentChain + when (chainChanged curChain) $ do closeChain + l <- L.new L.chainVectorSize + State.modify $ createChain l + where + chainChanged Nothing = True + chainChanged (Just (Chain { chainId = oldChain })) = oldChain /= name + createChain l state = state { currentChain = Just $! Chain { chainId = name, + residues = L.empty }, + chainContents = l } + + +-- | Checks that a current model has been declared, and creates zeroth model, +-- | if no such model exists. +-- TODO: when createing a dummy model, check that there are no models declared before +-- [Otherwise one needs to report an error!] +checkModel :: ParsingMonad t () +checkModel = do curModel <- State.gets currentModel + when (curModel == Nothing) $ openModel 1 +-- | Closes construction of a current residue and appends this residue to a current chain. (Monadic action.) +--closeResidue :: State.State BState () + +closeResidue :: ParsingMonad t () +closeResidue = do r <- State.gets currentResidue + when (r /= Nothing) $ do let Just res = r + rc <- State.gets residueContents + rf <- L.finalize rc + cc <- State.gets chainContents + cc' <- L.add cc $ res { Bio.PDB.Structure.atoms = rf } + State.modify clearResidue + where + clearResidue st = st { currentResidue = Nothing } + +-- | Finalizes construction of current chain, and appends it to current model. +--closeChain :: State.State BState () + +closeChain :: ParsingMonad t () +closeChain = do closeResidue + c <- State.gets currentChain + ac <- State.gets chainContents + when (c /= Nothing) $ do l <- State.gets chainContents + l' <- L.finalize l + let Just ch = c + ch' = ch { Bio.PDB.Structure.residues = l' } + m <- State.gets currentModel + when (m == Nothing) $ do mli <- State.gets structureContents + i <- L.tempLength mli + openModel i + addError ["Trying to close chain when currentChain is ", + BS.pack . show $ ch, + " and currentModel is ", + BS.pack . show $ m] + ml <- State.gets modelContents + ml' <- L.add ml ch' + State.modify clearChain + where + clearChain st = st { currentChain = Nothing } + +-- | Reports error during building of structure for PDB entry. +-- TODO: This should be probably monadic action +-- TODO: forgot about line/column number passing! +addError :: [String] -> ParsingMonad t () +addError msg = do e <- State.gets errors + lnref <- State.gets line_no + ln <- lift $ STRef.readSTRef lnref + lift $ STRef.modifySTRef lnref (+1) + L.add e $ anError ln + where anError ln = PDBParseError ln 0 $ BS.concat msg + +-- | Finalizes construction of current model +closeModel :: ParsingMonad t () +closeModel = do closeChain + cm <- State.gets currentModel + case cm of + Nothing -> return () + Just m -> do mc <- State.gets modelContents + chs <- L.finalize mc + let m' = m { chains = chs } + sc <- State.gets structureContents + State.modify clearModel + L.add sc m' + where clearModel st = st { currentModel = Nothing } + +-- | Finalizes construction of record holding PDB entry data. +-- NOTE: this one is different and should only be used after parsing is complete! + +closeStructure :: ParsingMonad t () +closeStructure = do closeModel + sc <- State.gets structureContents + sc' <- L.finalize sc + State.modify (closeStructure' sc') + where + closeStructure' sc bstate@(BState { currentStructure = aStructure}) = + bstate { currentStructure = aStructure { models = sc }, + structureContents = undefined } + +nextLine :: ParsingMonad t () +nextLine = do lnref <- State.gets line_no + lift $ STRef.modifySTRef lnref (+1) + +-- | Performs a match on a single PDBEvent and performs relevant change to a BState of structure builder. +--parseStep :: (State.MonadState BState m) => PDBEvent -> m () +parseStep pe@(PDBParseError l _ _) = do e <- State.gets errors + L.add e pe + lnref <- State.gets line_no + lift $ STRef.writeSTRef lnref l +parseStep (ATOM { no = atSer, -- :: !Int, + atomtype = atType, -- :: !String, + restype = resName, -- :: !String, + chain = chainName, -- :: !Char, + resid = resSeq, -- :: !Int, + resins = resInsCode, -- :: !Char, + altloc = altloc, -- :: !Char, - atom name + coords = atCoord, -- :: !Vector3, + occupancy = atOccupancy,-- :: !Double, + bfactor = atBFactor, -- :: !Double, + segid = atSegId, -- :: !String, + elt = atElement, -- :: !String, + charge = atCharge, -- :: !String, -- why not a number? + hetatm = isHet -- :: !Bool + }) = + do checkResidue $ RESID (resName, chainName, resSeq, resInsCode) + reslist <- State.gets residueContents + newAtom `seq` L.add reslist newAtom + nextLine + where newAtom = Atom { atName = atType, + atSerial = atSer, + coord = atCoord, + bFactor = atBFactor, + occupancy = atOccupancy, + element = atElement, + segid = atSegId, + charge = atCharge, + hetatm = isHet + } + +parseStep (MODEL { num = n }) = do closeModel + openModel n + nextLine +parseStep ENDMDL = do closeModel + nextLine +parseStep END = do closeModel + nextLine +parseStep (TER {..}) = do closeChain -- TODO: check TER with currentChain parameters + nextLine +parseStep (MASTER {..}) = do closeModel -- TODO: check MASTER parameters with current model -- is it really model end? + nextLine +parseStep _ = nextLine + +-- | Creates a new model within structure builder. (For internal use.) +-- WARNING: And forgets anything that was there before! +openModel :: Int -> ParsingMonad t () +openModel n = do l <- L.new L.defaultSize + State.modify $ changeModel l + where changeModel l st = st { currentModel = Just newModel, + modelContents = l } + newModel = Bio.PDB.Structure.Model { modelId = n, + chains = empty } + +-- | Finalizes state of structure builder, and returns pair of a structure, and list of errors. +-- NOTE: should have a monadic action for each error instead. Then possibly default monad that accumulates these errors. +parseFinish :: ParsingMonad t (Structure, L.List PDBEvent) +parseFinish = do closeStructure + st <- State.gets currentStructure + er <- State.gets errors + er' <- finalize er + st `seq` return (st, er') + diff --git a/Bio/PDB/StructurePrinter.hs b/Bio/PDB/StructurePrinter.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/StructurePrinter.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE NamedFieldPuns, DisambiguateRecordFields #-} +module Bio.PDB.StructurePrinter(write) where + +import Prelude hiding(print) +import Data.ByteString.Char8 as BS +import Bio.PDB.Structure +import Bio.PDB.Iterable +import Bio.PDB.Iterable.Utils +import Bio.PDB.Structure.List as L +import Bio.PDB.EventParser.PDBEventPrinter as PR +import Control.Monad(mapM_) +import Bio.PDB.EventParser.PDBEvents + +-- | ShowS like type for a list of `PDBEvent`s. +type PDBEventS = [PDBEvent] -> [PDBEvent] + +-- | Writes a structure in a PDB format to a filehandle. +write handle structure = mapM_ (PR.print handle) (structureEvents structure) + +-- | Generates list of `PDBEvent`s from a given Structure. +structureEvents :: Structure -> [PDBEvent] +structureEvents s = ifoldr modelEvents [END] s + +-- | Generates list of `PDBEvent`s from a given Model. +modelEvents :: Model -> PDBEventS +modelEvents m cont = start:main (ENDMDL : cont) + where + start = MODEL $ modelId m + main c = ifoldr chainEvents c m + +-- | Generates list of `PDBEvent`s from a given Chain. +chainEvents :: Chain -> PDBEventS +chainEvents ch c = ifoldr (residueEvents ch) (ter:c) ch + where + ter = TER { num = atSer + 1 , -- FIXME: should be lastAtom ch + 1 + resname = lastResName , + chain = chainId ch , + resid = lastResSeq , + insCode = lastInsCode } + Atom { atSerial = atSer } = L.last ats + Residue { resName = lastResName, + resSeq = lastResSeq , + insCode = lastInsCode, + atoms = ats + } = L.last . Bio.PDB.Structure.residues $ ch + +-- | Generates list of `PDBEvent`s from a given Residue and its Chain. +residueEvents :: Chain -> Residue -> PDBEventS +residueEvents ch r c = ifoldr (atomEvents ch r) c r + +-- | Generates list of `PDBEvent`s from a given Atom, its Residue, and its Chain. +atomEvents :: Chain -> Residue -> Atom -> PDBEventS +atomEvents (Chain { chainId = chid } + ) (Residue { resName = rtype, + resSeq = rid, + insCode = rins + } + ) (Atom { atName = atName, + atSerial = atSer, + coord = coord, + bFactor = bf, + occupancy = occ, + element = e, + segid = sid, + charge = ch, + hetatm = isHet + }) c = ATOM { no = atSer, -- TODO: assign atom serial numbers + atomtype = atName, + restype = rtype, + chain = chid, + resid = rid, + resins = rins, + altloc = ' ', + coords = coord, + occupancy = occ, + bfactor = bf, + segid = sid, + elt = e, + charge = ch, + hetatm = isHet + } : c diff --git a/Bio/PDB/Util/MissingInstances.hs b/Bio/PDB/Util/MissingInstances.hs new file mode 100644 --- /dev/null +++ b/Bio/PDB/Util/MissingInstances.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE CPP #-} + +-- | This module contains instances of `NFData` for Data.ByteString +-- and `Params` before text-format 0.3.0.8. +module Bio.PDB.Util.MissingInstances() where + +import Prelude() +import qualified Data.ByteString as BS +import Control.DeepSeq + +#ifdef DEFINE_PARAMS_INSTANCES +import Data.Text.Buildable +import Data.Text.Format.Types +import Data.Text.Lazy.Builder +import Data.Text.Format.Params(Params(..)) +#endif + + +#ifdef DEFINE_NFDATA_INSTANCE +-- I use strict version of BS.ByteString so default implementation should do +-- | Nothing needs to be done in NFData instance for stricty `BS.ByteString`. +instance NFData BS.ByteString where +#endif + +#ifdef DEFINE_PARAMS_INSTANCES + +-- | Adds instances of Params for tuples of more than ten Buildables. +instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, + Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, + Buildable k) + => Params (a,b,c,d,e,f,g,h,i,j,k) where + buildParams (a,b,c,d,e,f,g,h,i,j,k) = + [build a, build b, build c, build d, build e, + build f, build g, build h, build i, build j, + build k] + +instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, + Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, + Buildable k, Buildable l) + => Params (a,b,c,d,e,f,g,h,i,j,k,l) where + buildParams (a,b,c,d,e,f,g,h,i,j,k,l) = + [build a, build b, build c, build d, build e, + build f, build g, build h, build i, build j, + build k, build l] + +instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, + Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, + Buildable k, Buildable l, Buildable m) + => Params (a,b,c,d,e,f,g,h,i,j,k,l,m) where + buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m) = + [build a, build b, build c, build d, build e, + build f, build g, build h, build i, build j, + build k, build l, build m] + +instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, + Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, + Buildable k, Buildable l, Buildable m, Buildable n) + => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where + buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = + [build a, build b, build c, build d, build e, + build f, build g, build h, build i, build j, + build k, build l, build m, build n] + +instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, + Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, + Buildable k, Buildable l, Buildable m, Buildable n, Buildable o) + => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where + buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = + [build a, build b, build c, build d, build e, + build f, build g, build h, build i, build j, + build k, build l, build m, build n, build o] + +instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, + Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, + Buildable k, Buildable l, Buildable m, Buildable n, Buildable o, + Buildable p) + => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) where + buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) = + [build a, build b, build c, build d, build e, + build f, build g, build h, build i, build j, + build k, build l, build m, build n, build o, + build p] + +instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, + Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, + Buildable k, Buildable l, Buildable m, Buildable n, Buildable o, + Buildable p, Buildable r) + => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r) where + buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r) = + [build a, build b, build c, build d, build e, + build f, build g, build h, build i, build j, + build k, build l, build m, build n, build o, + build p, build r] + +instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, + Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, + Buildable k, Buildable l, Buildable m, Buildable n, Buildable o, + Buildable p, Buildable r, Buildable s) + => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s) where + buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s) = + [build a, build b, build c, build d, build e, + build f, build g, build h, build i, build j, + build k, build l, build m, build n, build o, + build p, build r, build s] + +instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, + Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, + Buildable k, Buildable l, Buildable m, Buildable n, Buildable o, + Buildable p, Buildable r, Buildable s, Buildable t) + => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s,t) where + buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s,t) = + [build a, build b, build c, build d, build e, + build f, build g, build h, build i, build j, + build k, build l, build m, build n, build o, + build p, build r, build s, build t] + +instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, + Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, + Buildable k, Buildable l, Buildable m, Buildable n, Buildable o, + Buildable p, Buildable r, Buildable s, Buildable t, Buildable u) + => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s,t,u) where + buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s,t,u) = + [build a, build b, build c, build d, build e, + build f, build g, build h, build i, build j, + build k, build l, build m, build n, build o, + build p, build r, build s, build t, build u] + +#endif diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +PDB data in here (*.pdb files) is subject to Protein Databank License. + +Haskell code in this package is subject to: + +Copyright (c) Michal J. Gajda 2010-2013 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +#! /usr/bin/env runhaskell + +import Distribution.Simple +main = defaultMain diff --git a/hPDB.cabal b/hPDB.cabal new file mode 100644 --- /dev/null +++ b/hPDB.cabal @@ -0,0 +1,91 @@ +name: hPDB +version: 0.99 +stability: beta +homepage: https://github.com/mgajda/hpdb +package-url: http://hackage.haskell.org/package/hPDB +synopsis: Parser, print and manipulate structures in PDB file format. +description: Protein Data Bank file format is a most popular format for holding biomolecule data. + + This is a very fast parser (below 7s for the largest entry in PDB - 1HTQ which is over 70MB - as compared with 11s of RASMOL 2.7.5, or 2m15s of BioPython with Python 2.6 interpreter.) + + It is aimed to not only deliver event-based interface, but also a high-level data structure for manipulating data in spirit of BioPython's PDB parser. + +category: Bioinformatics +license: BSD3 +license-file: LICENSE + +author: Michal J. Gajda +copyright: Copyright by Michal J. Gajda '2009-'2012 +maintainer: mjgajda@googlemail.com +bug-reports: mailto:mjgajda@googlemail.com + +build-type: Simple +cabal-version: >=1.8 +tested-with: GHC==7.4.1, GHC==7.0.3, GHC==7.4.2 +--Need to re-test: GHC==6.12.1, GHC==7.0.4, GHC==7.1.20101026 + +flag have-mmap + description: Use bytestring-mmap to read input faster. + default: True + +flag have-sse2 + description: Use -msse2 for faster code. + default: True + +flag old-text-format + description: Use text-format versions before 0.3.0.9 (and define Params instance for 11-tuple to 20-tuple yourself.) + Disable for (yet unreleased) versions after 0.3.0.8 when change was merged into upstream. + default: True + +flag old-bytestring + description: Use bytestring before version 0.10 (introduced in GHC 7.6), and define NFData for Data.ByteString yourself. + Disable for GHC 7.6. + default: False + +flag old-zlib + description: Use zlib before version 0.5.4 (introduced in GHC 7.6). + Disable for GHC 7.6.1 + default: False + +flag old-vector + description: Use old vector library before version 0.10 (introduced along with GHC 7.6). + Disable for GHC 7.6.1 and latest 7.4.2. + default: False + +source-repository head + type: git + location: git://github.com:mgajda/hpdb.git + +Library + ghc-options: -fspec-constr-count=4 -O3 + build-depends: base>=4.0, base <4.7, ghc-prim, directory, mtl, template-haskell, vector, AC-Vector, containers, deepseq, QuickCheck >= 2.5.0.0, text>=0.11.1.13 + if flag(have-mmap) + build-depends: bytestring-mmap + cpp-options: -DHAVE_MMAP + if flag(have-sse2) + ghc-options: -fspec-constr-count=4 -O3 + if flag(old-text-format) + cpp-options: -DDEFINE_PARAMS_INSTANCES + build-depends: text-format <= 0.3.0.8 + else + build-depends: text-format >= 0.3.0.9 + if flag(old-bytestring) + cpp-options: -DDEFINE_NFDATA_INSTANCE + build-depends: bytestring <= 0.9.2.1 + else + build-depends: bytestring >= 0.10.0.0 + if flag(old-vector) + cpp-options: -DDEFINE_NFDATA_VECTOR + build-depends: vector < 0.10 + else + build-depends: vector >= 0.10.0.0 + if flag(old-zlib) + cpp-options: -DOLD_ZLIB + build-depends: zlib <= 0.5.3.3 + else + build-depends: zlib >= 0.5.4.0 + other-extensions: ScopedTypeVariables OverloadedStrings BangPatterns NoMonomorphismRestriction EmptyDataDecls MagicHash + other-modules: Bio.PDB.EventParser.ParseATOM, Bio.PDB.EventParser.ParseCAVEAT, Bio.PDB.EventParser.ParseCISPEP, Bio.PDB.EventParser.ParseCONECT, Bio.PDB.EventParser.ParseCRYST1, Bio.PDB.EventParser.ParseDBREF, Bio.PDB.EventParser.ParseFORMUL, Bio.PDB.EventParser.ParseHEADER, Bio.PDB.EventParser.ParseHELIX, Bio.PDB.EventParser.ParseHET, Bio.PDB.EventParser.ParseHETNAM, Bio.PDB.EventParser.ParseHYDBND, Bio.PDB.EventParser.ParseIntRecord, Bio.PDB.EventParser.ParseJRNL, Bio.PDB.EventParser.ParseLINK, Bio.PDB.EventParser.ParseListRecord, Bio.PDB.EventParser.ParseMASTER, Bio.PDB.EventParser.ParseMatrixRecord, Bio.PDB.EventParser.ParseMODRES, Bio.PDB.EventParser.ParseObsoleting, Bio.PDB.EventParser.ParseREMARK, Bio.PDB.EventParser.ParseREVDAT, Bio.PDB.EventParser.ParseSEQADV, Bio.PDB.EventParser.ParseSEQRES, Bio.PDB.EventParser.ParseSHEET, Bio.PDB.EventParser.ParseSITE, Bio.PDB.EventParser.ParseSLTBRG, Bio.PDB.EventParser.ParseSpecListRecord, Bio.PDB.EventParser.ParseSPLIT, Bio.PDB.EventParser.ParseSSBOND, Bio.PDB.EventParser.ParseTER, Bio.PDB.EventParser.ParseTITLE, Bio.PDB.EventParser.ParseTVECT, Bio.PDB.EventParser.PDBParsingAbstractions, Bio.PDB.EventParser.FastParse, Bio.PDB.Util.MissingInstances, Bio.PDB.Common, Bio.PDB.InstantiateIterable, Bio.PDB.Iterable.Utils + exposed-modules: Bio.PDB.EventParser.PDBEvents, Bio.PDB.EventParser.PDBEventParser, Bio.PDB.EventParser.ExperimentalMethods, Bio.PDB.EventParser.HelixTypes, Bio.PDB.EventParser.StrandSense, Bio.PDB.Structure, Bio.PDB.StructureBuilder, Bio.PDB.Iterable, Bio.PDB.IO, Bio.PDB.Fasta, Bio.PDB, Bio.PDB.Structure.Vector, Bio.PDB.Structure.Elements, Bio.PDB.Structure.List, Bio.PDB.StructurePrinter, Bio.PDB.EventParser.PDBEventPrinter, Bio.PDB.IO.OpenAnyFile + exposed: True +