module Bio.PDB.Reader
  ( fromTextPDB
  , fromFilePDB
  , PDBWarnings(..)
  ) where

import           Bio.PDB.Parser         (pdbP)
import           Bio.PDB.Type           (PDB (..))
import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Data.Attoparsec.Text   (parseOnly)
import           Data.Bifunctor         (first)
import           Data.List              as L (findIndices, length)
import           Data.Maybe             (catMaybes)
import           Data.Text              as T (Text, length, lines, pack,
                                              replicate, take, unlines)
import qualified Data.Text.IO           as TIO (readFile)


type LineNumber = Int

data PDBWarnings = LineTooLong LineNumber
                 | LineTooShort LineNumber
  deriving (Int -> PDBWarnings -> ShowS
[PDBWarnings] -> ShowS
PDBWarnings -> String
(Int -> PDBWarnings -> ShowS)
-> (PDBWarnings -> String)
-> ([PDBWarnings] -> ShowS)
-> Show PDBWarnings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PDBWarnings] -> ShowS
$cshowList :: [PDBWarnings] -> ShowS
show :: PDBWarnings -> String
$cshow :: PDBWarnings -> String
showsPrec :: Int -> PDBWarnings -> ShowS
$cshowsPrec :: Int -> PDBWarnings -> ShowS
Show, PDBWarnings -> PDBWarnings -> Bool
(PDBWarnings -> PDBWarnings -> Bool)
-> (PDBWarnings -> PDBWarnings -> Bool) -> Eq PDBWarnings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDBWarnings -> PDBWarnings -> Bool
$c/= :: PDBWarnings -> PDBWarnings -> Bool
== :: PDBWarnings -> PDBWarnings -> Bool
$c== :: PDBWarnings -> PDBWarnings -> Bool
Eq)

standardizeText :: Text -> ([PDBWarnings], Text)
standardizeText :: Text -> ([PDBWarnings], Text)
standardizeText Text
text = ([PDBWarnings]
textWarnings, [Text] -> Text
T.unlines [Text]
standardizedLines)
  where
    textLines :: [Text]
textLines = Text -> [Text]
T.lines Text
text
    desiredLength :: Int
desiredLength = Int
80  -- cause it is max length in standart pdb file

    warnings'n'text :: [(Maybe PDBWarnings, Text)]
warnings'n'text = ((Int, Text) -> (Maybe PDBWarnings, Text))
-> [(Int, Text)] -> [(Maybe PDBWarnings, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Text) -> (Maybe PDBWarnings, Text)
standardizeLine ([(Int, Text)] -> [(Maybe PDBWarnings, Text)])
-> [(Int, Text)] -> [(Maybe PDBWarnings, Text)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Text]
textLines
    textWarnings :: [PDBWarnings]
textWarnings = [Maybe PDBWarnings] -> [PDBWarnings]
forall a. [Maybe a] -> [a]
catMaybes ((Maybe PDBWarnings, Text) -> Maybe PDBWarnings
forall a b. (a, b) -> a
fst ((Maybe PDBWarnings, Text) -> Maybe PDBWarnings)
-> [(Maybe PDBWarnings, Text)] -> [Maybe PDBWarnings]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe PDBWarnings, Text)]
warnings'n'text)
    standardizedLines :: [Text]
standardizedLines = (Maybe PDBWarnings, Text) -> Text
forall a b. (a, b) -> b
snd ((Maybe PDBWarnings, Text) -> Text)
-> [(Maybe PDBWarnings, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe PDBWarnings, Text)]
warnings'n'text

    standardizeLine :: (Int, Text) -> (Maybe PDBWarnings, Text)
    standardizeLine :: (Int, Text) -> (Maybe PDBWarnings, Text)
standardizeLine (Int
lineNumber,Text
line) | Int
lineLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
desiredLength = (PDBWarnings -> Maybe PDBWarnings
forall a. a -> Maybe a
Just (Int -> PDBWarnings
LineTooShort Int
lineNumber), Text
line Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
spacesCount Text
" ")
                                      | Int
lineLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
desiredLength = (PDBWarnings -> Maybe PDBWarnings
forall a. a -> Maybe a
Just (Int -> PDBWarnings
LineTooLong Int
lineNumber), Int -> Text -> Text
T.take Int
desiredLength Text
line)
                                      | Bool
otherwise = (Maybe PDBWarnings
forall a. Maybe a
Nothing, Text
line)
      where
        lineLength :: Int
lineLength = Text -> Int
T.length Text
line
        spacesCount :: Int
spacesCount = Int
desiredLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lineLength


isMdlLine :: Text -> Bool
isMdlLine :: Text -> Bool
isMdlLine Text
line = Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Int -> Text -> Text
T.take Int
6 Text
line) [Text]
modelStrings Bool -> Bool -> Bool
|| Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Int -> Text -> Text
T.take Int
5 Text
line) [Text]
modelStrings
  where
    modelStrings :: [Text]
modelStrings = [Text
"MODEL ", Text
"ENDMDL", Text
"ATOM ", Text
"TER   ", Text
"HETATM", Text
"ANISOU", Text
"CONECT"]

checkRow :: [Int] -> Bool
checkRow :: [Int] -> Bool
checkRow [] = Bool
True
checkRow [Int]
xs = [Int] -> Int
forall a. [a] -> a
last [Int]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Int] -> Int
forall a. [a] -> a
head [Int]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Int]
xs

checkMdlLines :: ([PDBWarnings], Text) -> Bool
checkMdlLines :: ([PDBWarnings], Text) -> Bool
checkMdlLines ([PDBWarnings], Text)
warnings'n'text = [Int] -> Bool
checkRow [Int]
mdlLineNumbers
  where
    mdlLineNumbers :: [Int]
mdlLineNumbers = (Text -> Bool) -> [Text] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices Text -> Bool
isMdlLine ([Text] -> [Int]) -> [Text] -> [Int]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines (([PDBWarnings], Text) -> Text
forall a b. (a, b) -> b
snd ([PDBWarnings], Text)
warnings'n'text)

preprocess :: Text -> Either Text ([PDBWarnings], Text)
preprocess :: Text -> Either Text ([PDBWarnings], Text)
preprocess Text
text = do
  let standardizedText :: ([PDBWarnings], Text)
standardizedText = Text -> ([PDBWarnings], Text)
standardizeText Text
text
  if ([PDBWarnings], Text) -> Bool
checkMdlLines ([PDBWarnings], Text)
standardizedText
  then ([PDBWarnings], Text) -> Either Text ([PDBWarnings], Text)
forall a b. b -> Either a b
Right ([PDBWarnings], Text)
standardizedText
  else Text -> Either Text ([PDBWarnings], Text)
forall a b. a -> Either a b
Left Text
"There are trash strings between model strings"


fromFilePDB :: MonadIO m => FilePath -> m (Either Text ([PDBWarnings], PDB))
fromFilePDB :: String -> m (Either Text ([PDBWarnings], PDB))
fromFilePDB = IO (Either Text ([PDBWarnings], PDB))
-> m (Either Text ([PDBWarnings], PDB))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Text ([PDBWarnings], PDB))
 -> m (Either Text ([PDBWarnings], PDB)))
-> (String -> IO (Either Text ([PDBWarnings], PDB)))
-> String
-> m (Either Text ([PDBWarnings], PDB))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either Text ([PDBWarnings], PDB))
-> IO Text -> IO (Either Text ([PDBWarnings], PDB))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Either Text ([PDBWarnings], PDB)
fromTextPDB (IO Text -> IO (Either Text ([PDBWarnings], PDB)))
-> (String -> IO Text)
-> String
-> IO (Either Text ([PDBWarnings], PDB))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Text
TIO.readFile

fromTextPDB :: Text -> Either Text ([PDBWarnings], PDB)
fromTextPDB :: Text -> Either Text ([PDBWarnings], PDB)
fromTextPDB Text
text = do
  ([PDBWarnings]
warnings, Text
preprocessedText) <- Text -> Either Text ([PDBWarnings], Text)
preprocess Text
text
  PDB
pdb <- (String -> Text) -> Either String PDB -> Either Text PDB
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
pack (Either String PDB -> Either Text PDB)
-> Either String PDB -> Either Text PDB
forall a b. (a -> b) -> a -> b
$ Parser PDB -> Text -> Either String PDB
forall a. Parser a -> Text -> Either String a
parseOnly Parser PDB
pdbP Text
preprocessedText

  ([PDBWarnings], PDB) -> Either Text ([PDBWarnings], PDB)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PDBWarnings]
warnings, PDB
pdb)