-- | This module gives functionality to convert between different variants
-- of secondary structure elements.

module Biobase.Secondary.Convert where

import           Biobase.Types.BioSequence

import           Biobase.Primary.Letter
import           Biobase.Primary.Nuc.RNA
import           Biobase.Secondary.Basepair
import           Biobase.Secondary.Vienna (ViennaPair(..))
import qualified Biobase.Secondary.Vienna as SV
import qualified Biobase.Secondary.Basepair as SB



-- | @basepairConvert@ converts between different secondary structure base
-- pair representations. In general, the conversion is lossy, in particular
-- when "downsizing", say to @ViennaPair@.

class BasepairConvert a b where
  basepairConvert :: a -> b



-- ** @(RNA,RNA) <-> Basepair@

instance BasepairConvert (Letter RNA n,Letter RNA n) Basepair where
  basepairConvert :: (Letter RNA n, Letter RNA n) -> Basepair
basepairConvert (Letter RNA n
l,Letter RNA n
r)
    | Letter RNA n
l Letter RNA n -> Letter RNA n -> Bool
forall a. Ord a => a -> a -> Bool
>= Letter RNA n
forall k (n :: k). Letter RNA n
A Bool -> Bool -> Bool
&& Letter RNA n
l Letter RNA n -> Letter RNA n -> Bool
forall a. Ord a => a -> a -> Bool
<= Letter RNA n
forall k (n :: k). Letter RNA n
U Bool -> Bool -> Bool
&& Letter RNA n
r Letter RNA n -> Letter RNA n -> Bool
forall a. Ord a => a -> a -> Bool
>= Letter RNA n
forall k (n :: k). Letter RNA n
A Bool -> Bool -> Bool
&& Letter RNA n
r Letter RNA n -> Letter RNA n -> Bool
forall a. Ord a => a -> a -> Bool
<= Letter RNA n
forall k (n :: k). Letter RNA n
U
    = Int -> Basepair
BP (Int -> Basepair) -> Int -> Basepair
forall a b. (a -> b) -> a -> b
$ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Letter RNA n -> Int
forall seqTy k (nameTy :: k). Letter seqTy nameTy -> Int
getLetter Letter RNA n
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Letter RNA n -> Int
forall seqTy k (nameTy :: k). Letter seqTy nameTy -> Int
getLetter Letter RNA n
r
    | Bool
otherwise = Basepair
NoBP
  {-# Inline basepairConvert #-}

instance BasepairConvert Basepair (Letter RNA n, Letter RNA n) where
  basepairConvert :: Basepair -> (Letter RNA n, Letter RNA n)
basepairConvert Basepair
k
    | Basepair
k Basepair -> Basepair -> Bool
forall a. Eq a => a -> a -> Bool
== Basepair
NoBP Bool -> Bool -> Bool
|| Basepair
k Basepair -> Basepair -> Bool
forall a. Eq a => a -> a -> Bool
== Basepair
NS = (Letter RNA n
forall k (n :: k). Letter RNA n
N,Letter RNA n
forall k (n :: k). Letter RNA n
N)
    | Bool
otherwise = let (Int
l,Int
r) = Basepair -> Int
getBP Basepair
k Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
4 in (Int -> Letter RNA n
forall k seqTy (nameTy :: k). Int -> Letter seqTy nameTy
Letter Int
l, Int -> Letter RNA n
forall k seqTy (nameTy :: k). Int -> Letter seqTy nameTy
Letter Int
r)
  {-# Inline basepairConvert #-}



-- ** @(RNA,RNA) <-> ViennaPair@

instance BasepairConvert (Letter RNA n, Letter RNA n) ViennaPair where
  basepairConvert :: (Letter RNA n, Letter RNA n) -> ViennaPair
basepairConvert = \case
    (Letter RNA n
C,Letter RNA n
G) -> ViennaPair
SV.CG
    (Letter RNA n
G,Letter RNA n
C) -> ViennaPair
SV.GC
    (Letter RNA n
G,Letter RNA n
U) -> ViennaPair
SV.GU
    (Letter RNA n
U,Letter RNA n
G) -> ViennaPair
SV.UG
    (Letter RNA n
A,Letter RNA n
U) -> ViennaPair
SV.AU
    (Letter RNA n
U,Letter RNA n
A) -> ViennaPair
SV.UA
    (Letter RNA n, Letter RNA n)
_     -> ViennaPair
SV.NS
  {-# Inline basepairConvert #-}

instance BasepairConvert ViennaPair (Letter RNA n, Letter RNA n) where
  basepairConvert :: ViennaPair -> (Letter RNA n, Letter RNA n)
basepairConvert = \case
    ViennaPair
SV.CG -> (Letter RNA n
forall k (n :: k). Letter RNA n
C,Letter RNA n
forall k (n :: k). Letter RNA n
G)
    ViennaPair
SV.GC -> (Letter RNA n
forall k (n :: k). Letter RNA n
G,Letter RNA n
forall k (n :: k). Letter RNA n
C)
    ViennaPair
SV.GU -> (Letter RNA n
forall k (n :: k). Letter RNA n
G,Letter RNA n
forall k (n :: k). Letter RNA n
U)
    ViennaPair
SV.UG -> (Letter RNA n
forall k (n :: k). Letter RNA n
U,Letter RNA n
forall k (n :: k). Letter RNA n
G)
    ViennaPair
SV.AU -> (Letter RNA n
forall k (n :: k). Letter RNA n
A,Letter RNA n
forall k (n :: k). Letter RNA n
U)
    ViennaPair
SV.UA -> (Letter RNA n
forall k (n :: k). Letter RNA n
U,Letter RNA n
forall k (n :: k). Letter RNA n
A)
    ViennaPair
SV.NS -> (Letter RNA n
forall k (n :: k). Letter RNA n
N,Letter RNA n
forall k (n :: k). Letter RNA n
N)
  {-# Inline basepairConvert #-}



-- ** @Basepair <-> ViennaPair@

instance BasepairConvert Basepair ViennaPair where
  basepairConvert :: Basepair -> ViennaPair
basepairConvert = \case
    Basepair
SB.AU -> ViennaPair
SV.AU
    Basepair
SB.CG -> ViennaPair
SV.CG
    Basepair
SB.GC -> ViennaPair
SV.GC
    Basepair
SB.GU -> ViennaPair
SV.GU
    Basepair
SB.UA -> ViennaPair
SV.UA
    Basepair
SB.UG -> ViennaPair
SV.UG
    Basepair
_     -> ViennaPair
SV.NS
  {-# Inline basepairConvert #-}

instance BasepairConvert ViennaPair Basepair where
  basepairConvert :: ViennaPair -> Basepair
basepairConvert = \case
    ViennaPair
SV.AU -> Basepair
SB.AU
    ViennaPair
SV.CG -> Basepair
SB.CG
    ViennaPair
SV.GC -> Basepair
SB.GC
    ViennaPair
SV.GU -> Basepair
SB.GU
    ViennaPair
SV.UA -> Basepair
SB.UA
    ViennaPair
SV.UG -> Basepair
SB.UG
    ViennaPair
_     -> Basepair
SB.NS
  {-# Inline basepairConvert #-}