{-# LANGUAGE DeriveAnyClass  #-}
{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE TemplateHaskell #-}

module Bio.Structure
  ( SecondaryStructure (..)
  , Atom (..), Bond (..)
  , Residue (..), Chain (..), Model (..)
  , StructureModels (..), StructureSerializable (..)
  , LocalID (..)
  , GlobalID (..)
  , atoms, localBonds
  , residues
  , chains, globalBonds
  ) where

import           Control.DeepSeq (NFData (..))
import           Control.Lens    (makeLensesFor)
import           Data.Text       (Text)
import           Data.Vector     (Vector)
import           GHC.Generics    (Generic)
import           Linear.V3       (V3)

-- | Protein secondary structure
--
data SecondaryStructure = PiHelix       -- ^ pi helix
                        | Bend          -- ^ bend
                        | AlphaHelix    -- ^ alpha helix
                        | Extended      -- ^ extended
                        | ThreeTenHelix -- ^ 3-10 helix
                        | Bridge        -- ^ brigde
                        | Turn          -- ^ turn
                        | Coil          -- ^ coil
                        | Undefined     -- ^ unknown structure
  deriving (Int -> SecondaryStructure -> ShowS
[SecondaryStructure] -> ShowS
SecondaryStructure -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecondaryStructure] -> ShowS
$cshowList :: [SecondaryStructure] -> ShowS
show :: SecondaryStructure -> String
$cshow :: SecondaryStructure -> String
showsPrec :: Int -> SecondaryStructure -> ShowS
$cshowsPrec :: Int -> SecondaryStructure -> ShowS
Show, SecondaryStructure -> SecondaryStructure -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecondaryStructure -> SecondaryStructure -> Bool
$c/= :: SecondaryStructure -> SecondaryStructure -> Bool
== :: SecondaryStructure -> SecondaryStructure -> Bool
$c== :: SecondaryStructure -> SecondaryStructure -> Bool
Eq, forall x. Rep SecondaryStructure x -> SecondaryStructure
forall x. SecondaryStructure -> Rep SecondaryStructure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SecondaryStructure x -> SecondaryStructure
$cfrom :: forall x. SecondaryStructure -> Rep SecondaryStructure x
Generic)

instance NFData SecondaryStructure

newtype GlobalID = GlobalID { GlobalID -> Int
getGlobalID :: Int }
  deriving (GlobalID -> GlobalID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalID -> GlobalID -> Bool
$c/= :: GlobalID -> GlobalID -> Bool
== :: GlobalID -> GlobalID -> Bool
$c== :: GlobalID -> GlobalID -> Bool
Eq, Int -> GlobalID -> ShowS
[GlobalID] -> ShowS
GlobalID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobalID] -> ShowS
$cshowList :: [GlobalID] -> ShowS
show :: GlobalID -> String
$cshow :: GlobalID -> String
showsPrec :: Int -> GlobalID -> ShowS
$cshowsPrec :: Int -> GlobalID -> ShowS
Show, Eq GlobalID
GlobalID -> GlobalID -> Bool
GlobalID -> GlobalID -> Ordering
GlobalID -> GlobalID -> GlobalID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GlobalID -> GlobalID -> GlobalID
$cmin :: GlobalID -> GlobalID -> GlobalID
max :: GlobalID -> GlobalID -> GlobalID
$cmax :: GlobalID -> GlobalID -> GlobalID
>= :: GlobalID -> GlobalID -> Bool
$c>= :: GlobalID -> GlobalID -> Bool
> :: GlobalID -> GlobalID -> Bool
$c> :: GlobalID -> GlobalID -> Bool
<= :: GlobalID -> GlobalID -> Bool
$c<= :: GlobalID -> GlobalID -> Bool
< :: GlobalID -> GlobalID -> Bool
$c< :: GlobalID -> GlobalID -> Bool
compare :: GlobalID -> GlobalID -> Ordering
$ccompare :: GlobalID -> GlobalID -> Ordering
Ord, forall x. Rep GlobalID x -> GlobalID
forall x. GlobalID -> Rep GlobalID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlobalID x -> GlobalID
$cfrom :: forall x. GlobalID -> Rep GlobalID x
Generic, GlobalID -> ()
forall a. (a -> ()) -> NFData a
rnf :: GlobalID -> ()
$crnf :: GlobalID -> ()
NFData)

newtype LocalID  = LocalID { LocalID -> Int
getLocalID :: Int }
  deriving (LocalID -> LocalID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalID -> LocalID -> Bool
$c/= :: LocalID -> LocalID -> Bool
== :: LocalID -> LocalID -> Bool
$c== :: LocalID -> LocalID -> Bool
Eq, Int -> LocalID -> ShowS
[LocalID] -> ShowS
LocalID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalID] -> ShowS
$cshowList :: [LocalID] -> ShowS
show :: LocalID -> String
$cshow :: LocalID -> String
showsPrec :: Int -> LocalID -> ShowS
$cshowsPrec :: Int -> LocalID -> ShowS
Show, Eq LocalID
LocalID -> LocalID -> Bool
LocalID -> LocalID -> Ordering
LocalID -> LocalID -> LocalID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LocalID -> LocalID -> LocalID
$cmin :: LocalID -> LocalID -> LocalID
max :: LocalID -> LocalID -> LocalID
$cmax :: LocalID -> LocalID -> LocalID
>= :: LocalID -> LocalID -> Bool
$c>= :: LocalID -> LocalID -> Bool
> :: LocalID -> LocalID -> Bool
$c> :: LocalID -> LocalID -> Bool
<= :: LocalID -> LocalID -> Bool
$c<= :: LocalID -> LocalID -> Bool
< :: LocalID -> LocalID -> Bool
$c< :: LocalID -> LocalID -> Bool
compare :: LocalID -> LocalID -> Ordering
$ccompare :: LocalID -> LocalID -> Ordering
Ord, forall x. Rep LocalID x -> LocalID
forall x. LocalID -> Rep LocalID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocalID x -> LocalID
$cfrom :: forall x. LocalID -> Rep LocalID x
Generic, LocalID -> ()
forall a. (a -> ()) -> NFData a
rnf :: LocalID -> ()
$crnf :: LocalID -> ()
NFData)

-- | Generic atom representation
--
data Atom = Atom { Atom -> GlobalID
atomId         :: GlobalID -- ^ global identifier, 0-based
                 , Atom -> Int
atomInputIndex :: Int      -- ^ atom index from input file
                 , Atom -> Text
atomName       :: Text     -- ^ IUPAC atom name
                 , Atom -> Text
atomElement    :: Text     -- ^ atom chemical element
                 , Atom -> V3 Float
atomCoords     :: V3 Float -- ^ 3D coordinates of atom
                 , Atom -> Int
formalCharge   :: Int      -- ^ Formal charge of atom
                 , Atom -> Float
bFactor        :: Float    -- ^ B-factor of atom
                 , Atom -> Float
occupancy      :: Float    -- ^ the amount of each conformation that is observed in the crystal
                 }
  deriving (Int -> Atom -> ShowS
[Atom] -> ShowS
Atom -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Atom] -> ShowS
$cshowList :: [Atom] -> ShowS
show :: Atom -> String
$cshow :: Atom -> String
showsPrec :: Int -> Atom -> ShowS
$cshowsPrec :: Int -> Atom -> ShowS
Show, Atom -> Atom -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Atom -> Atom -> Bool
$c/= :: Atom -> Atom -> Bool
== :: Atom -> Atom -> Bool
$c== :: Atom -> Atom -> Bool
Eq, forall x. Rep Atom x -> Atom
forall x. Atom -> Rep Atom x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Atom x -> Atom
$cfrom :: forall x. Atom -> Rep Atom x
Generic)

instance Ord Atom where
  Atom
a1 <= :: Atom -> Atom -> Bool
<= Atom
a2 = Atom -> GlobalID
atomId Atom
a1 forall a. Ord a => a -> a -> Bool
<= Atom -> GlobalID
atomId Atom
a2

instance NFData Atom

-- | Generic chemical bond
--
data Bond m = Bond { forall m. Bond m -> m
bondStart :: m    -- ^ index of first incident atom
                   , forall m. Bond m -> m
bondEnd   :: m    -- ^ index of second incident atom
                   , forall m. Bond m -> Int
bondOrder :: Int  -- ^ the order of chemical bond
                   }
  deriving (Int -> Bond m -> ShowS
forall m. Show m => Int -> Bond m -> ShowS
forall m. Show m => [Bond m] -> ShowS
forall m. Show m => Bond m -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bond m] -> ShowS
$cshowList :: forall m. Show m => [Bond m] -> ShowS
show :: Bond m -> String
$cshow :: forall m. Show m => Bond m -> String
showsPrec :: Int -> Bond m -> ShowS
$cshowsPrec :: forall m. Show m => Int -> Bond m -> ShowS
Show, Bond m -> Bond m -> Bool
forall m. Eq m => Bond m -> Bond m -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bond m -> Bond m -> Bool
$c/= :: forall m. Eq m => Bond m -> Bond m -> Bool
== :: Bond m -> Bond m -> Bool
$c== :: forall m. Eq m => Bond m -> Bond m -> Bool
Eq, forall a b. a -> Bond b -> Bond a
forall a b. (a -> b) -> Bond a -> Bond b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Bond b -> Bond a
$c<$ :: forall a b. a -> Bond b -> Bond a
fmap :: forall a b. (a -> b) -> Bond a -> Bond b
$cfmap :: forall a b. (a -> b) -> Bond a -> Bond b
Functor, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall m x. Rep (Bond m) x -> Bond m
forall m x. Bond m -> Rep (Bond m) x
$cto :: forall m x. Rep (Bond m) x -> Bond m
$cfrom :: forall m x. Bond m -> Rep (Bond m) x
Generic)

instance Ord (Bond LocalID) where
    (Bond (LocalID Int
x) (LocalID Int
y) Int
_) <= :: Bond LocalID -> Bond LocalID -> Bool
<= (Bond (LocalID Int
x') (LocalID Int
y') Int
_) | Int
x forall a. Eq a => a -> a -> Bool
== Int
x'   = Int
y forall a. Ord a => a -> a -> Bool
<= Int
y'
                                                                           | Bool
otherwise = Int
x forall a. Ord a => a -> a -> Bool
<= Int
x'

instance Ord (Bond GlobalID) where
    (Bond (GlobalID Int
x) (GlobalID Int
y) Int
_) <= :: Bond GlobalID -> Bond GlobalID -> Bool
<= (Bond (GlobalID Int
x') (GlobalID Int
y') Int
_) | Int
x forall a. Eq a => a -> a -> Bool
== Int
x'   = Int
y forall a. Ord a => a -> a -> Bool
<= Int
y'
                                                                               | Bool
otherwise = Int
x forall a. Ord a => a -> a -> Bool
<= Int
x'

instance NFData a => NFData (Bond a)

-- | A set of atoms, organized to a residues
--
data Residue = Residue { Residue -> Text
resName          :: Text                  -- ^ residue name
                       , Residue -> Int
resNumber        :: Int                   -- ^ residue number
                       , Residue -> Char
resInsertionCode :: Char                  -- ^ residue insertion code
                       , Residue -> Vector Atom
resAtoms         :: Vector Atom           -- ^ a set of residue atoms
                       , Residue -> Vector (Bond LocalID)
resBonds         :: Vector (Bond LocalID) -- ^ a set of residue bonds with local identifiers (position in 'resAtoms')
                       , Residue -> SecondaryStructure
resSecondary     :: SecondaryStructure    -- ^ residue secondary structure
                       , Residue -> Text
resChemCompType  :: Text                  -- ^ chemical component type
                       }
  deriving (Int -> Residue -> ShowS
[Residue] -> ShowS
Residue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Residue] -> ShowS
$cshowList :: [Residue] -> ShowS
show :: Residue -> String
$cshow :: Residue -> String
showsPrec :: Int -> Residue -> ShowS
$cshowsPrec :: Int -> Residue -> ShowS
Show, Residue -> Residue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Residue -> Residue -> Bool
$c/= :: Residue -> Residue -> Bool
== :: Residue -> Residue -> Bool
$c== :: Residue -> Residue -> Bool
Eq, forall x. Rep Residue x -> Residue
forall x. Residue -> Rep Residue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Residue x -> Residue
$cfrom :: forall x. Residue -> Rep Residue x
Generic, Residue -> ()
forall a. (a -> ()) -> NFData a
rnf :: Residue -> ()
$crnf :: Residue -> ()
NFData)

makeLensesFor [("resAtoms", "atoms"), ("resBonds", "localBonds")] ''Residue

-- | Chain organizes linear structure of residues
--
data Chain = Chain { Chain -> Text
chainName     :: Text              -- ^ name of a chain
                   , Chain -> Vector Residue
chainResidues :: Vector Residue    -- ^ residues of a chain
                   }
  deriving (Int -> Chain -> ShowS
[Chain] -> ShowS
Chain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Chain] -> ShowS
$cshowList :: [Chain] -> ShowS
show :: Chain -> String
$cshow :: Chain -> String
showsPrec :: Int -> Chain -> ShowS
$cshowsPrec :: Int -> Chain -> ShowS
Show, Chain -> Chain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Chain -> Chain -> Bool
$c/= :: Chain -> Chain -> Bool
== :: Chain -> Chain -> Bool
$c== :: Chain -> Chain -> Bool
Eq, forall x. Rep Chain x -> Chain
forall x. Chain -> Rep Chain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Chain x -> Chain
$cfrom :: forall x. Chain -> Rep Chain x
Generic, Chain -> ()
forall a. (a -> ()) -> NFData a
rnf :: Chain -> ()
$crnf :: Chain -> ()
NFData)

makeLensesFor [("chainResidues", "residues")] ''Chain

-- | Model represents a single experiment of structure determination
--
data Model = Model { Model -> Vector Chain
modelChains :: Vector Chain           -- ^ chains in the model
                   , Model -> Vector (Bond GlobalID)
modelBonds  :: Vector (Bond GlobalID) -- ^ bonds with global identifiers (field `atomId` in 'Atom')
                   }
  deriving (Int -> Model -> ShowS
[Model] -> ShowS
Model -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Model] -> ShowS
$cshowList :: [Model] -> ShowS
show :: Model -> String
$cshow :: Model -> String
showsPrec :: Int -> Model -> ShowS
$cshowsPrec :: Int -> Model -> ShowS
Show, Model -> Model -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Model -> Model -> Bool
$c/= :: Model -> Model -> Bool
== :: Model -> Model -> Bool
$c== :: Model -> Model -> Bool
Eq, forall x. Rep Model x -> Model
forall x. Model -> Rep Model x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Model x -> Model
$cfrom :: forall x. Model -> Rep Model x
Generic, Model -> ()
forall a. (a -> ()) -> NFData a
rnf :: Model -> ()
$crnf :: Model -> ()
NFData)

makeLensesFor [("modelChains", "chains"), ("modelBonds", "globalBonds")] ''Model

-- | Convert any format-specific data to an intermediate representation of structure
class StructureModels a where
    -- | Get an array of models
    modelsOf :: a -> Vector Model

-- | Serialize an intermediate representation of sequence to some specific format
class StructureSerializable a where
    -- | Serialize an array of models to some format
    serializeModels :: Vector Model -> a