hPDB 0.999 → 0.9999

raw patch · 23 files changed

+567/−362 lines, 23 filesdep +paralleldep ~iterablePVP ok

version bump matches the API change (PVP)

Dependencies added: parallel

Dependency ranges changed: iterable

API changes (from Hackage documentation)

Files

• Bio/PDB.hs +0/−1
• Bio/PDB/Common.hs +2/−1
• Bio/PDB/EventParser/ExperimentalMethods.hs +2/−2
• Bio/PDB/EventParser/FastParse.hs +18/−3
• Bio/PDB/EventParser/PDBEventParser.hs +1/−0
• Bio/PDB/EventParser/PDBEventPrinter.hs +6/−0
• Bio/PDB/EventParser/ParseDBREF.hs +1/−2
• Bio/PDB/EventParser/ParseListRecord.hs +2/−5
• Bio/PDB/EventParser/StrandSense.hs +2/−2
• Bio/PDB/Fasta.hs +13/−8
• Bio/PDB/IO.hs +3/−1
• Bio/PDB/IO/OpenAnyFile.hs +2/−0
• Bio/PDB/Iterable.hs +10/−35
• Bio/PDB/Iterable/Instances.hs +36/−0
• Bio/PDB/Iterable/Utils.hs +13/−6
• Bio/PDB/Structure/Elements.hs +13/−7
• Bio/PDB/Structure/List.hs +19/−2
• Bio/PDB/Structure/Vector.hs +8/−8
• Bio/PDB/StructureBuilder.hs +17/−271
• Bio/PDB/StructureBuilder/Internals.hs +279/−0
• Bio/PDB/StructureBuilder/Parallel.hs +112/−0
• Bio/PDB/StructurePrinter.hs +5/−5
• hPDB.cabal +3/−3

@@ -13,7 +13,6 @@ 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

@@ -1,3 +1,4 @@+-- | Common datatype aliases. module Bio.PDB.Common(String(..), Vector3(..))  where@@ -10,7 +11,7 @@ import Control.DeepSeq(NFData(..)) import Bio.PDB.Util.MissingInstances() --- | We use only strict ByteString as strings in PDB parser.+-- | We use only strict 'ByteString' as strings in PDB parser. type String = BS.ByteString  -- -- | Datatype for 3D locations (numbers are in ångströms.)

@@ -17,7 +17,7 @@                  OtherExpMethod !BS.ByteString   deriving (Show, Read, Eq, Ord) --- | Generates an ExpMethod from words in PDB+-- | Generates an 'ExpMethod' from words in PDB mkExpMethod :: [BS.ByteString] -> ExpMethod mkExpMethod ["X-RAY", "DIFFRACTION"]        = XRayDiffraction mkExpMethod ["FIBER", "DIFFRACTION"]        = FiberDiffraction@@ -29,7 +29,7 @@ mkExpMethod ["SOLUTION", "SCATTERING"]      = SolutionScattering mkExpMethod other                           = OtherExpMethod (BS.unwords other) -- error-like --- | Converts an ExpMethod back into text+-- | Converts an 'ExpMethod' back into text showExpMethod :: ExpMethod -> BS.ByteString showExpMethod XRayDiffraction         = "X-RAY DIFFRACTION" showExpMethod FiberDiffraction        = "FIBER DIFFRACTION"

@@ -11,11 +11,14 @@ 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!!!+-- | Alias for 'ord' to make sure it is inlined.+-- Why on earth GHC 7.4 doesn't inline functions like ord?! They should normally compile to no-ops!!! {-# INLINE ord #-} ord :: Char -> Int ord (C# c#) = I# (ord# c#) +-- | Faster 'String' to 'Float' conversion.+-- Top level function dealing with negation. {-# INLINE strtof #-} strtof :: BS.ByteString -> Maybe Double strtof bs | BS.null bs = Nothing@@ -28,15 +31,19 @@         dv   = digitValue chr         rest = BSU.unsafeTail bs +-- | Value of a decimal digit. {-# INLINE digitValue #-} digitValue :: Char -> Int digitValue !c = ord c - ord '0' +-- | Strict negation. {-# INLINE final #-}-{-# ANN final "HLint: ignore Too strict if" #-}+{-# ANN final ("HLint: ignore Too strict if" :: [Char]) #-} final :: Bool -> Double -> Maybe Double final !sign !f = if sign then Just (-f) else Just f +-- | First helper function for fast 'ByteString' to 'Float' conversion+-- This function deals with things before the comma. {-# INLINE strtof0 #-} strtof0 :: Bool -> Int -> BS.ByteString -> Maybe Double strtof0 !sign !f !bs | BS.null bs = final sign (fromIntegral f :: Double)@@ -47,6 +54,8 @@         rest = BSU.unsafeTail bs         dv   = digitValue chr +-- | Second helper function for fast 'ByteString' to 'Float' conversion+-- This function deals with things after the comma. {-# INLINE strtof1 #-} strtof1 :: Bool -> Int -> Int -> BS.ByteString -> Maybe Double strtof1 !sign !e !f !bs | BS.null bs = makeDouble sign e f@@ -59,13 +68,17 @@         fs   = makeDouble sign e f         rest = BSU.unsafeTail bs +-- | Finalize parsing of 'Double' and construct result. {-# INLINE makeDouble #-} makeDouble !sign !e !f = final sign (fromIntegral f * 0.1 ** fromIntegral e) +-- | Checks that remaining part of 'ByteString' is pure spaces,+-- and return 'Nothing' if there is something else (for error handling.) {-# INLINE checkSpaces #-} checkSpaces ::  Maybe a -> BS.ByteString -> Maybe a checkSpaces !result !blanks = if BS.all (==' ') blanks then result else Nothing +-- | Trim spaces in front of the 'ByteString'. {-# INLINE trimFront #-} trimFront !s | BS.null s = s trimFront !s = if BSU.unsafeHead s == 32 -- space@@ -73,14 +86,16 @@                  else s -- No idea why it is faster than BS.span version? +-- | Trim spaces at the end of the 'ByteString'. {-# 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 -+-- | Discard last character within 'ByteString' without checking.  butlast (BSI.PS fp o l) = BSI.PS fp o (l-1) +-- | Trim spaces in the front and at the end of 'ByteString'. trim !s = trimRear $ trimFront s 

@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables, OverloadedStrings, BangPatterns, NoMonomorphismRestriction #-}+-- | Low-level event-based parser interface. module Bio.PDB.EventParser.PDBEventParser(parsePDBRecords) where 

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings, PatternGuards, CPP #-}+-- | Low-level output routines: printing any 'PDBEvent'. module Bio.PDB.EventParser.PDBEventPrinter(print, isPrintable)  where@@ -227,9 +228,11 @@ print handle e                     = hPrintf stderr "UNIMPLEMENTED: %s\n"                                                     (show e) +-- | For indicating continuation of the record in previous line as a digit with line number. showContinuation 0                 = ' ' showContinuation x | [c] <- show x = c +-- | For indicating continuation of the text in previous line by indent. contd 0 s = s contd x s = ' ' : s                                          @@ -266,18 +269,21 @@ isPrintable (PDBParseError c r s) = True isPrintable _                     = False +-- | Prints a list of words as a PDB speclist record (see 'Bio.PDB.EventParser.ParseSpecListRecord'.) 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) +-- | Prints a list of words as a PDB list record (see 'Bio.PDB.EventParser.ParseSpecListRecord'.) 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) +-- | Prints a matrix given as a list of 'Vector3's. 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

@@ -1,6 +1,5 @@ {-# LANGUAGE ScopedTypeVariables, OverloadedStrings, BangPatterns  #-}---- Parsing cross-references to other databases.+-- | Parsing cross-references to other databases. module Bio.PDB.EventParser.ParseDBREF(parseDBREF, parseDBREF12) where 

@@ -1,8 +1,5 @@-{-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE OverloadedStrings  #-}---- Parsing of records that contain simple list of values: KEYWDS, AUTHOR, MDLTYP, EXPDTA.+{-# LANGUAGE ScopedTypeVariables, NoMonomorphismRestriction, OverloadedStrings  #-}+-- | Parsing of records that contain simple list of values: KEYWDS, AUTHOR, MDLTYP, EXPDTA. module Bio.PDB.EventParser.ParseListRecord(parseKEYWDS,parseAUTHOR,parseMDLTYP,parseEXPDTA) where 

@@ -1,8 +1,8 @@-{-| Module with enumeration of beta-strand senses. -}+-- | Module with enumeration of beta-strand senses. module Bio.PDB.EventParser.StrandSense(StrandSenseT(Parallel, Antiparallel)) where -{-| Enumeration of beta-strand sense. -}+-- | Enumeration of beta-strand sense. data StrandSenseT = Parallel |                     Antiparallel    deriving (Eq, Ord, Show, Read)

@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings, FlexibleContexts #-}-+-- | Conversion of PDB residue codes to FASTA single-letter sequence codes. module Bio.PDB.Fasta(resname2fastacode, fastacode2resname  ,                      defaultResname,    defaultFastaCode   ,                      fastaSequence,     fastaGappedSequence,@@ -10,7 +10,7 @@ import Data.Map          as Map  -- | Standard nucleic acid codes-codebook_nucleic_acids = [+codebookNucleicAcids = [   -- RNA codes   ("A",  'A'),   ("C",  'C'),@@ -28,10 +28,10 @@   ]  -- | List of all correspondences between FASTA 1-letter codes, and PDB 3-letter codes.-codebook = codebook_nucleic_acids ++ codebook_protein+codebook = codebookNucleicAcids ++ codebookProtein  -- | Standard protein codes-codebook_standard_protein = [+codebookStandardProtein = [   ("ALA", 'A'),   ("CYS", 'C'),   ("ASP", 'D'),@@ -57,7 +57,7 @@   ("TYR", 'Y')]  -- | List of both standard and non-standard protein codes.-codebook_protein = codebook_standard_protein ++ [+codebookProtein = codebookStandardProtein ++ [   -- Protein codes (common variants)   ("MSE", 'M')] -- selenomethionine @@ -66,7 +66,7 @@  -- | 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+fastacode2resnameDictionary = Map.fromList . Prelude.map (\(a, b) -> (b, a)) $ codebookStandardProtein  -- | Three-letter PDB code for an unknown type of residue. defaultResname   = "UNK"@@ -86,11 +86,11 @@  -- | 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) []+fastaSequence = Iter.itfoldr (\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) []+fastaGappedSequence = concat . scan2 insertGaps projectAA . Iter.itfoldr (\a b -> (resSeq a, res2code a) : b) []   where     projectAA  (i, aa)         = [aa]     insertGaps (i, _ ) (j, aa) = ['-' | _ <- [2..j-i]] ++ [aa]@@ -113,7 +113,12 @@                else ident ++ "|" ++ [chainId c]     fastaSeq = if withGaps then fastaSequence else fastaGappedSequence +-- | Returns 'String' with ungapped sequence of a given PDB 'Chain'. fastaRecord       = fastaRecord' False++-- | Returns 'String' with gapped sequence of a given PDB 'Chain'.+-- Gaps are placed to assure consistent numbering of residues and+-- indices in the output 'String'. fastaGappedRecord = fastaRecord' True  

@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings  #-}-+-- | Simple input/output wrappers taking filenames, and handling compression. module Bio.PDB.IO(parse, write) where  import qualified Control.Exception(catch)@@ -20,9 +20,11 @@ import Bio.PDB.IO.OpenAnyFile import Control.DeepSeq +-- | Type alias. type String = BS.ByteString  -- Until I get a newer version of Control.DeepSeq:+-- | Alias to a function present in newer versions of 'deepseq' library. force x = x `deepseq` x  -- | Parse a .pdb file and return `Bio.PDB.Structure.Structure`.

@@ -28,6 +28,7 @@ -- otherwise: import qualified Data.ByteString.Char8 as BS +-- | Read file contents as strict 'ByteString'. Uses mmap if possible. May decompress file contents, if needed. readFile fname = do r <- isReadable fname                     if r                       then@@ -71,4 +72,5 @@     reportError e = do putStrLn $ concat [show e, "while trying to mmap('", fname, "')"] #endif +-- | Write file contents as strict 'ByteString'. writeFile fname writer = void $ withFile fname WriteMode writer 

@@ -1,36 +1,11 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, OverlappingInstances, TemplateHaskell, FlexibleContexts #-}--- | Instances of Iterable class.-module Bio.PDB.Iterable(Iterable(..)) where--import Data.Iterable-import Data.Iterable.Instantiate-import Data.Iterable.Instantiate.Vector-import Data.Vector-import Bio.PDB.Structure.List as L-import Bio.PDB.Structure -import Control.Monad.Identity-import Control.Monad(foldM)--$(gen_vector_iterable [t| Structure |] [t| Model   |] [e| models   |] [e| (\s m -> s { models   = m }) |] )--$(gen_vector_iterable [t| Model     |] [t| Chain   |] [e| chains   |] [e| (\s m -> s { chains   = m }) |] )--$(gen_vector_iterable [t| Chain     |] [t| Residue |] [e| residues |] [e| (\s m -> s { residues = m }) |] )--$(gen_vector_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    |] )+-- | Iterable instances and convenience functions.+module Bio.PDB.Iterable(Iterable(..),+                        firstModel,+                        numAtoms,+                        numResidues,+                        numChains,+                        numModels)+where +import Bio.PDB.Iterable.Instances+import Bio.PDB.Iterable.Utils

@@ -0,0 +1,36 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, OverlappingInstances, TemplateHaskell, FlexibleContexts #-}+-- | Instances of Iterable class.+module Bio.PDB.Iterable.Instances(Iterable(..)) where++import Data.Iterable+import Data.Iterable.Instantiate+import Data.Iterable.Instantiate.Vector+import Data.Vector+import Bio.PDB.Structure.List as L+import Bio.PDB.Structure +import Control.Monad.Identity+import Control.Monad(foldM)++$(gen_vector_iterable [t| Structure |] [t| Model   |] [e| models   |] [e| (\s m -> s { models   = m }) |] )++$(gen_vector_iterable [t| Model     |] [t| Chain   |] [e| chains   |] [e| (\s m -> s { chains   = m }) |] )++$(gen_vector_iterable [t| Chain     |] [t| Residue |] [e| residues |] [e| (\s m -> s { residues = m }) |] )++$(gen_vector_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    |] )+

@@ -1,4 +1,5 @@ {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}+-- | Convenience functions using specific Iterable instances. module Bio.PDB.Iterable.Utils(firstModel,                               numAtoms,                               numResidues,@@ -7,21 +8,27 @@ where  import Bio.PDB.Structure-import Bio.PDB.Iterable+import Bio.PDB.Iterable.Instances +-- | Takes a first model. firstModel :: (Iterable a Model) => a -> Maybe Model-firstModel = ifoldr (\m _ -> Just m) Nothing+firstModel = itfoldr (\m _ -> Just m) Nothing  -- GHC BUG: I see no reason, why such a function has to have explicit type decl++-- | Number of all atoms within the structure. numAtoms :: Iterable a Atom => a -> Int-numAtoms = ilength (undefined :: Atom)+numAtoms = itlength (undefined :: Atom) +-- | Number of all residues within the structure. numResidues :: Iterable a Residue => a -> Int-numResidues = ilength (undefined :: Residue)+numResidues = itlength (undefined :: Residue) +-- | Number of all chains within the structure. numChains :: Iterable a Chain => a -> Int-numChains = ilength (undefined :: Chain)+numChains = itlength (undefined :: Chain) +-- | Number of all models within the structure. numModels :: Iterable a Model => a -> Int-numModels = ilength (undefined :: Model)+numModels = itlength (undefined :: Model) 

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+-- | Basic properties of chemical 'Element's as suggested by Cambridge Structural Database. module Bio.PDB.Structure.Elements(Element(..),                                   -- Finding element for a given atom                                   assignElement,@@ -13,20 +14,16 @@ 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 alias for 'Element' names. type Element = BS.ByteString+-- TODO: May be better as a newtype, and make sure that other modules use this declaration  -- | 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 #-}+-- | Atomic number of a given element atomicNumber :: Element -> Int atomicNumber       "C" =   6 atomicNumber       "N" =   7@@ -140,6 +137,8 @@ atomicNumber      "ZR" =  40 atomicNumber      x    = defaulting ["Unknown atomic number for element:", BS.pack $ show x] 0 +{-# INLINE covalentRadius    #-}+-- | Covalent radius of an element with a given name. covalentRadius    "AC" = 2.15 covalentRadius    "AG" = 1.45 covalentRadius    "AL" = 1.21@@ -253,6 +252,7 @@ covalentRadius    x    = defaulting ["Unknown covalent radius for element:", BS.pack $ show x] 0.0  +{-# INLINE atomicMass        #-} -- | Atomic mass of a given element in g/mol atomicMass :: Element -> Double atomicMass         "C" =  12.011@@ -367,6 +367,7 @@ atomicMass        "ZR" =  91.224 atomicMass        x    = defaulting ["Unknown atomic mass for element:", BS.pack $ show x] 0.0 +{-# INLINE vanDerWaalsRadius #-} -- | Van der Waals radius of the given element vanDerWaalsRadius :: Element -> Double vanDerWaalsRadius  "C" = 1.70@@ -481,11 +482,16 @@ vanDerWaalsRadius "ZR" = 2.00 vanDerWaalsRadius e    = defaulting ["Do not know van der Waals radius of", BS.pack $ show e] 0.0 +{-# INLINE assignElement #-}+-- | Given a PDB 'Atom' extract or guess its 'Element' name. assignElement :: Atom -> Element assignElement at = case element at of                      ""   -> guessElement . atName $ at                      code -> code +{-# INLINE guessElement #-}+-- | Guessing an 'Element' name from PDB 'Atom' name. +-- Returns empty string, if 'Element' can't be guessed. guessElement :: BS.ByteString -> Element guessElement "C"   = "C" guessElement "C1'" = "C"

@@ -1,14 +1,16 @@ {-# LANGUAGE MagicHash, NoMonomorphismRestriction, CPP #-}+-- | Collections used within the Structure, currently aliases for the 'Vector' and 'MVector' types. 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, (!)+                              toList, vimap, (!), (++), concat,+                              init, tail, head                              ) where  --import Prelude(Int,Num(..),Monad(..))-import Prelude hiding (length, filter, drop, take, init, tail, mapM, splitAt, map, mapM, foldl, foldr, last)+import Prelude hiding (length, filter, drop, take, init, tail, mapM, splitAt, map, mapM, foldl, foldr, last, (++), concat, head) import qualified Data.Vector.Mutable as M import qualified Data.Vector as V import Control.Monad(when)@@ -122,6 +124,21 @@  -- | `map` on immutable vectors. vimap  = V.imap++-- | Concatenation of a list of immutable vectors.+concat = V.concat++-- | Remove last element of immutable vectors.+init   = V.init++-- | First element of immutable vector.+head   = V.head++-- | Remove first element of immutable vector.+tail   = V.tail++-- | Concatenation of two immutable+(++) = (V.++)  -- | Indexing of an immutable vector. (!)    = (V.!)

@@ -1,4 +1,5 @@ {-# LANGUAGE NoMonomorphismRestriction, BangPatterns #-}+-- | This module wraps 3D vector operations, and adds missing ones. module Bio.PDB.Structure.Vector(Vector3(..),                                 unpackVector3,                                 vnormalise, vdot, (*|), (|*),@@ -10,18 +11,16 @@ import Data.List(foldl') import Test.QuickCheck --- ^ This module wraps 3D vector operations, and adds missing ones.---- | Unpacks an abstract 3D vector into a triple of Doubles.+-- | Unpacks an abstract 3D vector into a triple of 'Double's. unpackVector3 :: Vector3 -> (Double, Double, Double) unpackVector3 (Vector3 x y z) = (x, y, z) --- | Maps an operation that modifies a Double onto a 3D vector.+-- | Maps an operation that modifies a 'Double' onto a 3D vector. {-# INLINE vmap #-} vmap :: (Double -> Double) -> Vector3 -> Vector3 vmap = C.vmap --- | Maps an operation on a pair of Doubles onto a pair of 3D vectors+-- | Maps an operation on a pair of 'Double's onto a pair of 3D vectors --   coordinatewise. vzip :: (Double -> Double -> Double) -> Vector3 -> Vector3 -> Vector3 vzip = C.vzip@@ -31,8 +30,8 @@ vnormalise :: Vector3 -> Vector3 vnormalise = C.vnormalise  --- | Computes a dot product of two 3D vectors. {-# INLINE vdot #-}+-- | Computes a dot product of two 3D vectors. vdot :: Vector3 -> Vector3 -> Double vdot = C.vdot @@ -47,13 +46,13 @@ 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 (*|) #-}+-- | Scalar product. (asterisk - "*" - indicates side on which one can put a scalar.) (*|) :: Double -> Vector3  -> Vector3 (*|) = (C.*|) --- | Scalar product. (`*` indicates side on which one can put a scalar.) {-# INLINE (|*) #-}+-- | Scalar product. (asterisk - "*" - indicates side on which one can put a scalar.) (|*) :: Vector3  -> Double -> Vector3 (|*) = (C.|*) @@ -69,6 +68,7 @@ vperpend v w = v - (v `vproj` w)  +{-# INLINE vperpends #-} -- | Finds a component of the vector v that is perpendicular to all vectors in a list. vperpends v ws = foldl' vperpend v ws 

@@ -1,274 +1,20 @@-{-# LANGUAGE BangPatterns, DisambiguateRecordFields, MultiParamTypeClasses, NamedFieldPuns, FlexibleContexts, OverloadedStrings, RankNTypes #-}-{-# LANGUAGE RecordWildCards #-} -- for convenient debugging-{-# OPTIONS_GHC -fspec-constr-count=2 #-}-module Bio.PDB.StructureBuilder(parse)-+-- | Front-end module presenting minimal interface for serial and parallel parsing.+module Bio.PDB.StructureBuilder(parse+                               ,parseSerial+                               ,parseParallel+                               ,parseWithNParallel) 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 Data.Maybe(isNothing, isJust)--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---- | 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 :: (State.MonadState BState m) => FilePath -> String -> m (Structure, [PDBEvent])-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 (BS.pack 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,-                         lineNo           :: 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,-                                     lineNo           = 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 (isNothing curModel) $ 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 (isJust r) $ 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 (isJust c) $ 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 (isNothing m) $ 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 lineNo-                  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 lineNo-              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 lineNo-                                        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')+import Bio.PDB.StructureBuilder.Internals+import Bio.PDB.StructureBuilder.Parallel+-- For type declaration:+import Prelude hiding(String)+import Bio.PDB.Common(String)+import Bio.PDB.Structure.List(List(..))+import Bio.PDB.Structure(Structure)+import Bio.PDB.EventParser.PDBEvents(PDBEvent(PDBParseError)) +-- | Default parser - uses parallel capabilities, if available.+parse :: FilePath -> String -> (Structure,+                                List PDBEvent)+parse = parseParallel

@@ -0,0 +1,279 @@+{-# LANGUAGE BangPatterns, DisambiguateRecordFields, MultiParamTypeClasses, NamedFieldPuns, FlexibleContexts, OverloadedStrings, RankNTypes #-}+{-# LANGUAGE RecordWildCards #-} -- for convenient debugging+{-# OPTIONS_GHC -fspec-constr-count=2 #-}+module Bio.PDB.StructureBuilder.Internals+--(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 Data.Maybe(isNothing, isJust)++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++-- | Shorthand for the State monad in which parsing is done.+-- `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?++-- parsePDBRec :: (Monad m) => String -> String -> (() -> PDBEvent -> m ()) -> () -> m ()+-- | Parses PDB records given as ByteString, given filename fileContents and a monadic+-- action to be executed for each PDB event.+parsePDBRec :: String -> String -> (() -> PDBEvent -> ParsingMonad t ()) -> () -> ParsingMonad t ()+parsePDBRec = Bio.PDB.EventParser.PDBEventParser.parsePDBRecords++-- | 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.+parseSerial :: FilePath -> String -> (Structure, List PDBEvent)+parseSerial fname contents = ST.runST $ do initial <- initializeState+                                           (s, e)  <- State.evalStateT parsing initial+                                           return (s :: Structure, e :: L.List PDBEvent)+  where parsing = do parsePDBRec (BS.pack 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,+                         lineNo            :: 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,+                                     lineNo            = 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.+checkModel :: ParsingMonad t ()+checkModel = do curModel <- State.gets currentModel+                when (isNothing curModel) $ openModel defaultModelId+-- | Closes construction of a current residue and appends this residue to a current chain. (Monadic action.)+--closeResidue :: State.State BState ()+-- TODO: when createing a dummy model, check that there are no models declared before+--       [Otherwise one needs to report an error!]++-- | Default model id, in case none was indicated (for comparison.)+defaultModelId = 1++closeResidue :: ParsingMonad t ()+closeResidue = do r <- State.gets currentResidue+                  when (isJust r) $ 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 (isJust c) $ 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 (isNothing m) $ 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 lineNo+                  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 lineNo+              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 lineNo+                                        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')+

@@ -0,0 +1,112 @@+{-# LANGUAGE BangPatterns, PatternGuards #-}+module Bio.PDB.StructureBuilder.Parallel(parseParallel, parseWithNParallel, joinStructure, joinResult)+where++import           Prelude hiding(String)+import           Bio.PDB.StructureBuilder.Internals+import           Bio.PDB.Structure+import           Bio.PDB.EventParser.PDBEvents(PDBEvent(PDBParseError))+import           GHC.Conc(numCapabilities)+import           Control.Parallel.Strategies+import           Control.Arrow((&&&))+import qualified Bio.PDB.Structure.List     as L+import qualified Data.ByteString.Char8      as BS+import qualified Control.Monad.ST           as ST+import           Control.Monad.State.Strict as State +import           Data.STRef                 as STRef++-- | Parse a fragment of PDB file, returning final line number (within the chunk.)+partialParse :: FilePath -> String -> (Structure, L.List PDBEvent, Int)+partialParse fname contents = ST.runST $ do initial <- initializeState+                                            (s, e, l)  <- State.evalStateT parsing initial+                                            return (s :: Structure, e :: L.List PDBEvent, l :: Int)+  where parsing = do parsePDBRec (BS.pack fname) contents (\() !ev -> parseStep ev) ()+                     closeStructure+                     s     <- State.gets currentStructure+                     e     <- State.gets errors+                     lnref <- State.gets lineNo+                     ln    <- lift $ STRef.readSTRef lnref+                     e'    <- L.finalize e+                     return (s, e', ln)++-- | Parse file in parallel with as many threads as we have capabilities.+parseParallel = parseWithNParallel numCapabilities+-- TODO: merging+-- | Intermediate result from parsing of PDB chunk.+type ParseResult = (Structure, L.List PDBEvent, Int)++-- | Joins 'ParseResult' from two different chunks and returns a single 'ParseResult'.+joinResult :: ParseResult -> ParseResult -> ParseResult+joinResult (struct1, errs1, ln1) (struct2, errs2, ln2) = (resultStruct, resultErrs, ln2)+  where+    resultStruct = struct1 `joinStructure` struct2+    resultErrs   = errs1 L.++ L.map (updateErrorLine ln1) errs2++-- | Joins 'Structure's resulting from partial parses.+joinStructure ::  Structure -> Structure -> Structure+joinStructure = joiner models (\s m -> s { models = m }) modelId matchModelId joinModel+  where+    modelId1 `matchModelId` modelId2 | modelId2 == defaultModelId = True+    modelId1 `matchModelId` modelId2 | modelId1 == modelId2       = True+    modelId1 `matchModelId` modelId2                              = False++-- | Joins 'Model's resulting from partial parses.+joinModel :: Model -> Model -> Model+joinModel = joiner chains (\m c -> m { chains = c }) chainId (==) joinChain++-- | Joins 'Chain's resulting from partial parses.+joinChain :: Chain -> Chain -> Chain+joinChain = joiner residues (\c r -> c { residues = r }) resId (==) joinResidue+  where+    resId = resName &&& resSeq &&& insCode++-- | Joins 'Residue's resulting from partial parses.+joinResidue = joiner atoms (\r a -> r { atoms = a }) (const ()) (/=) (error "Never happens")++{-# INLINE joiner #-}+-- | Produce joinX function, given:+--   * getter for subordinate component vector,+--   * setter for subordinate component vector,+--   * getter for the id of a subordinate component,+--   * matcher for ids of subordinate components that decides whether they have to be joined,+--   * and joining function for subordinate objects (if they share the same id.)+--+-- This joining function merges two data structures.+joiner :: (a -> L.List a1)-> (a -> L.List a1 -> t)-> (a1 -> t1)-> (t1 -> t1 -> Bool)-> (a1 -> a1 -> a1)-> a-> a-> t+joiner getter setter idGetter matcher subjoiner = join+  where+    s1 `join` s2 | len s1 == 0 || len s2 == 0 = s1 `setter` (getter s1 L.++ getter s2)+      where+        len = L.length . getter+    s1 `join` s2 | id1 `matcher` id2          = s1 `setter` L.concat [L.init      (getter s1)        ,+                                                                      L.singleton (m1 `subjoiner` m2),+                                                                      L.tail      (getter s2)        ]+      where+        id1 = idGetter m1+        id2 = idGetter m2+        m1       = L.last $ getter s1+        m2       = L.head $ getter s2+    s1 `join` s2                              = s1 `setter` (getter s1 L.++ getter s2)++-- | Increments line numbers in 'PDBParseError' records by a given value.+updateErrorLine ::  Int -> PDBEvent -> PDBEvent+updateErrorLine startingLineNo (PDBParseError lineNo colNo line) = PDBParseError (lineNo + startingLineNo) colNo line+updateErrorLine startingLineNo evt                               = evt++--parseParallelWithNSparks :: Int -> FilePath -> String -> [(Structure, List PDBEvent)]+-- | Parse input file with N parallel threads.+parseWithNParallel sparks fname input = (struct, errs)+  where+    chunkLen = ceiling (fromIntegral (BS.length input) / fromIntegral sparks)+    chunks = chunkString chunkLen input+    pList = map (partialParse fname) chunks+    partialResults  = pList `using` parList (evalTuple3 rdeepseq r0 r0)+    (struct, errs, ln)  = foldl joinResult (head partialResults) (tail partialResults)+-- TODO: correct line numbers! partial parse should return Structure + line number++-- | Splits a ByteString into chunks of given size, and ending at end of line.+chunkString ::  Int -> String -> [String]+chunkString l s | BS.length s <= l                          = [s]+chunkString l s | Just n <- BS.elemIndex '\n' (BS.drop l s) = BS.take (l+n+1) s:chunkString l (BS.drop (l+n+1) s)+chunkString l s                                             = [s]+

@@ -1,11 +1,11 @@ {-# LANGUAGE NamedFieldPuns, DisambiguateRecordFields #-}+-- | High-level output routines for 'Structure'. 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_)@@ -19,18 +19,18 @@                              -- | Generates list of `PDBEvent`s from a given Structure. structureEvents :: Structure -> [PDBEvent]-structureEvents s = ifoldr modelEvents [END] s+structureEvents s = itfoldr 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+    main  c = itfoldr chainEvents c m  -- | Generates list of `PDBEvent`s from a given Chain. chainEvents :: Chain -> PDBEventS-chainEvents ch c = ifoldr (residueEvents ch) (ter:c) ch+chainEvents ch c = itfoldr (residueEvents ch) (ter:c) ch   where     ter = TER { num     = atSer + 1      , -- FIXME: should be lastAtom ch + 1                 resname = lastResName    ,@@ -46,7 +46,7 @@  -- | 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+residueEvents ch r c = itfoldr (atomEvents ch r) c r  -- | Generates list of `PDBEvent`s from a given Atom, its Residue, and its Chain. atomEvents :: Chain -> Residue -> Atom -> PDBEventS

@@ -1,5 +1,5 @@ name:                hPDB-version:             0.999+version:             0.9999 synopsis:            Protein Databank file format library homepage:            https://github.com/mgajda/hpdb stability:           beta@@ -64,7 +64,7 @@  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, iterable >= 1.0+  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, iterable >= 2.0, parallel >= 3.0.0.0   if flag(have-mmap)     build-depends: mmap     cpp-options: -DHAVE_MMAP@@ -89,7 +89,7 @@   else     build-depends: zlib >= 0.5.4.0   other-extensions:       ScopedTypeVariables OverloadedStrings BangPatterns NoMonomorphismRestriction EmptyDataDecls MagicHash CPP PatternGuards NamedFieldPuns DisambiguateRecordFields TemplateHaskell MultiParamTypeClasses FlexibleInstances FlexibleContexts-  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.Iterable.Utils+  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.Iterable.Utils, Bio.PDB.Iterable.Instances, Bio.PDB.StructureBuilder.Internals, Bio.PDB.StructureBuilder.Parallel   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