{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Bio.PDB.Parser
  ( pdbP )
where


import           Bio.PDB.Type         (Atom (..), Chain, FieldType, Model,
                                       PDB (..), RemarkCode)
import           Control.Applicative  (many, some, (<|>))
import           Control.DeepSeq      ()
import           Data.Attoparsec.Text (Parser, choice, count, endOfInput,
                                       endOfLine, isEndOfLine, satisfy,
                                       skipWhile, space, string, takeWhile,
                                       anyChar)
import qualified Data.List            as L (groupBy)
import           Data.Map.Strict      (Map, fromListWithKey)
import           Data.Maybe           (catMaybes)
import           Data.Function        (on)
import           Data.Text            as T (Text, concat, pack, stripEnd)
import qualified Data.Vector          as V (Vector, concat, fromList, singleton)
import           GHC.Generics         ()
import           Text.Read            (readMaybe)

pdbP :: Parser PDB
pdbP :: Parser PDB
pdbP = do
    [PdbData]
pdbData <- Parser Text PdbData -> Parser Text [PdbData]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ([Parser Text PdbData] -> Parser Text PdbData
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Parser Text PdbData
titleP, Parser Text PdbData
remarkStringP, Parser Text PdbData
manyModelsP, Parser Text PdbData
otherFieldP]) -- parser order is important
    let
        models :: Vector Model
models         = [Vector Model] -> Vector Model
forall a. [Vector a] -> Vector a
V.concat ([Vector Model] -> Vector Model) -> [Vector Model] -> Vector Model
forall a b. (a -> b) -> a -> b
$ [Maybe (Vector Model)] -> [Vector Model]
forall a. [Maybe a] -> [a]
catMaybes (PdbData -> Maybe (Vector Model)
getModels (PdbData -> Maybe (Vector Model))
-> [PdbData] -> [Maybe (Vector Model)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PdbData]
pdbData)
        otherFieldsMap :: Map FieldType (Vector Text)
otherFieldsMap = (Vector Text -> Vector Text -> Vector Text)
-> [(FieldType, Vector Text)] -> Map FieldType (Vector Text)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
fromRevListWith Vector Text -> Vector Text -> Vector Text
forall a. Semigroup a => a -> a -> a
(<>) ([(FieldType, Vector Text)] -> Map FieldType (Vector Text))
-> [(FieldType, Vector Text)] -> Map FieldType (Vector Text)
forall a b. (a -> b) -> a -> b
$ [Maybe (FieldType, Vector Text)] -> [(FieldType, Vector Text)]
forall a. [Maybe a] -> [a]
catMaybes (PdbData -> Maybe (FieldType, Vector Text)
getOtherField (PdbData -> Maybe (FieldType, Vector Text))
-> [PdbData] -> [Maybe (FieldType, Vector Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PdbData]
pdbData)
        title :: Text
title          = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes (PdbData -> Maybe Text
getTitle (PdbData -> Maybe Text) -> [PdbData] -> [Maybe Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PdbData]
pdbData)
        remarks :: Map RemarkCode (Vector Text)
remarks        = (Vector Text -> Vector Text -> Vector Text)
-> [(RemarkCode, Vector Text)] -> Map RemarkCode (Vector Text)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
fromRevListWith Vector Text -> Vector Text -> Vector Text
forall a. Semigroup a => a -> a -> a
(<>) ([(RemarkCode, Vector Text)] -> Map RemarkCode (Vector Text))
-> [(RemarkCode, Vector Text)] -> Map RemarkCode (Vector Text)
forall a b. (a -> b) -> a -> b
$ [Maybe (RemarkCode, Vector Text)] -> [(RemarkCode, Vector Text)]
forall a. [Maybe a] -> [a]
catMaybes (PdbData -> Maybe (RemarkCode, Vector Text)
getRemarks (PdbData -> Maybe (RemarkCode, Vector Text))
-> [PdbData] -> [Maybe (RemarkCode, Vector Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PdbData]
pdbData)

    PDB -> Parser PDB
forall (m :: * -> *) a. Monad m => a -> m a
return (PDB -> Parser PDB) -> PDB -> Parser PDB
forall a b. (a -> b) -> a -> b
$ Text
-> Vector Model
-> Map RemarkCode (Vector Text)
-> Map FieldType (Vector Text)
-> PDB
PDB Text
title Vector Model
models Map RemarkCode (Vector Text)
remarks Map FieldType (Vector Text)
otherFieldsMap
  where
    getModels :: PdbData -> Maybe (V.Vector Model)
    getModels :: PdbData -> Maybe (Vector Model)
getModels PdbData
item = case PdbData
item of
      ModelData Vector Model
x -> Vector Model -> Maybe (Vector Model)
forall a. a -> Maybe a
Just Vector Model
x
      PdbData
_           -> Maybe (Vector Model)
forall a. Maybe a
Nothing
    getOtherField :: PdbData -> Maybe (FieldType, V.Vector Text)
    getOtherField :: PdbData -> Maybe (FieldType, Vector Text)
getOtherField PdbData
item = case PdbData
item of
      OtherFieldData (Just FieldType
x, Text
y) -> (FieldType, Vector Text) -> Maybe (FieldType, Vector Text)
forall a. a -> Maybe a
Just (FieldType
x, Text -> Vector Text
forall a. a -> Vector a
V.singleton Text
y)
      PdbData
_                          -> Maybe (FieldType, Vector Text)
forall a. Maybe a
Nothing
    getTitle :: PdbData -> Maybe Text
    getTitle :: PdbData -> Maybe Text
getTitle PdbData
item = case PdbData
item of
      TitleData Text
x -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
      PdbData
_           -> Maybe Text
forall a. Maybe a
Nothing
    getRemarks :: PdbData -> Maybe (RemarkCode, V.Vector Text)
    getRemarks :: PdbData -> Maybe (RemarkCode, Vector Text)
getRemarks PdbData
item = case PdbData
item of
      RemarkData (RemarkCode
x, Text
y) -> (RemarkCode, Vector Text) -> Maybe (RemarkCode, Vector Text)
forall a. a -> Maybe a
Just (RemarkCode
x, Text -> Vector Text
forall a. a -> Vector a
V.singleton Text
y)
      PdbData
_                 -> Maybe (RemarkCode, Vector Text)
forall a. Maybe a
Nothing

data PdbData = ModelData (V.Vector Model)
             | OtherFieldData (Maybe FieldType, Text)
             | RemarkData (RemarkCode, Text)
             | TitleData Text
  deriving (Int -> PdbData -> ShowS
[PdbData] -> ShowS
PdbData -> String
(Int -> PdbData -> ShowS)
-> (PdbData -> String) -> ([PdbData] -> ShowS) -> Show PdbData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PdbData] -> ShowS
$cshowList :: [PdbData] -> ShowS
show :: PdbData -> String
$cshow :: PdbData -> String
showsPrec :: Int -> PdbData -> ShowS
$cshowsPrec :: Int -> PdbData -> ShowS
Show)

notEndLineChar :: Parser Char
notEndLineChar :: Parser Char
notEndLineChar = (Char -> Bool) -> Parser Char
satisfy ((Char -> Bool) -> Parser Char) -> (Char -> Bool) -> Parser Char
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isEndOfLine

takeText :: Parser Text
takeText :: Parser Text
takeText = (Char -> Bool) -> Parser Text
Data.Attoparsec.Text.takeWhile ((Char -> Bool) -> Parser Text) -> (Char -> Bool) -> Parser Text
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isEndOfLine

atomP :: Parser CoordLike
atomP :: Parser CoordLike
atomP = let atom :: Parser Text Atom
atom = Int
-> Text
-> Char
-> Text
-> Char
-> Int
-> Char
-> Float
-> Float
-> Float
-> Float
-> Float
-> Text
-> Text
-> Atom
Atom (Int
 -> Text
 -> Char
 -> Text
 -> Char
 -> Int
 -> Char
 -> Float
 -> Float
 -> Float
 -> Float
 -> Float
 -> Text
 -> Text
 -> Atom)
-> Parser Text Int
-> Parser
     Text
     (Text
      -> Char
      -> Text
      -> Char
      -> Int
      -> Char
      -> Float
      -> Float
      -> Float
      -> Float
      -> Float
      -> Text
      -> Text
      -> Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    (
                      (Text -> Parser Text
string Text
"ATOM " Parser Text -> Parser Text Int -> Parser Text Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>                                      -- (1 -  5)  ATOM -- we extended atomSerial length to the left for one symbol
                      (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> Parser Text String -> Parser Text Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
6 Parser Char
notEndLineChar))                      -- (6 - 11)  atomSerial
                        Parser Text Int -> Parser Text Int -> Parser Text Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>                                                   -- or
                      (Text -> Parser Text
string Text
"HETATM" Parser Text -> Parser Text Int -> Parser Text Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>                                     -- (1 -  6)  HETATM
                      (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> Parser Text String -> Parser Text Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
5 Parser Char
notEndLineChar))                      -- (7 - 11)  atomSerial
                    )
                    Parser
  Text
  (Text
   -> Char
   -> Text
   -> Char
   -> Int
   -> Char
   -> Float
   -> Float
   -> Float
   -> Float
   -> Float
   -> Text
   -> Text
   -> Atom)
-> Parser Char
-> Parser
     Text
     (Text
      -> Char
      -> Text
      -> Char
      -> Int
      -> Char
      -> Float
      -> Float
      -> Float
      -> Float
      -> Float
      -> Text
      -> Text
      -> Atom)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
space
                    Parser
  Text
  (Text
   -> Char
   -> Text
   -> Char
   -> Int
   -> Char
   -> Float
   -> Float
   -> Float
   -> Float
   -> Float
   -> Text
   -> Text
   -> Atom)
-> Parser Text
-> Parser
     Text
     (Char
      -> Text
      -> Char
      -> Int
      -> Char
      -> Float
      -> Float
      -> Float
      -> Float
      -> Float
      -> Text
      -> Text
      -> Atom)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Text
T.pack (String -> Text) -> Parser Text String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
4 Parser Char
notEndLineChar)                   -- (13 - 16) atomName
                    Parser
  Text
  (Char
   -> Text
   -> Char
   -> Int
   -> Char
   -> Float
   -> Float
   -> Float
   -> Float
   -> Float
   -> Text
   -> Text
   -> Atom)
-> Parser Char
-> Parser
     Text
     (Text
      -> Char
      -> Int
      -> Char
      -> Float
      -> Float
      -> Float
      -> Float
      -> Float
      -> Text
      -> Text
      -> Atom)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Char
notEndLineChar                                        -- (17)      atomAltLoc
                    Parser
  Text
  (Text
   -> Char
   -> Int
   -> Char
   -> Float
   -> Float
   -> Float
   -> Float
   -> Float
   -> Text
   -> Text
   -> Atom)
-> Parser Text
-> Parser
     Text
     (Char
      -> Int
      -> Char
      -> Float
      -> Float
      -> Float
      -> Float
      -> Float
      -> Text
      -> Text
      -> Atom)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Text
T.pack (String -> Text) -> Parser Text String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
3 Parser Char
notEndLineChar) Parser
  Text
  (Char
   -> Int
   -> Char
   -> Float
   -> Float
   -> Float
   -> Float
   -> Float
   -> Text
   -> Text
   -> Atom)
-> Parser Char
-> Parser
     Text
     (Char
      -> Int
      -> Char
      -> Float
      -> Float
      -> Float
      -> Float
      -> Float
      -> Text
      -> Text
      -> Atom)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
space          -- (18 - 20) atomResName
                    Parser
  Text
  (Char
   -> Int
   -> Char
   -> Float
   -> Float
   -> Float
   -> Float
   -> Float
   -> Text
   -> Text
   -> Atom)
-> Parser Char
-> Parser
     Text
     (Int
      -> Char
      -> Float
      -> Float
      -> Float
      -> Float
      -> Float
      -> Text
      -> Text
      -> Atom)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Char
notEndLineChar                                        -- (22)      atomChainID
                    Parser
  Text
  (Int
   -> Char
   -> Float
   -> Float
   -> Float
   -> Float
   -> Float
   -> Text
   -> Text
   -> Atom)
-> Parser Text Int
-> Parser
     Text
     (Char
      -> Float
      -> Float
      -> Float
      -> Float
      -> Float
      -> Text
      -> Text
      -> Atom)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> Parser Text String -> Parser Text Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
4 Parser Char
notEndLineChar)                     -- (23 - 26) atomResSeq
                    Parser
  Text
  (Char
   -> Float
   -> Float
   -> Float
   -> Float
   -> Float
   -> Text
   -> Text
   -> Atom)
-> Parser Char
-> Parser
     Text
     (Float -> Float -> Float -> Float -> Float -> Text -> Text -> Atom)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Char
notEndLineChar Parser
  Text
  (Float -> Float -> Float -> Float -> Float -> Text -> Text -> Atom)
-> Parser Text String
-> Parser
     Text
     (Float -> Float -> Float -> Float -> Float -> Text -> Text -> Atom)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
3 Parser Char
space                       -- (27)      atomICode
                    Parser
  Text
  (Float -> Float -> Float -> Float -> Float -> Text -> Text -> Atom)
-> Parser Text Float
-> Parser
     Text (Float -> Float -> Float -> Float -> Text -> Text -> Atom)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Float
forall a. Read a => String -> a
read (String -> Float) -> Parser Text String -> Parser Text Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
8 Parser Char
notEndLineChar)                     -- (31 - 38) atomX
                    Parser
  Text (Float -> Float -> Float -> Float -> Text -> Text -> Atom)
-> Parser Text Float
-> Parser Text (Float -> Float -> Float -> Text -> Text -> Atom)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Float
forall a. Read a => String -> a
read (String -> Float) -> Parser Text String -> Parser Text Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
8 Parser Char
notEndLineChar)                     -- (39 - 46) atomY
                    Parser Text (Float -> Float -> Float -> Text -> Text -> Atom)
-> Parser Text Float
-> Parser Text (Float -> Float -> Text -> Text -> Atom)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Float
forall a. Read a => String -> a
read (String -> Float) -> Parser Text String -> Parser Text Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
8 Parser Char
notEndLineChar)                     -- (47 - 54) atomZ
                    Parser Text (Float -> Float -> Text -> Text -> Atom)
-> Parser Text Float -> Parser Text (Float -> Text -> Text -> Atom)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Float
forall a. Read a => String -> a
read (String -> Float) -> Parser Text String -> Parser Text Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
6 Parser Char
notEndLineChar)                     -- (55 - 60) atomOccupancy
                    Parser Text (Float -> Text -> Text -> Atom)
-> Parser Text Float -> Parser Text (Text -> Text -> Atom)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Float
forall a. Read a => String -> a
read (String -> Float) -> Parser Text String -> Parser Text Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
6 Parser Char
notEndLineChar) Parser Text (Text -> Text -> Atom)
-> Parser Text String -> Parser Text (Text -> Text -> Atom)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
10 Parser Char
anyChar -- (61 - 66) atomTempFactor
                    Parser Text (Text -> Text -> Atom)
-> Parser Text -> Parser Text (Text -> Atom)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Text
T.pack (String -> Text) -> Parser Text String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Char
notEndLineChar)                   -- (77 - 78) atomElement
                    Parser Text (Text -> Atom) -> Parser Text -> Parser Text Atom
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Text
T.pack (String -> Text) -> Parser Text String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 Parser Char
notEndLineChar)                   -- (79 - 80) atomCharge
                    Parser Text Atom -> Parser Text () -> Parser Text Atom
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Text ()
endOfLine Parser Text () -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput)
        in Atom -> CoordLike
AtomLine (Atom -> CoordLike) -> Parser Text Atom -> Parser CoordLike
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Atom
atom

coordNotAtomP :: Parser CoordLike
coordNotAtomP :: Parser CoordLike
coordNotAtomP = do
    Text
_ <- Text -> Parser Text
string Text
"TER" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
string Text
"ANISOU" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
string Text
"CONECT"
    (Char -> Bool) -> Parser Text ()
skipWhile ((Char -> Bool) -> Parser Text ())
-> (Char -> Bool) -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isEndOfLine
    Parser Text ()
endOfLine
    CoordLike -> Parser CoordLike
forall (m :: * -> *) a. Monad m => a -> m a
return CoordLike
CoordNotAtomLine

data CoordLike = AtomLine Atom | CoordNotAtomLine
  deriving (Int -> CoordLike -> ShowS
[CoordLike] -> ShowS
CoordLike -> String
(Int -> CoordLike -> ShowS)
-> (CoordLike -> String)
-> ([CoordLike] -> ShowS)
-> Show CoordLike
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoordLike] -> ShowS
$cshowList :: [CoordLike] -> ShowS
show :: CoordLike -> String
$cshow :: CoordLike -> String
showsPrec :: Int -> CoordLike -> ShowS
$cshowsPrec :: Int -> CoordLike -> ShowS
Show)

coordLikeP :: Parser [CoordLike]
coordLikeP :: Parser [CoordLike]
coordLikeP = Parser CoordLike -> Parser [CoordLike]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Parser CoordLike
coordNotAtomP Parser CoordLike -> Parser CoordLike -> Parser CoordLike
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser CoordLike
atomP)

chainsP :: Parser (V.Vector Chain)
chainsP :: Parser Model
chainsP = do
    [CoordLike]
coordLikeLines <- Parser [CoordLike]
coordLikeP
    let atoms :: [Atom]
atoms  = [Maybe Atom] -> [Atom]
forall a. [Maybe a] -> [a]
catMaybes (CoordLike -> Maybe Atom
getAtom (CoordLike -> Maybe Atom) -> [CoordLike] -> [Maybe Atom]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CoordLike]
coordLikeLines)
        chains :: Model
chains = [Vector Atom] -> Model
forall a. [a] -> Vector a
V.fromList (([Atom] -> Vector Atom) -> [[Atom]] -> [Vector Atom]
forall a b. (a -> b) -> [a] -> [b]
map [Atom] -> Vector Atom
forall a. [a] -> Vector a
V.fromList ([[Atom]] -> [Vector Atom]) -> [[Atom]] -> [Vector Atom]
forall a b. (a -> b) -> a -> b
$ [Atom] -> [[Atom]]
groupByChains [Atom]
atoms)
    Model -> Parser Model
forall (f :: * -> *) a. Applicative f => a -> f a
pure Model
chains
  where
    getAtom :: CoordLike -> Maybe Atom
    getAtom :: CoordLike -> Maybe Atom
getAtom CoordLike
line = case CoordLike
line of
      AtomLine Atom
x -> Atom -> Maybe Atom
forall a. a -> Maybe a
Just Atom
x
      CoordLike
_          -> Maybe Atom
forall a. Maybe a
Nothing
    groupByChains :: [Atom]-> [[Atom]]
    groupByChains :: [Atom] -> [[Atom]]
groupByChains = (Atom -> Atom -> Bool) -> [Atom] -> [[Atom]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Char -> Char -> Bool) -> (Atom -> Char) -> Atom -> Atom -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Atom -> Char
atomChainID)

modelP :: Parser Model
modelP :: Parser Model
modelP = do
    Text
_ <- Text -> Parser Text
string Text
"MODEL"
    (Char -> Bool) -> Parser Text ()
skipWhile ((Char -> Bool) -> Parser Text ())
-> (Char -> Bool) -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isEndOfLine
    Parser Text ()
endOfLine
    Model
chains <- Parser Model
chainsP
    Text -> Parser Text
string Text
"ENDMDL" Parser Text -> Parser Text () -> Parser Text ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Parser Text ()
skipWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isEndOfLine)
    Parser Text ()
endOfLine Parser Text () -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput
    Model -> Parser Model
forall (f :: * -> *) a. Applicative f => a -> f a
pure Model
chains

manyModelsP :: Parser PdbData
manyModelsP :: Parser Text PdbData
manyModelsP = do
    [Model]
models <- (Model -> [Model] -> [Model]
forall a. a -> [a] -> [a]
:[]) (Model -> [Model]) -> Parser Model -> Parser Text [Model]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Model
chainsP Parser Text [Model] -> Parser Text [Model] -> Parser Text [Model]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Model -> Parser Text [Model]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Model
modelP
    PdbData -> Parser Text PdbData
forall (m :: * -> *) a. Monad m => a -> m a
return (PdbData -> Parser Text PdbData) -> PdbData -> Parser Text PdbData
forall a b. (a -> b) -> a -> b
$ Vector Model -> PdbData
ModelData ([Model] -> Vector Model
forall a. [a] -> Vector a
V.fromList [Model]
models)

titleStringP :: Parser Text
titleStringP :: Parser Text
titleStringP = do
    Text
_ <- Text -> Parser Text
string Text
"TITLE "
    Text
titleText <- Parser Text
takeText
    Parser Text ()
endOfLine
    Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripEnd Text
titleText

titleP :: Parser PdbData
titleP :: Parser Text PdbData
titleP =  do
    Text
titleText <- [Text] -> Text
T.concat ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser Text [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Text
titleStringP
    PdbData -> Parser Text PdbData
forall (m :: * -> *) a. Monad m => a -> m a
return (PdbData -> Parser Text PdbData) -> PdbData -> Parser Text PdbData
forall a b. (a -> b) -> a -> b
$ Text -> PdbData
TitleData Text
titleText

remarkStringP :: Parser PdbData
remarkStringP :: Parser Text PdbData
remarkStringP = do
    Text
_ <- Text -> Parser Text
string Text
"REMARK"
    Char
_ <- Parser Char
space
    (RemarkCode
remarkCode :: RemarkCode) <- String -> RemarkCode
forall a. Read a => String -> Maybe a
readMaybe (String -> RemarkCode)
-> Parser Text String -> Parser Text RemarkCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
3 Parser Char
notEndLineChar
    Char
_ <- Parser Char
notEndLineChar
    Text
remarkText <- Parser Text
takeText
    Parser Text ()
endOfLine
    PdbData -> Parser Text PdbData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PdbData -> Parser Text PdbData) -> PdbData -> Parser Text PdbData
forall a b. (a -> b) -> a -> b
$ (RemarkCode, Text) -> PdbData
RemarkData (RemarkCode
remarkCode, Text -> Text
T.stripEnd Text
remarkText)

fromRevListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a
fromRevListWith :: (a -> a -> a) -> [(k, a)] -> Map k a
fromRevListWith a -> a -> a
f [(k, a)]
xs = (k -> a -> a -> a) -> [(k, a)] -> Map k a
forall k a. Ord k => (k -> a -> a -> a) -> [(k, a)] -> Map k a
fromListWithKey (\k
_ a
x a
y -> a -> a -> a
f a
y a
x) [(k, a)]
xs

otherFieldP :: Parser PdbData
otherFieldP :: Parser Text PdbData
otherFieldP = do
    (Maybe FieldType
fieldType :: Maybe FieldType) <- String -> Maybe FieldType
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe FieldType)
-> Parser Text String -> Parser Text (Maybe FieldType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
6 Parser Char
notEndLineChar
    Text
fieldTypeText <- Parser Text
takeText
    Parser Text ()
endOfLine Parser Text () -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput
    PdbData -> Parser Text PdbData
forall (m :: * -> *) a. Monad m => a -> m a
return (PdbData -> Parser Text PdbData) -> PdbData -> Parser Text PdbData
forall a b. (a -> b) -> a -> b
$ (Maybe FieldType, Text) -> PdbData
OtherFieldData (Maybe FieldType
fieldType, Text -> Text
T.stripEnd Text
fieldTypeText)