module Bio.Sequence.AminoAcid.Internal.Types
  ( AminoAcid (..)
  , shortName3, shortName, fromChar, fromShortCode
  ) where

import           Data.Char (toUpper)

data AminoAcid = Alanine | Glycine | Valine | Isoleucine | Leucine | Methionine
               | Phenylalanine | Tyrosine | Tryptophan | Serine | Threonine
               | Asparagine | Glutamine | Cysteine | Proline | Arginine
               | Histidine | Lysine | AsparticAcid | GlutamicAcid
               | AcetylGroup | MetilAmine
  deriving (Show, Read, Eq, Ord)

shortName3 :: AminoAcid -> String
shortName3 Alanine       = "Ala"
shortName3 Glycine       = "Gly"
shortName3 Valine        = "Val"
shortName3 Isoleucine    = "Ile"
shortName3 Leucine       = "Leu"
shortName3 Methionine    = "Met"
shortName3 Phenylalanine = "Phe"
shortName3 Tyrosine      = "Tyr"
shortName3 Tryptophan    = "Trp"
shortName3 Serine        = "Ser"
shortName3 Threonine     = "Thr"
shortName3 Asparagine    = "Asn"
shortName3 Glutamine     = "Gln"
shortName3 Cysteine      = "Cys"
shortName3 Proline       = "Pro"
shortName3 Arginine      = "Arg"
shortName3 Histidine     = "His"
shortName3 Lysine        = "Lys"
shortName3 AsparticAcid  = "Asp"
shortName3 GlutamicAcid  = "Glu"
shortName3 AcetylGroup   = "Ace"
shortName3 MetilAmine    = "Nma"

shortName :: AminoAcid -> Char
shortName Alanine       = 'A'
shortName Glycine       = 'G'
shortName Valine        = 'V'
shortName Isoleucine    = 'I'
shortName Leucine       = 'L'
shortName Methionine    = 'M'
shortName Phenylalanine = 'F'
shortName Tyrosine      = 'Y'
shortName Tryptophan    = 'W'
shortName Serine        = 'S'
shortName Threonine     = 'T'
shortName Asparagine    = 'N'
shortName Glutamine     = 'Q'
shortName Cysteine      = 'C'
shortName Proline       = 'P'
shortName Arginine      = 'R'
shortName Histidine     = 'H'
shortName Lysine        = 'K'
shortName AsparticAcid  = 'D'
shortName GlutamicAcid  = 'E'
shortName AcetylGroup   = '^'
shortName MetilAmine    = '$'

fromShortCode :: String -> AminoAcid
fromShortCode str = fromCode' $ toUpper <$> str
  where fromCode' "ALA" = Alanine
        fromCode' "GLY" = Glycine
        fromCode' "VAL" = Valine
        fromCode' "ILE" = Isoleucine
        fromCode' "LEU" = Leucine
        fromCode' "MET" = Methionine
        fromCode' "PHE" = Phenylalanine
        fromCode' "TYR" = Tyrosine
        fromCode' "TRP" = Tryptophan
        fromCode' "SER" = Serine
        fromCode' "THR" = Threonine
        fromCode' "ASN" = Asparagine
        fromCode' "GLN" = Glutamine
        fromCode' "CYS" = Cysteine
        fromCode' "PRO" = Proline
        fromCode' "ARG" = Arginine
        fromCode' "HIS" = Histidine
        fromCode' "LYS" = Lysine
        fromCode' "ASP" = AsparticAcid
        fromCode' "GLU" = GlutamicAcid
        fromCode' "ACE" = AcetylGroup
        fromCode' "NMA" = MetilAmine
        fromCode' code  = error $ "Unknown aminoacid code => " ++ code

fromChar :: Char -> AminoAcid
fromChar 'A'  = Alanine
fromChar 'G'  = Glycine
fromChar 'V'  = Valine
fromChar 'I'  = Isoleucine
fromChar 'L'  = Leucine
fromChar 'M'  = Methionine
fromChar 'F'  = Phenylalanine
fromChar 'Y'  = Tyrosine
fromChar 'W'  = Tryptophan
fromChar 'S'  = Serine
fromChar 'T'  = Threonine
fromChar 'N'  = Asparagine
fromChar 'Q'  = Glutamine
fromChar 'C'  = Cysteine
fromChar 'P'  = Proline
fromChar 'R'  = Arginine
fromChar 'H'  = Histidine
fromChar 'K'  = Lysine
fromChar 'D'  = AsparticAcid
fromChar 'E'  = GlutamicAcid
fromChar '^'  = AcetylGroup
fromChar '$'  = MetilAmine
fromChar code = error $ "Unknown aminoacid code => " ++ [code]