module Bio.Utils.IUPAC
  (
    AtomType (..)
  ) where

import           Control.DeepSeq (NFData (..))
import           GHC.Generics    (Generic)

-- | Atom types in IUPAC nomenclature.
--
data AtomType = N   | CA  | C    | O  | OXT
              | CB
              | CG  | CG1 | CG2
              | CD  | CD1 | CD2
              | CE  | CE1 | CE2  | CE3
              | CH3
              | CZ  | CZ2 | CZ3
              | CH2
              | SG
              | SD
              | OG  | OG1
              | OD1 | OD2
              | OE1 | OE2
              | OH
              | ND1 | ND2
              | NE  | NE1 | NE2
              | NZ
              | NH1 | NH2
              | H
              | HA  | HA2 | HA3
              | HB  | HB1 | HB2  | HB3
              | HG  | HG1 | HG2  | HG3  | HG11 | HG12 | HG13 | HG21 | HG22 | HG23
              | HD  | HD1 | HD2  | HD3  | HD11 | HD12 | HD13 | HD21 | HD22 | HD23
              | HE  | HE1 | HE2  | HE3  | HE21 | HE22
              | HH  | HH2 | HH11 | HH12 | HH21 | HH22
              | HZ  | HZ1 | HZ2  | HZ3
  deriving (Int -> AtomType -> ShowS
[AtomType] -> ShowS
AtomType -> String
(Int -> AtomType -> ShowS)
-> (AtomType -> String) -> ([AtomType] -> ShowS) -> Show AtomType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AtomType] -> ShowS
$cshowList :: [AtomType] -> ShowS
show :: AtomType -> String
$cshow :: AtomType -> String
showsPrec :: Int -> AtomType -> ShowS
$cshowsPrec :: Int -> AtomType -> ShowS
Show, ReadPrec [AtomType]
ReadPrec AtomType
Int -> ReadS AtomType
ReadS [AtomType]
(Int -> ReadS AtomType)
-> ReadS [AtomType]
-> ReadPrec AtomType
-> ReadPrec [AtomType]
-> Read AtomType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AtomType]
$creadListPrec :: ReadPrec [AtomType]
readPrec :: ReadPrec AtomType
$creadPrec :: ReadPrec AtomType
readList :: ReadS [AtomType]
$creadList :: ReadS [AtomType]
readsPrec :: Int -> ReadS AtomType
$creadsPrec :: Int -> ReadS AtomType
Read, AtomType -> AtomType -> Bool
(AtomType -> AtomType -> Bool)
-> (AtomType -> AtomType -> Bool) -> Eq AtomType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AtomType -> AtomType -> Bool
$c/= :: AtomType -> AtomType -> Bool
== :: AtomType -> AtomType -> Bool
$c== :: AtomType -> AtomType -> Bool
Eq, Eq AtomType
Eq AtomType
-> (AtomType -> AtomType -> Ordering)
-> (AtomType -> AtomType -> Bool)
-> (AtomType -> AtomType -> Bool)
-> (AtomType -> AtomType -> Bool)
-> (AtomType -> AtomType -> Bool)
-> (AtomType -> AtomType -> AtomType)
-> (AtomType -> AtomType -> AtomType)
-> Ord AtomType
AtomType -> AtomType -> Bool
AtomType -> AtomType -> Ordering
AtomType -> AtomType -> AtomType
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 :: AtomType -> AtomType -> AtomType
$cmin :: AtomType -> AtomType -> AtomType
max :: AtomType -> AtomType -> AtomType
$cmax :: AtomType -> AtomType -> AtomType
>= :: AtomType -> AtomType -> Bool
$c>= :: AtomType -> AtomType -> Bool
> :: AtomType -> AtomType -> Bool
$c> :: AtomType -> AtomType -> Bool
<= :: AtomType -> AtomType -> Bool
$c<= :: AtomType -> AtomType -> Bool
< :: AtomType -> AtomType -> Bool
$c< :: AtomType -> AtomType -> Bool
compare :: AtomType -> AtomType -> Ordering
$ccompare :: AtomType -> AtomType -> Ordering
$cp1Ord :: Eq AtomType
Ord, (forall x. AtomType -> Rep AtomType x)
-> (forall x. Rep AtomType x -> AtomType) -> Generic AtomType
forall x. Rep AtomType x -> AtomType
forall x. AtomType -> Rep AtomType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AtomType x -> AtomType
$cfrom :: forall x. AtomType -> Rep AtomType x
Generic)

instance NFData AtomType