{-# LANGUAGE AllowAmbiguousTypes  #-}
{-# LANGUAGE CPP                  #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Bio.MAE
  ( Block (..), FromMaeValue (..)
  , Mae (..), MaeValue (..)
  , Table (..)
  , fromFile
  , fromText
  , modelsFromMaeText
  , modelsFromMaeFile
  , maeP
  ) where

import           Bio.MAE.Parser
import           Bio.MAE.Type           (Block (..), FromMaeValue (..),
                                         Mae (..), MaeValue (..), Table (..))
import           Bio.Structure          (Atom (..), Bond (..), Chain (..), Model (..),
                                         GlobalID (..), LocalID (..),
                                         Model (..), Residue (..),
                                         SecondaryStructure (..),
                                         StructureModels (..))
import qualified Bio.Utils.Map          as M ((!?!))
import           Control.Monad          (join)
import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Data.Attoparsec.Text   (parseOnly)
import           Data.Bifunctor         (bimap, first)
import           Data.Function          (on)
import qualified Data.List              as L (find, groupBy, sortOn)
import           Data.Map.Strict        (Map)
import qualified Data.Map.Strict        as M (fromList, lookup)
import           Data.Maybe             (catMaybes, fromJust)
import           Data.Text              (Text)
import qualified Data.Text              as T (head, init, last, null, pack,
                                              strip, tail)
import qualified Data.Text.IO           as TIO (readFile)
import           Data.Vector            (Vector)
import qualified Data.Vector            as V (fromList)
import           Linear.V3              (V3 (..))
#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail     (MonadFail (..))
import           Prelude                hiding (fail)
#endif

-- | Reads 'Mae' from givem file.
--
fromFile :: (MonadFail m, MonadIO m) => FilePath -> m Mae
fromFile :: FilePath -> m Mae
fromFile FilePath
f = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
TIO.readFile FilePath
f) m Text -> (Text -> m Mae) -> m Mae
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> m Mae)
-> (Mae -> m Mae) -> Either FilePath Mae -> m Mae
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> m Mae
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail Mae -> m Mae
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Mae -> m Mae)
-> (Text -> Either FilePath Mae) -> Text -> m Mae
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Mae -> Text -> Either FilePath Mae
forall a. Parser a -> Text -> Either FilePath a
parseOnly Parser Mae
maeP

-- | Reads 'Mae' from 'Text'.
--
fromText :: Text -> Either Text Mae
fromText :: Text -> Either Text Mae
fromText = (FilePath -> Text) -> Either FilePath Mae -> Either Text Mae
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first FilePath -> Text
T.pack (Either FilePath Mae -> Either Text Mae)
-> (Text -> Either FilePath Mae) -> Text -> Either Text Mae
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Mae -> Text -> Either FilePath Mae
forall a. Parser a -> Text -> Either FilePath a
parseOnly Parser Mae
maeP

modelsFromMaeFile :: (MonadIO m) => FilePath -> m (Either Text (Vector Model))
modelsFromMaeFile :: FilePath -> m (Either Text (Vector Model))
modelsFromMaeFile = IO (Either Text (Vector Model)) -> m (Either Text (Vector Model))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Text (Vector Model)) -> m (Either Text (Vector Model)))
-> (FilePath -> IO (Either Text (Vector Model)))
-> FilePath
-> m (Either Text (Vector Model))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either Text (Vector Model))
-> IO Text -> IO (Either Text (Vector Model))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Either Text (Vector Model)
modelsFromMaeText (IO Text -> IO (Either Text (Vector Model)))
-> (FilePath -> IO Text)
-> FilePath
-> IO (Either Text (Vector Model))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Text
TIO.readFile

modelsFromMaeText :: Text -> Either Text (Vector Model)
modelsFromMaeText :: Text -> Either Text (Vector Model)
modelsFromMaeText Text
maeText = Mae -> Vector Model
forall a. StructureModels a => a -> Vector Model
modelsOf (Mae -> Vector Model)
-> Either Text Mae -> Either Text (Vector Model)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text Mae
fromText Text
maeText

instance StructureModels Mae where
  modelsOf :: Mae -> Vector Model
modelsOf Mae{[Block]
Text
blocks :: Mae -> [Block]
version :: Mae -> Text
blocks :: [Block]
version :: Text
..} = [Model] -> Vector Model
forall a. [a] -> Vector a
V.fromList ([Model] -> Vector Model) -> [Model] -> Vector Model
forall a b. (a -> b) -> a -> b
$ (Block -> Model) -> [Block] -> [Model]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block -> Model
blockToModel [Block]
blocks
    where
      unsafeGetFromContentsMap :: FromMaeValue a => Map Text [MaeValue] -> Text -> Int -> a
      unsafeGetFromContentsMap :: Map Text [MaeValue] -> Text -> Int -> a
unsafeGetFromContentsMap Map Text [MaeValue]
m Text
name Int
i = MaeValue -> a
forall a. FromMaeValue a => MaeValue -> a
unsafeFromMaeValue (MaeValue -> a) -> MaeValue -> a
forall a b. (a -> b) -> a -> b
$ (Map Text [MaeValue]
m Map Text [MaeValue] -> Text -> [MaeValue]
forall k a.
(HasCallStack, Ord k, Show k, Show a) =>
Map k a -> k -> a
M.!?! Text
name) [MaeValue] -> Int -> MaeValue
forall a. [a] -> Int -> a
!! Int
i

      getFromContentsMap :: FromMaeValue a => Map Text [MaeValue] -> Text -> Int -> Maybe a
      getFromContentsMap :: Map Text [MaeValue] -> Text -> Int -> Maybe a
getFromContentsMap Map Text [MaeValue]
m Text
name Int
i = Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe a) -> Maybe a) -> Maybe (Maybe a) -> Maybe a
forall a b. (a -> b) -> a -> b
$ MaeValue -> Maybe a
forall a. FromMaeValue a => MaeValue -> Maybe a
fromMaeValue (MaeValue -> Maybe a)
-> ([MaeValue] -> MaeValue) -> [MaeValue] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([MaeValue] -> Int -> MaeValue
forall a. [a] -> Int -> a
!! Int
i) ([MaeValue] -> Maybe a) -> Maybe [MaeValue] -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
name Text -> Map Text [MaeValue] -> Maybe [MaeValue]
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Text [MaeValue]
m

      blockToModel :: Block -> Model
      blockToModel :: Block -> Model
blockToModel Block{[Table]
Text
Map Text MaeValue
tables :: Block -> [Table]
fields :: Block -> Map Text MaeValue
blockName :: Block -> Text
tables :: [Table]
fields :: Map Text MaeValue
blockName :: Text
..} = Vector Chain -> Vector (Bond GlobalID) -> Model
Model (Map Text [MaeValue] -> Vector Chain
atomsTableToChains Map Text [MaeValue]
atomsTable) Vector (Bond GlobalID)
bonds
        where
          atomsTable :: Map Text [MaeValue]
atomsTable    = Text -> Map Text [MaeValue]
findTable Text
"m_atom"
          numberOfAtoms :: Int
numberOfAtoms = [MaeValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([MaeValue] -> Int) -> [MaeValue] -> Int
forall a b. (a -> b) -> a -> b
$ Map Text [MaeValue]
atomsTable Map Text [MaeValue] -> Text -> [MaeValue]
forall k a.
(HasCallStack, Ord k, Show k, Show a) =>
Map k a -> k -> a
M.!?! Text
"r_m_x_coord"

          bondsTable :: Map Text [MaeValue]
bondsTable         = Text -> Map Text [MaeValue]
findTable Text
"m_bond"
          (Map Int [(Int, Int)]
bondGraph, Vector (Bond GlobalID)
bonds) = Map Text [MaeValue]
-> (Map Int [(Int, Int)], Vector (Bond GlobalID))
bondsTableToGlobalBonds Map Text [MaeValue]
bondsTable

          findTable :: Text -> Map Text [MaeValue]
          findTable :: Text -> Map Text [MaeValue]
findTable Text
name = Table -> Map Text [MaeValue]
contents (Table -> Map Text [MaeValue]) -> Table -> Map Text [MaeValue]
forall a b. (a -> b) -> a -> b
$ Maybe Table -> Table
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Table -> Table) -> Maybe Table -> Table
forall a b. (a -> b) -> a -> b
$ (Table -> Bool) -> [Table] -> Maybe Table
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) (Text -> Bool) -> (Table -> Text) -> Table -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table -> Text
tableName) [Table]
tables

          stripQuotes :: Text -> Text
          stripQuotes :: Text -> Text
stripQuotes Text
t | Bool -> Bool
not (Text -> Bool
T.null Text
t) Bool -> Bool -> Bool
&& Text -> Char
T.head Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Char
T.last Text
t, Text -> Char
T.last Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\"' = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.init (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.tail Text
t
                        | Bool
otherwise                                                = Text -> Text
T.strip Text
t

          toGroupsOn :: (Eq b, Ord b) => (a -> b) -> [a] -> [[a]]
          toGroupsOn :: (a -> b) -> [a] -> [[a]]
toGroupsOn a -> b
f = (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) (b -> b -> Bool) -> (a -> b) -> a -> a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f) ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn a -> b
f

          bondsTableToGlobalBonds :: Map Text [MaeValue] -> (Map Int [(Int, Int)], Vector (Bond GlobalID))
          bondsTableToGlobalBonds :: Map Text [MaeValue]
-> (Map Int [(Int, Int)], Vector (Bond GlobalID))
bondsTableToGlobalBonds Map Text [MaeValue]
m = ([(Int, (Int, Int))] -> Map Int [(Int, Int)])
-> ([Bond GlobalID] -> Vector (Bond GlobalID))
-> ([(Int, (Int, Int))], [Bond GlobalID])
-> (Map Int [(Int, Int)], Vector (Bond GlobalID))
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [(Int, (Int, Int))] -> Map Int [(Int, Int)]
toMap [Bond GlobalID] -> Vector (Bond GlobalID)
forall a. [a] -> Vector a
V.fromList ([(Int, (Int, Int))], [Bond GlobalID])
bonds'
            where
              numberOfBonds :: Int
numberOfBonds = [MaeValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([MaeValue] -> Int) -> [MaeValue] -> Int
forall a b. (a -> b) -> a -> b
$ Map Text [MaeValue]
m Map Text [MaeValue] -> Text -> [MaeValue]
forall k a.
(HasCallStack, Ord k, Show k, Show a) =>
Map k a -> k -> a
M.!?! Text
"i_m_from"
              bonds' :: ([(Int, (Int, Int))], [Bond GlobalID])
bonds'        = [((Int, (Int, Int)), Bond GlobalID)]
-> ([(Int, (Int, Int))], [Bond GlobalID])
forall a b. [(a, b)] -> ([a], [b])
unzip ([((Int, (Int, Int)), Bond GlobalID)]
 -> ([(Int, (Int, Int))], [Bond GlobalID]))
-> [((Int, (Int, Int)), Bond GlobalID)]
-> ([(Int, (Int, Int))], [Bond GlobalID])
forall a b. (a -> b) -> a -> b
$ (Int -> ((Int, (Int, Int)), Bond GlobalID))
-> [Int] -> [((Int, (Int, Int)), Bond GlobalID)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> ((Int, (Int, Int)), Bond GlobalID)
indexToBond [Int
0 .. Int
numberOfBonds Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

              toMap :: [(Int, (Int, Int))] -> Map Int [(Int, Int)]
              toMap :: [(Int, (Int, Int))] -> Map Int [(Int, Int)]
toMap = [(Int, [(Int, Int)])] -> Map Int [(Int, Int)]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, [(Int, Int)])] -> Map Int [(Int, Int)])
-> ([(Int, (Int, Int))] -> [(Int, [(Int, Int)])])
-> [(Int, (Int, Int))]
-> Map Int [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, (Int, Int))] -> (Int, [(Int, Int)]))
-> [[(Int, (Int, Int))]] -> [(Int, [(Int, Int)])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\l :: [(Int, (Int, Int))]
l@((Int
k, (Int, Int)
_) : [(Int, (Int, Int))]
_) -> (Int
k, ((Int, (Int, Int)) -> (Int, Int))
-> [(Int, (Int, Int))] -> [(Int, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, (Int, Int)) -> (Int, Int)
forall a b. (a, b) -> b
snd [(Int, (Int, Int))]
l)) ([[(Int, (Int, Int))]] -> [(Int, [(Int, Int)])])
-> ([(Int, (Int, Int))] -> [[(Int, (Int, Int))]])
-> [(Int, (Int, Int))]
-> [(Int, [(Int, Int)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, (Int, Int)) -> Int)
-> [(Int, (Int, Int))] -> [[(Int, (Int, Int))]]
forall b a. (Eq b, Ord b) => (a -> b) -> [a] -> [[a]]
toGroupsOn (Int, (Int, Int)) -> Int
forall a b. (a, b) -> a
fst

              indexToBond :: Int -> ((Int, (Int, Int)), Bond GlobalID)
              indexToBond :: Int -> ((Int, (Int, Int)), Bond GlobalID)
indexToBond Int
i = ((Int
x, (Int
y, Int
o)), GlobalID -> GlobalID -> Int -> Bond GlobalID
forall m. m -> m -> Int -> Bond m
Bond (Int -> GlobalID
GlobalID Int
x) (Int -> GlobalID
GlobalID Int
y) Int
o)
                where
                  x :: Int
x = Text -> Int
forall a. FromMaeValue a => Text -> a
getFromContentsI Text
"i_m_from" Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                  y :: Int
y = Text -> Int
forall a. FromMaeValue a => Text -> a
getFromContentsI Text
"i_m_to" Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                  o :: Int
o = Text -> Int
forall a. FromMaeValue a => Text -> a
getFromContentsI Text
"i_m_order"

                  getFromContentsI :: FromMaeValue a => Text -> a
                  getFromContentsI :: Text -> a
getFromContentsI = (Text -> Int -> a) -> Int -> Text -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Map Text [MaeValue] -> Text -> Int -> a
forall a. FromMaeValue a => Map Text [MaeValue] -> Text -> Int -> a
unsafeGetFromContentsMap Map Text [MaeValue]
m) Int
i

          atomsTableToChains :: Map Text [MaeValue] -> Vector Chain
          atomsTableToChains :: Map Text [MaeValue] -> Vector Chain
atomsTableToChains Map Text [MaeValue]
m = [Chain] -> Vector Chain
forall a. [a] -> Vector a
V.fromList ([Chain] -> Vector Chain) -> [Chain] -> Vector Chain
forall a b. (a -> b) -> a -> b
$ ([Int] -> Chain) -> [[Int]] -> [Chain]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int] -> Chain
groupToChain [[Int]]
groupedByChains
            where
              groupedByChains :: [[Int]]
groupedByChains = (Int -> Text) -> [Int] -> [[Int]]
forall b a. (Eq b, Ord b) => (a -> b) -> [a] -> [[a]]
toGroupsOn (Text -> Text -> Int -> Text
forall a. FromMaeValue a => a -> Text -> Int -> a
getFromContents Text
defaultChainName Text
"s_m_chain_name") [Int
0 .. Int
numberOfAtoms Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

              getFromContents :: FromMaeValue a => a -> Text -> Int -> a
              getFromContents :: a -> Text -> Int -> a
getFromContents a
def Text
name Int
ind = a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
def a -> a
forall a. a -> a
id (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ Map Text [MaeValue] -> Text -> Int -> Maybe a
forall a.
FromMaeValue a =>
Map Text [MaeValue] -> Text -> Int -> Maybe a
getFromContentsMap Map Text [MaeValue]
m Text
name Int
ind

              unsafeGetFromContents :: FromMaeValue a => Text -> Int -> a
              unsafeGetFromContents :: Text -> Int -> a
unsafeGetFromContents = Map Text [MaeValue] -> Text -> Int -> a
forall a. FromMaeValue a => Map Text [MaeValue] -> Text -> Int -> a
unsafeGetFromContentsMap Map Text [MaeValue]
m

              groupToChain :: [Int] -> Chain
              groupToChain :: [Int] -> Chain
groupToChain []            = FilePath -> Chain
forall a. HasCallStack => FilePath -> a
error FilePath
"Group that is result of List.groupBy can't be empty."
              groupToChain group :: [Int]
group@(Int
h : [Int]
_) = Text -> Vector Residue -> Chain
Chain Text
name Vector Residue
residues
                where
                  name :: Text
name = Text -> Text
stripQuotes (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Int -> Text
forall a. FromMaeValue a => a -> Text -> Int -> a
getFromContents Text
defaultChainName Text
"s_m_chain_name" Int
h

                  groupedByResidues :: [[Int]]
groupedByResidues = (Int -> (Int, Char)) -> [Int] -> [[Int]]
forall b a. (Eq b, Ord b) => (a -> b) -> [a] -> [[a]]
toGroupsOn Int -> (Int, Char)
by [Int]
group
                  residues :: Vector Residue
residues          = [Residue] -> Vector Residue
forall a. [a] -> Vector a
V.fromList ([Residue] -> Vector Residue) -> [Residue] -> Vector Residue
forall a b. (a -> b) -> a -> b
$ ([Int] -> Residue) -> [[Int]] -> [Residue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int] -> Residue
groupToResidue [[Int]]
groupedByResidues

                  by :: Int -> (Int, Char)
                  by :: Int -> (Int, Char)
by Int
i = (Text -> Int -> Int
forall a. FromMaeValue a => Text -> Int -> a
unsafeGetFromContents Text
"i_m_residue_number" Int
i, Char -> Text -> Int -> Char
forall a. FromMaeValue a => a -> Text -> Int -> a
getFromContents Char
defaultInsertionCode Text
"s_m_insertion_code" Int
i)

              defaultChainName :: Text
              defaultChainName :: Text
defaultChainName = Text
"A"

              defaultInsertionCode :: Char
              defaultInsertionCode :: Char
defaultInsertionCode = Char
' '

              groupToResidue :: [Int] -> Residue
              groupToResidue :: [Int] -> Residue
groupToResidue []            = FilePath -> Residue
forall a. HasCallStack => FilePath -> a
error FilePath
"Group that is result of List.groupBy can't be empty."
              groupToResidue group :: [Int]
group@(Int
h : [Int]
_) = Text
-> Int
-> Char
-> Vector Atom
-> Vector (Bond LocalID)
-> SecondaryStructure
-> Text
-> Residue
Residue Text
name Int
residueNumber Char
insertionCode Vector Atom
atoms ([Bond LocalID] -> Vector (Bond LocalID)
forall a. [a] -> Vector a
V.fromList [Bond LocalID]
localBonds) SecondaryStructure
secondary Text
chemCompType
                where
                  name :: Text
name          = Text -> Text
stripQuotes (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Text
forall a. FromMaeValue a => Text -> Int -> a
unsafeGetFromContents Text
"s_m_pdb_residue_name" Int
h
                  residueNumber :: Int
residueNumber = Text -> Int -> Int
forall a. FromMaeValue a => Text -> Int -> a
unsafeGetFromContents Text
"i_m_residue_number" Int
h
                  insertionCode :: Char
insertionCode = Char -> Text -> Int -> Char
forall a. FromMaeValue a => a -> Text -> Int -> a
getFromContents Char
defaultInsertionCode Text
"s_m_insertion_code" Int
h
                  atoms :: Vector Atom
atoms         = [Atom] -> Vector Atom
forall a. [a] -> Vector a
V.fromList ([Atom] -> Vector Atom) -> [Atom] -> Vector Atom
forall a b. (a -> b) -> a -> b
$ (Int -> Atom) -> [Int] -> [Atom]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Atom
indexToAtom [Int]
group

                  localInds :: [Int]
localInds     = [Int
0 .. [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
group Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                  globalToLocal :: Map Int Int
globalToLocal = [(Int, Int)] -> Map Int Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, Int)] -> Map Int Int) -> [(Int, Int)] -> Map Int Int
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
group [Int]
localInds
                  bondsParts :: [Maybe [(Int, Int)]]
bondsParts    = (Int -> Maybe [(Int, Int)]) -> [Int] -> [Maybe [(Int, Int)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Map Int [(Int, Int)] -> Maybe [(Int, Int)]
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Int [(Int, Int)]
bondGraph) [Int]
group
                  localBonds :: [Bond LocalID]
localBonds    = [[Bond LocalID]] -> [Bond LocalID]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Bond LocalID]] -> [Bond LocalID])
-> [[Bond LocalID]] -> [Bond LocalID]
forall a b. (a -> b) -> a -> b
$ [Maybe [Bond LocalID]] -> [[Bond LocalID]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Bond LocalID]] -> [[Bond LocalID]])
-> [Maybe [Bond LocalID]] -> [[Bond LocalID]]
forall a b. (a -> b) -> a -> b
$ (Maybe [(Int, Int)] -> Int -> Maybe [Bond LocalID])
-> [Maybe [(Int, Int)]] -> [Int] -> [Maybe [Bond LocalID]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Maybe [(Int, Int)]
l Int
x -> ([(Int, Int)] -> [Bond LocalID])
-> Maybe [(Int, Int)] -> Maybe [Bond LocalID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, Int) -> [Bond LocalID]) -> [(Int, Int)] -> [Bond LocalID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> (Int, Int) -> [Bond LocalID]
toLocalBond Int
x)) Maybe [(Int, Int)]
l) [Maybe [(Int, Int)]]
bondsParts [Int]
localInds

                  toLocalBond :: Int -> (Int, Int) -> [Bond LocalID]
                  toLocalBond :: Int -> (Int, Int) -> [Bond LocalID]
toLocalBond Int
x (Int
y, Int
o) | Int
y Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
group = Bond LocalID -> [Bond LocalID]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bond LocalID -> [Bond LocalID]) -> Bond LocalID -> [Bond LocalID]
forall a b. (a -> b) -> a -> b
$ LocalID -> LocalID -> Int -> Bond LocalID
forall m. m -> m -> Int -> Bond m
Bond (Int -> LocalID
LocalID Int
x)
                                                                      (Int -> LocalID
LocalID (Int -> LocalID) -> Int -> LocalID
forall a b. (a -> b) -> a -> b
$ Map Int Int
globalToLocal Map Int Int -> Int -> Int
forall k a.
(HasCallStack, Ord k, Show k, Show a) =>
Map k a -> k -> a
M.!?! Int
y)
                                                                      Int
o
                                       | Bool
otherwise          = []

                  secondary :: SecondaryStructure
secondary    = SecondaryStructure
Undefined
                  chemCompType :: Text
chemCompType = Text
forall a. Monoid a => a
mempty

              indexToAtom :: Int -> Atom
              indexToAtom :: Int -> Atom
indexToAtom Int
i = GlobalID
-> Int -> Text -> Text -> V3 Float -> Int -> Float -> Float -> Atom
Atom (Int -> GlobalID
GlobalID Int
i)
                                   (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                                   (Text -> Text
stripQuotes (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
forall a. FromMaeValue a => Text -> a
getFromContentsI Text
"s_m_pdb_atom_name")
                                   (Map Int Text
elIndToElement Map Int Text -> Int -> Text
forall k a.
(HasCallStack, Ord k, Show k, Show a) =>
Map k a -> k -> a
M.!?! Text -> Int
forall a. FromMaeValue a => Text -> a
getFromContentsI Text
"i_m_atomic_number")
                                   V3 Float
coords
                                   (Int -> Text -> Int -> Int
forall a. FromMaeValue a => a -> Text -> Int -> a
getFromContents Int
0 Text
"i_m_formal_charge" Int
i)
                                   (Float -> Text -> Int -> Float
forall a. FromMaeValue a => a -> Text -> Int -> a
getFromContents Float
0 Text
"r_m_pdb_tfactor" Int
i)
                                   (Float -> Text -> Int -> Float
forall a. FromMaeValue a => a -> Text -> Int -> a
getFromContents Float
0 Text
"r_m_pdb_occupancy" Int
i)
                where
                  getFromContentsI :: FromMaeValue a => Text -> a
                  getFromContentsI :: Text -> a
getFromContentsI = (Text -> Int -> a) -> Int -> Text -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Int -> a
forall a. FromMaeValue a => Text -> Int -> a
unsafeGetFromContents Int
i

                  coords :: V3 Float
                  coords :: V3 Float
coords = Float -> Float -> Float -> V3 Float
forall a. a -> a -> a -> V3 a
V3 (Text -> Float
forall a. FromMaeValue a => Text -> a
getFromContentsI Text
"r_m_x_coord")
                              (Text -> Float
forall a. FromMaeValue a => Text -> a
getFromContentsI Text
"r_m_y_coord")
                              (Text -> Float
forall a. FromMaeValue a => Text -> a
getFromContentsI Text
"r_m_z_coord")

elIndToElement :: Map Int Text
elIndToElement :: Map Int Text
elIndToElement = [(Int, Text)] -> Map Int Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, Text)] -> Map Int Text) -> [(Int, Text)] -> Map Int Text
forall a b. (a -> b) -> a -> b
$ [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 .. Int
118] [ Text
"H", Text
"He", Text
"Li", Text
"Be", Text
"B", Text
"C", Text
"N", Text
"O", Text
"F", Text
"Ne"
                                             , Text
"Na", Text
"Mg", Text
"Al", Text
"Si", Text
"P", Text
"S", Text
"Cl", Text
"Ar", Text
"K", Text
"Ca"
                                             , Text
"Sc", Text
"Ti", Text
"V", Text
"Cr", Text
"Mn", Text
"Fe", Text
"Co", Text
"Ni", Text
"Cu", Text
"Zn"
                                             , Text
"Ga", Text
"Ge", Text
"As", Text
"Se", Text
"Br", Text
"Kr", Text
"Rb", Text
"Sr", Text
"Y", Text
"Zr"
                                             , Text
"Nb", Text
"Mo", Text
"Tc", Text
"Ru", Text
"Rh", Text
"Pd", Text
"Ag", Text
"Cd", Text
"In", Text
"Sn"
                                             , Text
"Sb", Text
"Te", Text
"I", Text
"Xe", Text
"Cs", Text
"Ba", Text
"La", Text
"Ce", Text
"Pr", Text
"Nd"
                                             , Text
"Pm", Text
"Sm", Text
"Eu", Text
"Gd", Text
"Tb", Text
"Dy", Text
"Ho", Text
"Er", Text
"Tm", Text
"Yb"
                                             , Text
"Lu", Text
"Hf", Text
"Ta", Text
"W", Text
"Re", Text
"Os", Text
"Ir", Text
"Pt", Text
"Au", Text
"Hg"
                                             , Text
"Tl", Text
"Pb", Text
"Bi", Text
"Po", Text
"At", Text
"Rn", Text
"Fr", Text
"Ra", Text
"Ac", Text
"Th"
                                             , Text
"Pa", Text
"U", Text
"Np", Text
"Pu", Text
"Am", Text
"Cm", Text
"Bk", Text
"Cf", Text
"Es", Text
"Fm"
                                             , Text
"Md", Text
"No", Text
"Lr", Text
"Rf", Text
"Db", Text
"Sg", Text
"Bh", Text
"Hs", Text
"Mt", Text
"Ds"
                                             , Text
"Rg", Text
"Cn", Text
"Nh", Text
"Fl", Text
"Mc", Text
"Lv", Text
"Ts", Text
"Og"
                                             ]