-- | A secondary structure, with sequence, Vienna compatible canonical
-- secondary structure, extended structure, and additional information.
--
-- This is the structure that will be returned by prediction algorithms in
-- the future.
--
-- TODO we will need ex- and import functions to a number of standard
-- formats. There is an open feature request to export to something that
-- resembles FASTA with additional information.

module Biobase.Secondary.Structure where

import           Data.Map.Strict (Map)
import           Data.Text (Text)
import qualified Data.Text as T

import           Biobase.Secondary.Diagrams



-- | A sequence, complete with secondary structure. While this structure is
-- rather RNA-centric, there is nothing that prohibits us from using this
-- for DNA.
--
-- TODO Generics, Cereal, Binary, Aeson instances

data SecondaryStructure = SS
  { SecondaryStructure -> Text
_ssSeq      :: !Text          -- ^ sequence; we use 'Text' whenever possible
  , SecondaryStructure -> D1Secondary
_ssVienna   :: !D1Secondary   -- ^ canonical Vienna secondary structure
  , SecondaryStructure -> D2Secondary
_ssExt      :: !D2Secondary   -- ^ extended secondary structure
  , SecondaryStructure -> Maybe ()
_ssViennaE  :: Maybe ()       -- ^ TODO will be the energy, measured or predicted
  , SecondaryStructure -> Map Text Text
_ssAux      :: Map Text Text  -- ^ any auxiliary info in key/value format
  }
  deriving (SecondaryStructure -> SecondaryStructure -> Bool
(SecondaryStructure -> SecondaryStructure -> Bool)
-> (SecondaryStructure -> SecondaryStructure -> Bool)
-> Eq SecondaryStructure
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,Int -> SecondaryStructure -> ShowS
[SecondaryStructure] -> ShowS
SecondaryStructure -> String
(Int -> SecondaryStructure -> ShowS)
-> (SecondaryStructure -> String)
-> ([SecondaryStructure] -> ShowS)
-> Show SecondaryStructure
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,ReadPrec [SecondaryStructure]
ReadPrec SecondaryStructure
Int -> ReadS SecondaryStructure
ReadS [SecondaryStructure]
(Int -> ReadS SecondaryStructure)
-> ReadS [SecondaryStructure]
-> ReadPrec SecondaryStructure
-> ReadPrec [SecondaryStructure]
-> Read SecondaryStructure
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SecondaryStructure]
$creadListPrec :: ReadPrec [SecondaryStructure]
readPrec :: ReadPrec SecondaryStructure
$creadPrec :: ReadPrec SecondaryStructure
readList :: ReadS [SecondaryStructure]
$creadList :: ReadS [SecondaryStructure]
readsPrec :: Int -> ReadS SecondaryStructure
$creadsPrec :: Int -> ReadS SecondaryStructure
Read)