{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Bio.PDB.Writer
( pdbToFile
, pdbToText
) where
import Bio.PDB.Type (Atom (..), Chain, Model, PDB (..))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Text (Text)
import qualified Data.Text as T (cons, drop, init, intercalate,
last, length, pack, replicate,
singleton, splitAt, take)
import qualified Data.Text.IO as TIO (writeFile)
import Data.Vector (Vector)
import qualified Data.Vector as V (all, foldl', fromList, last,
length, toList, zip)
import Text.Printf (printf)
pdbToFile :: MonadIO m => PDB -> FilePath -> m ()
pdbToFile :: forall (m :: * -> *). MonadIO m => PDB -> String -> m ()
pdbToFile PDB
pdb = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Text -> IO ()
TIO.writeFile (PDB -> Text
pdbToText PDB
pdb)
pdbToText :: PDB -> Text
pdbToText :: PDB -> Text
pdbToText PDB{Vector Model
Text
Map RemarkCode RemarkData
Map FieldType RemarkData
otherFields :: PDB -> Map FieldType RemarkData
remarks :: PDB -> Map RemarkCode RemarkData
models :: PDB -> Vector Model
title :: PDB -> Text
otherFields :: Map FieldType RemarkData
remarks :: Map RemarkCode RemarkData
models :: Vector Model
title :: Text
..} = (forall a. Semigroup a => a -> a -> a
<> Text
newLine forall a. Semigroup a => a -> a -> a
<> Text -> Text
toPDBLine Text
end)
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
newLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
V.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> (Model, Int) -> Text
modelToText Bool
separateModels)
forall a b. (a -> b) -> a -> b
$ forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip Vector Model
models forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Vector a
V.fromList [Int
1 ..]
where
separateModels :: Bool
separateModels = forall a. Vector a -> Int
V.length Vector Model
models forall a. Ord a => a -> a -> Bool
> Int
1
end :: Text
end :: Text
end = Text
"END "
type TerAtom = Atom
modelToText :: Bool -> (Model, Int) -> Text
modelToText :: Bool -> (Model, Int) -> Text
modelToText Bool
separateModels (Model
pdbModel, Int
modelInd) = Text
modelPrefix forall a. Semigroup a => a -> a -> a
<> Text
atomsT forall a. Semigroup a => a -> a -> a
<> Text
modelSuffix
where
atomsT :: Text
atomsT = Text -> [Text] -> Text
T.intercalate Text
newLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
V.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either Atom Atom -> Text
atomOrTer forall b c a. (b -> c) -> (a -> b) -> a -> c
. Model -> Vector (Either Atom Atom)
withTers forall a b. (a -> b) -> a -> b
$ Model
pdbModel
modelPrefix :: Text
modelPrefix | Bool
separateModels = Text -> Text
toPDBLine (Text
mdl forall a. Semigroup a => a -> a -> a
<> Int -> Text
spaceText Int
4 forall a. Semigroup a => a -> a -> a
<> forall a. Show a => Int -> a -> Text
prependToS Int
4 Int
modelInd) forall a. Semigroup a => a -> a -> a
<> Text
newLine
| Bool
otherwise = Text
""
modelSuffix :: Text
modelSuffix | Bool
separateModels = Text
newLine forall a. Semigroup a => a -> a -> a
<> Text -> Text
toPDBLine Text
endmdl
| Bool
otherwise = Text
""
mdl :: Text
mdl :: Text
mdl = Text
"MODEL "
endmdl :: Text
endmdl :: Text
endmdl = Text
"ENDMDL "
withTers :: Vector Chain -> Vector (Either Atom TerAtom)
withTers :: Model -> Vector (Either Atom Atom)
withTers = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' (Int, Vector (Either Atom Atom))
-> Chain -> (Int, Vector (Either Atom Atom))
addTer (Int
0, forall a. Monoid a => a
mempty)
where
addTer :: (Int, Vector (Either Atom TerAtom)) -> Chain -> (Int, Vector (Either Atom TerAtom))
addTer :: (Int, Vector (Either Atom Atom))
-> Chain -> (Int, Vector (Either Atom Atom))
addTer (Int
add, Vector (Either Atom Atom)
res) Chain
cur = if forall a. (a -> Bool) -> Vector a -> Bool
V.all (Text -> Bool
isHetatm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Atom -> Text
atomResName) Chain
cur then (Int
add, Vector (Either Atom Atom)
newRes) else (Int, Vector (Either Atom Atom))
withTer
where
ter :: Atom
ter = Int -> Atom -> Atom
addSerial (Int
add forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> a
V.last Chain
cur
newRes :: Vector (Either Atom Atom)
newRes = Vector (Either Atom Atom)
res forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Atom -> Atom
addSerial Int
add) Chain
cur
withTer :: (Int, Vector (Either Atom Atom))
withTer = (Int
add forall a. Num a => a -> a -> a
+ Int
1, Vector (Either Atom Atom)
newRes forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right Atom
ter))
addSerial :: Int -> Atom -> Atom
addSerial :: Int -> Atom -> Atom
addSerial Int
i at :: Atom
at@Atom{Char
Float
Int
Text
atomCharge :: Atom -> Text
atomElement :: Atom -> Text
atomTempFactor :: Atom -> Float
atomOccupancy :: Atom -> Float
atomZ :: Atom -> Float
atomY :: Atom -> Float
atomX :: Atom -> Float
atomICode :: Atom -> Char
atomResSeq :: Atom -> Int
atomChainID :: Atom -> Char
atomAltLoc :: Atom -> Char
atomName :: Atom -> Text
atomSerial :: Atom -> Int
atomCharge :: Text
atomElement :: Text
atomTempFactor :: Float
atomOccupancy :: Float
atomZ :: Float
atomY :: Float
atomX :: Float
atomICode :: Char
atomResSeq :: Int
atomChainID :: Char
atomResName :: Text
atomAltLoc :: Char
atomName :: Text
atomSerial :: Int
atomResName :: Atom -> Text
..} = Atom
at { atomSerial :: Int
atomSerial = Int
atomSerial forall a. Num a => a -> a -> a
+ Int
i }
atomOrTer :: Either Atom TerAtom -> Text
atomOrTer :: Either Atom Atom -> Text
atomOrTer = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Atom -> Text
atomToText Atom -> Text
terAtomToText
terAtomToText :: Atom -> Text
terAtomToText :: Atom -> Text
terAtomToText Atom
at = Text -> Text
toPDBLine forall a b. (a -> b) -> a -> b
$ Text
pref forall a. Semigroup a => a -> a -> a
<> Int -> Text
spaceText Int
6 forall a. Semigroup a => a -> a -> a
<> Text
suf
where
t :: Text
t = (Text
ter forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.take Int
21 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
6 forall a b. (a -> b) -> a -> b
$ Atom -> Text
atomToText Atom
at
(Text
pref, Text
suf) = Int -> Text -> Text
T.drop Int
6 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Text -> (Text, Text)
T.splitAt Int
11 Text
t
ter :: Text
ter :: Text
ter = Text
"TER "
atomToText :: Atom -> Text
atomToText :: Atom -> Text
atomToText Atom{Char
Float
Int
Text
atomCharge :: Text
atomElement :: Text
atomTempFactor :: Float
atomOccupancy :: Float
atomZ :: Float
atomY :: Float
atomX :: Float
atomICode :: Char
atomResSeq :: Int
atomChainID :: Char
atomResName :: Text
atomAltLoc :: Char
atomName :: Text
atomSerial :: Int
atomCharge :: Atom -> Text
atomElement :: Atom -> Text
atomTempFactor :: Atom -> Float
atomOccupancy :: Atom -> Float
atomZ :: Atom -> Float
atomY :: Atom -> Float
atomX :: Atom -> Float
atomICode :: Atom -> Char
atomResSeq :: Atom -> Int
atomChainID :: Atom -> Char
atomAltLoc :: Atom -> Char
atomName :: Atom -> Text
atomSerial :: Atom -> Int
atomResName :: Atom -> Text
..} = Text
res
where
recordName :: Text
recordName | Text -> Bool
isHetatm Text
atomResName = Text
hetatm
| Bool
otherwise = Text
atm
serial :: Text
serial = forall a. Show a => Int -> a -> Text
prependToS Int
5 Int
atomSerial
name :: Text
name = (\Text
t -> if Text -> Char
T.last Text
t forall a. Eq a => a -> a -> Bool
== Char
space then Char -> Text -> Text
T.cons Char
space forall a b. (a -> b) -> a -> b
$ Text -> Text
T.init Text
t else Text
t) forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
appendTo Int
4 Text
atomName
altLoc :: Text
altLoc = Char -> Text
T.singleton Char
atomAltLoc
resName :: Text
resName = Int -> Text -> Text
prependTo Int
3 Text
atomResName
chainID :: Text
chainID = Char -> Text
T.singleton Char
atomChainID
resSeq :: Text
resSeq = forall a. Show a => Int -> a -> Text
prependToS Int
4 Int
atomResSeq
iCode :: Text
iCode = Char -> Text
T.singleton Char
atomICode
x :: Text
x = Int -> Text -> Text
prependTo Int
8 forall a b. (a -> b) -> a -> b
$ Int -> Float -> Text
printFloat Int
3 Float
atomX
y :: Text
y = Int -> Text -> Text
prependTo Int
8 forall a b. (a -> b) -> a -> b
$ Int -> Float -> Text
printFloat Int
3 Float
atomY
z :: Text
z = Int -> Text -> Text
prependTo Int
8 forall a b. (a -> b) -> a -> b
$ Int -> Float -> Text
printFloat Int
3 Float
atomZ
occupancy :: Text
occupancy = Int -> Text -> Text
prependTo Int
6 forall a b. (a -> b) -> a -> b
$ Int -> Float -> Text
printFloat Int
2 Float
atomOccupancy
tempFactor :: Text
tempFactor = Int -> Text -> Text
prependTo Int
6 forall a b. (a -> b) -> a -> b
$ Int -> Float -> Text
printFloat Int
2 Float
atomTempFactor
element :: Text
element = Int -> Text -> Text
prependTo Int
2 Text
atomElement
charge :: Text
charge | Text
atomCharge forall a. Eq a => a -> a -> Bool
/= Text
zeroCharge = Int -> Text -> Text
prependTo Int
2 Text
atomCharge
| Bool
otherwise = Int -> Text
spaceText Int
2
res :: Text
res = Text
recordName forall a. Semigroup a => a -> a -> a
<> Text
serial forall a. Semigroup a => a -> a -> a
<> Int -> Text
spaceText Int
1 forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
altLoc
forall a. Semigroup a => a -> a -> a
<> Text
resName forall a. Semigroup a => a -> a -> a
<> Int -> Text
spaceText Int
1 forall a. Semigroup a => a -> a -> a
<> Text
chainID forall a. Semigroup a => a -> a -> a
<> Text
resSeq forall a. Semigroup a => a -> a -> a
<> Text
iCode forall a. Semigroup a => a -> a -> a
<> Int -> Text
spaceText Int
3
forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Text
y forall a. Semigroup a => a -> a -> a
<> Text
z forall a. Semigroup a => a -> a -> a
<> Text
occupancy forall a. Semigroup a => a -> a -> a
<> Text
tempFactor forall a. Semigroup a => a -> a -> a
<> Int -> Text
spaceText Int
10
forall a. Semigroup a => a -> a -> a
<> Text
element forall a. Semigroup a => a -> a -> a
<> Text
charge
atm :: Text
atm :: Text
atm = Text
"ATOM "
hetatm :: Text
hetatm :: Text
hetatm = Text
"HETATM"
zeroCharge :: Text
zeroCharge :: Text
zeroCharge = Text
"0"
printFloat :: Int -> Float -> Text
printFloat :: Int -> Float -> Text
printFloat Int
after Float
f = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%.*f" Int
after Float
f
isHetatm :: Text -> Bool
isHetatm :: Text -> Bool
isHetatm = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
canonicalAminoAcids)
where
canonicalAminoAcids :: [Text]
canonicalAminoAcids = [ Text
"ACE", Text
"ALA", Text
"ARG", Text
"ASN", Text
"ASP", Text
"CYS", Text
"GLU", Text
"GLN"
, Text
"GLY", Text
"HIS", Text
"HID", Text
"HIE", Text
"HIP", Text
"ILE", Text
"LEU", Text
"LYS", Text
"LYN"
, Text
"MET", Text
"NMA", Text
"PHE", Text
"PRO", Text
"SER", Text
"THR", Text
"TRP", Text
"TYR", Text
"VAL"
]
toPDBLine :: Text -> Text
toPDBLine :: Text -> Text
toPDBLine = Int -> Text -> Text
appendTo Int
80
prependToS :: Show a => Int -> a -> Text
prependToS :: forall a. Show a => Int -> a -> Text
prependToS Int
i = Int -> Text -> Text
prependTo Int
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
prependTo :: Int -> Text -> Text
prependTo :: Int -> Text -> Text
prependTo Int
i Text
t = Int -> Text
spaceText (Int
i forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
t) forall a. Semigroup a => a -> a -> a
<> Text
t
appendTo :: Int -> Text -> Text
appendTo :: Int -> Text -> Text
appendTo Int
i Text
t = Text
t forall a. Semigroup a => a -> a -> a
<> Int -> Text
spaceText (Int
i forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
t)
newLine :: Text
newLine :: Text
newLine = Text
"\n"
spaceText :: Int -> Text
spaceText :: Int -> Text
spaceText = forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Text -> Text
T.replicate Text
" "
space :: Char
space :: Char
space = Char
' '