-- | Encoding of Watson-Crick and Wobble Pairs in the Vienna RNA package style.

module Biobase.Secondary.Vienna where

import           Data.Aeson
import           Data.Binary
import           Data.Ix
import           Data.Primitive.Types
import           Data.Serialize (Serialize(..))
import           Data.Tuple (swap)
import           Data.Vector.Fusion.Stream.Monadic (map,Step(..),flatten)
import           Data.Vector.Unboxed.Deriving
import           GHC.Base (remInt,quotInt)
import           GHC.Generics (Generic)
import           Prelude hiding (map)
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Unboxed as VU
import qualified Prelude as P

import           Data.PrimitiveArray hiding (Complement(..),map)
import           Biobase.Types.BioSequence

import           Biobase.Primary.Letter
import           Biobase.Primary.Nuc
import           Biobase.Primary.Nuc.RNA



-- | Use machine Ints internally

newtype ViennaPair = ViennaPair { ViennaPair -> Int
unViennaPair :: Int }
  deriving (ViennaPair -> ViennaPair -> Bool
(ViennaPair -> ViennaPair -> Bool)
-> (ViennaPair -> ViennaPair -> Bool) -> Eq ViennaPair
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViennaPair -> ViennaPair -> Bool
$c/= :: ViennaPair -> ViennaPair -> Bool
== :: ViennaPair -> ViennaPair -> Bool
$c== :: ViennaPair -> ViennaPair -> Bool
Eq,Eq ViennaPair
Eq ViennaPair
-> (ViennaPair -> ViennaPair -> Ordering)
-> (ViennaPair -> ViennaPair -> Bool)
-> (ViennaPair -> ViennaPair -> Bool)
-> (ViennaPair -> ViennaPair -> Bool)
-> (ViennaPair -> ViennaPair -> Bool)
-> (ViennaPair -> ViennaPair -> ViennaPair)
-> (ViennaPair -> ViennaPair -> ViennaPair)
-> Ord ViennaPair
ViennaPair -> ViennaPair -> Bool
ViennaPair -> ViennaPair -> Ordering
ViennaPair -> ViennaPair -> ViennaPair
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 :: ViennaPair -> ViennaPair -> ViennaPair
$cmin :: ViennaPair -> ViennaPair -> ViennaPair
max :: ViennaPair -> ViennaPair -> ViennaPair
$cmax :: ViennaPair -> ViennaPair -> ViennaPair
>= :: ViennaPair -> ViennaPair -> Bool
$c>= :: ViennaPair -> ViennaPair -> Bool
> :: ViennaPair -> ViennaPair -> Bool
$c> :: ViennaPair -> ViennaPair -> Bool
<= :: ViennaPair -> ViennaPair -> Bool
$c<= :: ViennaPair -> ViennaPair -> Bool
< :: ViennaPair -> ViennaPair -> Bool
$c< :: ViennaPair -> ViennaPair -> Bool
compare :: ViennaPair -> ViennaPair -> Ordering
$ccompare :: ViennaPair -> ViennaPair -> Ordering
$cp1Ord :: Eq ViennaPair
Ord,(forall x. ViennaPair -> Rep ViennaPair x)
-> (forall x. Rep ViennaPair x -> ViennaPair) -> Generic ViennaPair
forall x. Rep ViennaPair x -> ViennaPair
forall x. ViennaPair -> Rep ViennaPair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ViennaPair x -> ViennaPair
$cfrom :: forall x. ViennaPair -> Rep ViennaPair x
Generic,Ord ViennaPair
Ord ViennaPair
-> ((ViennaPair, ViennaPair) -> [ViennaPair])
-> ((ViennaPair, ViennaPair) -> ViennaPair -> Int)
-> ((ViennaPair, ViennaPair) -> ViennaPair -> Int)
-> ((ViennaPair, ViennaPair) -> ViennaPair -> Bool)
-> ((ViennaPair, ViennaPair) -> Int)
-> ((ViennaPair, ViennaPair) -> Int)
-> Ix ViennaPair
(ViennaPair, ViennaPair) -> Int
(ViennaPair, ViennaPair) -> [ViennaPair]
(ViennaPair, ViennaPair) -> ViennaPair -> Bool
(ViennaPair, ViennaPair) -> ViennaPair -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (ViennaPair, ViennaPair) -> Int
$cunsafeRangeSize :: (ViennaPair, ViennaPair) -> Int
rangeSize :: (ViennaPair, ViennaPair) -> Int
$crangeSize :: (ViennaPair, ViennaPair) -> Int
inRange :: (ViennaPair, ViennaPair) -> ViennaPair -> Bool
$cinRange :: (ViennaPair, ViennaPair) -> ViennaPair -> Bool
unsafeIndex :: (ViennaPair, ViennaPair) -> ViennaPair -> Int
$cunsafeIndex :: (ViennaPair, ViennaPair) -> ViennaPair -> Int
index :: (ViennaPair, ViennaPair) -> ViennaPair -> Int
$cindex :: (ViennaPair, ViennaPair) -> ViennaPair -> Int
range :: (ViennaPair, ViennaPair) -> [ViennaPair]
$crange :: (ViennaPair, ViennaPair) -> [ViennaPair]
$cp1Ix :: Ord ViennaPair
Ix)

derivingUnbox "ViennaPair"
  [t| ViennaPair -> Int |]
  [| unViennaPair |]
  [| ViennaPair |]

instance Binary    (ViennaPair)
instance Serialize (ViennaPair)
instance FromJSON  (ViennaPair)
instance ToJSON    (ViennaPair)

instance Index ViennaPair where
  data LimitType ViennaPair
    = Canonical | Extended
  linearIndex :: LimitType ViennaPair -> ViennaPair -> Int
linearIndex LimitType ViennaPair
_ (ViennaPair Int
p) = Int
p
  {-# Inline linearIndex #-}
  size :: LimitType ViennaPair -> Int
size LimitType ViennaPair
h = case LimitType ViennaPair
h of { LimitType ViennaPair
Canonical → Int
7; LimitType ViennaPair
Extended → Int
9 }
  {-# Inline size #-}
  inBounds :: LimitType ViennaPair -> ViennaPair -> Bool
inBounds LimitType ViennaPair
h (ViennaPair Int
p) = Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
p Bool -> Bool -> Bool
&& Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< LimitType ViennaPair -> Int
forall i. Index i => LimitType i -> Int
size LimitType ViennaPair
h
  {-# Inline inBounds #-}

instance IndexStream z => IndexStream (z:.ViennaPair) where
  streamUp :: LimitType (z :. ViennaPair)
-> LimitType (z :. ViennaPair) -> Stream m (z :. ViennaPair)
streamUp (ls:..l) (hs:..h) = (z -> m (z, Int))
-> ((z, Int) -> m (Step (z, Int) (z :. ViennaPair)))
-> Stream m z
-> Stream m (z :. ViennaPair)
forall (m :: * -> *) a s b.
Monad m =>
(a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
flatten z -> m (z, Int)
mk (z, Int) -> m (Step (z, Int) (z :. ViennaPair))
step (Stream m z -> Stream m (z :. ViennaPair))
-> Stream m z -> Stream m (z :. ViennaPair)
forall a b. (a -> b) -> a -> b
$ LimitType z -> LimitType z -> Stream m z
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamUp LimitType z
ls LimitType z
hs
    where mk :: z -> m (z, Int)
mk z
z = (z, Int) -> m (z, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (z
z,LimitType ViennaPair -> Int
forall i. Index i => LimitType i -> Int
size LimitType ViennaPair
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          step :: (z, Int) -> m (Step (z, Int) (z :. ViennaPair))
step (z
z,Int
k)
            | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> LimitType ViennaPair -> Int
forall i. Index i => LimitType i -> Int
size LimitType ViennaPair
h Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 = Step (z, Int) (z :. ViennaPair)
-> m (Step (z, Int) (z :. ViennaPair))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (z, Int) (z :. ViennaPair)
 -> m (Step (z, Int) (z :. ViennaPair)))
-> Step (z, Int) (z :. ViennaPair)
-> m (Step (z, Int) (z :. ViennaPair))
forall a b. (a -> b) -> a -> b
$ Step (z, Int) (z :. ViennaPair)
forall s a. Step s a
Done
            | Bool
otherwise     = Step (z, Int) (z :. ViennaPair)
-> m (Step (z, Int) (z :. ViennaPair))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (z, Int) (z :. ViennaPair)
 -> m (Step (z, Int) (z :. ViennaPair)))
-> Step (z, Int) (z :. ViennaPair)
-> m (Step (z, Int) (z :. ViennaPair))
forall a b. (a -> b) -> a -> b
$ (z :. ViennaPair) -> (z, Int) -> Step (z, Int) (z :. ViennaPair)
forall a s. a -> s -> Step s a
Yield (z
zz -> ViennaPair -> z :. ViennaPair
forall a b. a -> b -> a :. b
:.Int -> ViennaPair
ViennaPair Int
k) (z
z,Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
          {-# Inline [0] mk   #-}
          {-# Inline [0] step #-}
  {-# Inline streamUp #-}
  streamDown :: LimitType (z :. ViennaPair)
-> LimitType (z :. ViennaPair) -> Stream m (z :. ViennaPair)
streamDown (ls:..l) (hs:..h) = (z -> m (z, Int))
-> ((z, Int) -> m (Step (z, Int) (z :. ViennaPair)))
-> Stream m z
-> Stream m (z :. ViennaPair)
forall (m :: * -> *) a s b.
Monad m =>
(a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b
flatten z -> m (z, Int)
mk (z, Int) -> m (Step (z, Int) (z :. ViennaPair))
step (Stream m z -> Stream m (z :. ViennaPair))
-> Stream m z -> Stream m (z :. ViennaPair)
forall a b. (a -> b) -> a -> b
$ LimitType z -> LimitType z -> Stream m z
forall i (m :: * -> *).
(IndexStream i, Monad m) =>
LimitType i -> LimitType i -> Stream m i
streamDown LimitType z
ls LimitType z
hs
    where mk :: z -> m (z, Int)
mk z
z = (z, Int) -> m (z, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (z
z,LimitType ViennaPair -> Int
forall i. Index i => LimitType i -> Int
size LimitType ViennaPair
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          step :: (z, Int) -> m (Step (z, Int) (z :. ViennaPair))
step (z
z,Int
k)
            | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< LimitType ViennaPair -> Int
forall i. Index i => LimitType i -> Int
size LimitType ViennaPair
l Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 = Step (z, Int) (z :. ViennaPair)
-> m (Step (z, Int) (z :. ViennaPair))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (z, Int) (z :. ViennaPair)
 -> m (Step (z, Int) (z :. ViennaPair)))
-> Step (z, Int) (z :. ViennaPair)
-> m (Step (z, Int) (z :. ViennaPair))
forall a b. (a -> b) -> a -> b
$ Step (z, Int) (z :. ViennaPair)
forall s a. Step s a
Done
            | Bool
otherwise     = Step (z, Int) (z :. ViennaPair)
-> m (Step (z, Int) (z :. ViennaPair))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (z, Int) (z :. ViennaPair)
 -> m (Step (z, Int) (z :. ViennaPair)))
-> Step (z, Int) (z :. ViennaPair)
-> m (Step (z, Int) (z :. ViennaPair))
forall a b. (a -> b) -> a -> b
$ (z :. ViennaPair) -> (z, Int) -> Step (z, Int) (z :. ViennaPair)
forall a s. a -> s -> Step s a
Yield (z
zz -> ViennaPair -> z :. ViennaPair
forall a b. a -> b -> a :. b
:.Int -> ViennaPair
ViennaPair Int
k) (z
z,Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
          {-# Inline [0] mk   #-}
          {-# Inline [0] step #-}
  {-# Inline streamDown #-}

instance IndexStream ViennaPair where



pattern    $bNP :: ViennaPair
$mNP :: forall r. ViennaPair -> (Void# -> r) -> (Void# -> r) -> r
NP = ViennaPair 0 :: ViennaPair
pattern    $bCG :: ViennaPair
$mCG :: forall r. ViennaPair -> (Void# -> r) -> (Void# -> r) -> r
CG = ViennaPair 1 :: ViennaPair
pattern    $bGC :: ViennaPair
$mGC :: forall r. ViennaPair -> (Void# -> r) -> (Void# -> r) -> r
GC = ViennaPair 2 :: ViennaPair
pattern    $bGU :: ViennaPair
$mGU :: forall r. ViennaPair -> (Void# -> r) -> (Void# -> r) -> r
GU = ViennaPair 3 :: ViennaPair
pattern    $bUG :: ViennaPair
$mUG :: forall r. ViennaPair -> (Void# -> r) -> (Void# -> r) -> r
UG = ViennaPair 4 :: ViennaPair
pattern    $bAU :: ViennaPair
$mAU :: forall r. ViennaPair -> (Void# -> r) -> (Void# -> r) -> r
AU = ViennaPair 5 :: ViennaPair
pattern    $bUA :: ViennaPair
$mUA :: forall r. ViennaPair -> (Void# -> r) -> (Void# -> r) -> r
UA = ViennaPair 6 :: ViennaPair
-- | Non-standard base pair
pattern    $bNS :: ViennaPair
$mNS :: forall r. ViennaPair -> (Void# -> r) -> (Void# -> r) -> r
NS = ViennaPair 7 :: ViennaPair
pattern $bUndef :: ViennaPair
$mUndef :: forall r. ViennaPair -> (Void# -> r) -> (Void# -> r) -> r
Undef = ViennaPair 8 :: ViennaPair

{-
class MkViennaPair a where
  mkViennaPair :: a -> ViennaPair
  fromViennaPair :: ViennaPair -> a

instance MkViennaPair (Letter RNA, Letter RNA) where
  mkViennaPair = \case
    (C,G) -> CG
    (G,C) -> GC
    (G,U) -> GU
    (U,G) -> UG
    (A,U) -> AU
    (U,A) -> UA
    _     -> NS
  {-# INLINE mkViennaPair #-}
  fromViennaPair = \case
    CG -> (C,G)
    GC -> (G,C)
    GU -> (G,U)
    UG -> (U,G)
    AU -> (A,U)
    UA -> (U,A)
    _  -> error "non-standard pairs can't be backcasted"
  {-# INLINE fromViennaPair #-}
-}

isViennaPair :: Letter RNA m -> Letter RNA n -> Bool
isViennaPair :: Letter RNA m -> Letter RNA n -> Bool
isViennaPair Letter RNA m
l Letter RNA n
r =  Letter RNA m
lLetter RNA m -> Letter RNA m -> Bool
forall a. Eq a => a -> a -> Bool
==Letter RNA m
forall k (n :: k). Letter RNA n
C Bool -> Bool -> Bool
&& Letter RNA n
rLetter RNA n -> Letter RNA n -> Bool
forall a. Eq a => a -> a -> Bool
==Letter RNA n
forall k (n :: k). Letter RNA n
G
                 Bool -> Bool -> Bool
|| Letter RNA m
lLetter RNA m -> Letter RNA m -> Bool
forall a. Eq a => a -> a -> Bool
==Letter RNA m
forall k (n :: k). Letter RNA n
G Bool -> Bool -> Bool
&& Letter RNA n
rLetter RNA n -> Letter RNA n -> Bool
forall a. Eq a => a -> a -> Bool
==Letter RNA n
forall k (n :: k). Letter RNA n
C
                 Bool -> Bool -> Bool
|| Letter RNA m
lLetter RNA m -> Letter RNA m -> Bool
forall a. Eq a => a -> a -> Bool
==Letter RNA m
forall k (n :: k). Letter RNA n
A Bool -> Bool -> Bool
&& Letter RNA n
rLetter RNA n -> Letter RNA n -> Bool
forall a. Eq a => a -> a -> Bool
==Letter RNA n
forall k (n :: k). Letter RNA n
U
                 Bool -> Bool -> Bool
|| Letter RNA m
lLetter RNA m -> Letter RNA m -> Bool
forall a. Eq a => a -> a -> Bool
==Letter RNA m
forall k (n :: k). Letter RNA n
U Bool -> Bool -> Bool
&& Letter RNA n
rLetter RNA n -> Letter RNA n -> Bool
forall a. Eq a => a -> a -> Bool
==Letter RNA n
forall k (n :: k). Letter RNA n
A
                 Bool -> Bool -> Bool
|| Letter RNA m
lLetter RNA m -> Letter RNA m -> Bool
forall a. Eq a => a -> a -> Bool
==Letter RNA m
forall k (n :: k). Letter RNA n
G Bool -> Bool -> Bool
&& Letter RNA n
rLetter RNA n -> Letter RNA n -> Bool
forall a. Eq a => a -> a -> Bool
==Letter RNA n
forall k (n :: k). Letter RNA n
U
                 Bool -> Bool -> Bool
|| Letter RNA m
lLetter RNA m -> Letter RNA m -> Bool
forall a. Eq a => a -> a -> Bool
==Letter RNA m
forall k (n :: k). Letter RNA n
U Bool -> Bool -> Bool
&& Letter RNA n
rLetter RNA n -> Letter RNA n -> Bool
forall a. Eq a => a -> a -> Bool
==Letter RNA n
forall k (n :: k). Letter RNA n
G
{-# INLINE isViennaPair #-}

viennaPairTable :: Unboxed (Z:.Letter RNA n:.Letter RNA n) ViennaPair
viennaPairTable :: Unboxed ((Z :. Letter RNA n) :. Letter RNA n) ViennaPair
viennaPairTable = LimitType ((Z :. Letter RNA n) :. Letter RNA n)
-> ViennaPair
-> [((Z :. Letter RNA n) :. Letter RNA n, ViennaPair)]
-> Unboxed ((Z :. Letter RNA n) :. Letter RNA n) ViennaPair
forall (arr :: * -> * -> *) sh elm.
PrimArrayOps arr sh elm =>
LimitType sh -> elm -> [(sh, elm)] -> arr sh elm
fromAssocs (LimitType Z
ZZLimitType Z
-> LimitType (Letter RNA n) -> LimitType (Z :. Letter RNA n)
forall zs z. LimitType zs -> LimitType z -> LimitType (zs :. z)
:..Letter RNA n -> LimitType (Letter RNA n)
forall k l (n :: k). Letter l n -> LimitType (Letter l n)
LtLetter Letter RNA n
forall a. Bounded a => a
maxBoundLimitType (Z :. Letter RNA n)
-> LimitType (Letter RNA n)
-> LimitType ((Z :. Letter RNA n) :. Letter RNA n)
forall zs z. LimitType zs -> LimitType z -> LimitType (zs :. z)
:..Letter RNA n -> LimitType (Letter RNA n)
forall k l (n :: k). Letter l n -> LimitType (Letter l n)
LtLetter Letter RNA n
forall a. Bounded a => a
maxBound) ViennaPair
NS
  [ (Z
ZZ -> Letter RNA n -> Z :. Letter RNA n
forall a b. a -> b -> a :. b
:.Letter RNA n
forall k (n :: k). Letter RNA n
C(Z :. Letter RNA n)
-> Letter RNA n -> (Z :. Letter RNA n) :. Letter RNA n
forall a b. a -> b -> a :. b
:.Letter RNA n
forall k (n :: k). Letter RNA n
G , ViennaPair
CG)
  , (Z
ZZ -> Letter RNA n -> Z :. Letter RNA n
forall a b. a -> b -> a :. b
:.Letter RNA n
forall k (n :: k). Letter RNA n
G(Z :. Letter RNA n)
-> Letter RNA n -> (Z :. Letter RNA n) :. Letter RNA n
forall a b. a -> b -> a :. b
:.Letter RNA n
forall k (n :: k). Letter RNA n
C , ViennaPair
GC)
  , (Z
ZZ -> Letter RNA n -> Z :. Letter RNA n
forall a b. a -> b -> a :. b
:.Letter RNA n
forall k (n :: k). Letter RNA n
G(Z :. Letter RNA n)
-> Letter RNA n -> (Z :. Letter RNA n) :. Letter RNA n
forall a b. a -> b -> a :. b
:.Letter RNA n
forall k (n :: k). Letter RNA n
U , ViennaPair
GU)
  , (Z
ZZ -> Letter RNA n -> Z :. Letter RNA n
forall a b. a -> b -> a :. b
:.Letter RNA n
forall k (n :: k). Letter RNA n
U(Z :. Letter RNA n)
-> Letter RNA n -> (Z :. Letter RNA n) :. Letter RNA n
forall a b. a -> b -> a :. b
:.Letter RNA n
forall k (n :: k). Letter RNA n
G , ViennaPair
UG)
  , (Z
ZZ -> Letter RNA n -> Z :. Letter RNA n
forall a b. a -> b -> a :. b
:.Letter RNA n
forall k (n :: k). Letter RNA n
A(Z :. Letter RNA n)
-> Letter RNA n -> (Z :. Letter RNA n) :. Letter RNA n
forall a b. a -> b -> a :. b
:.Letter RNA n
forall k (n :: k). Letter RNA n
U , ViennaPair
AU)
  , (Z
ZZ -> Letter RNA n -> Z :. Letter RNA n
forall a b. a -> b -> a :. b
:.Letter RNA n
forall k (n :: k). Letter RNA n
U(Z :. Letter RNA n)
-> Letter RNA n -> (Z :. Letter RNA n) :. Letter RNA n
forall a b. a -> b -> a :. b
:.Letter RNA n
forall k (n :: k). Letter RNA n
A , ViennaPair
UA)
  ]
{-# NOINLINE viennaPairTable #-}

instance Enum ViennaPair where
  toEnum :: Int -> ViennaPair
toEnum Int
x
    | Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0 Bool -> Bool -> Bool
&& Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
7 = Int -> ViennaPair
ViennaPair Int
x
    | Bool
otherwise    = String -> ViennaPair
forall a. HasCallStack => String -> a
error (String -> ViennaPair) -> String -> ViennaPair
forall a b. (a -> b) -> a -> b
$ String
"can't make to enum" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x
  fromEnum :: ViennaPair -> Int
fromEnum (ViennaPair Int
x) = Int
x
  {-# INLINE toEnum #-}
  {-# INLINE fromEnum #-}

instance Bounded ViennaPair where
  minBound :: ViennaPair
minBound = ViennaPair
NP
  maxBound :: ViennaPair
maxBound = ViennaPair
NS

instance Show ViennaPair where
  show :: ViennaPair -> String
show ViennaPair
x
    | Just String
s <- ViennaPair
x ViennaPair -> [(ViennaPair, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(ViennaPair, String)]
pairToString = String
s
    | Bool
otherwise = String
"??"

instance Read ViennaPair where
  readsPrec :: Int -> ReadS ViennaPair
readsPrec Int
p [] = []
  readsPrec Int
p [Char
x] = []
  readsPrec Int
p (Char
x:Char
y:String
xs)
    | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ' = Int -> ReadS ViennaPair
forall a. Read a => Int -> ReadS a
readsPrec Int
p (Char
yChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
    | Just ViennaPair
n <- (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:Char
yChar -> String -> String
forall a. a -> [a] -> [a]
:[]) String -> [(String, ViennaPair)] -> Maybe ViennaPair
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String, ViennaPair)]
s2p = [(ViennaPair
n,String
xs)]
    | Bool
otherwise = []
    where s2p :: [(String, ViennaPair)]
s2p = (((ViennaPair, String) -> (String, ViennaPair))
-> [(ViennaPair, String)] -> [(String, ViennaPair)]
forall a b. (a -> b) -> [a] -> [b]
P.map (ViennaPair, String) -> (String, ViennaPair)
forall a b. (a, b) -> (b, a)
swap [(ViennaPair, String)]
pairToString)



-- | reverse a vienna pair

revPair :: ViennaPair -> ViennaPair
revPair :: ViennaPair -> ViennaPair
revPair = \case
  ViennaPair
CG -> ViennaPair
GC
  ViennaPair
GC -> ViennaPair
CG
  ViennaPair
GU -> ViennaPair
UG
  ViennaPair
UG -> ViennaPair
GU
  ViennaPair
AU -> ViennaPair
UA
  ViennaPair
UA -> ViennaPair
AU
  ViennaPair
NP -> ViennaPair
NP
  ViennaPair
NS -> ViennaPair
NS



-- * Convenience structures

cguaP :: [ViennaPair]
cguaP = [ViennaPair
CG .. ViennaPair
UA]
cgnsP :: [ViennaPair]
cgnsP = [ViennaPair
CG .. ViennaPair
NS]
pairToString :: [(ViennaPair, String)]
pairToString = [(ViennaPair
CG,String
"CG"),(ViennaPair
GC,String
"GC"),(ViennaPair
UA,String
"UA"),(ViennaPair
AU,String
"AU"),(ViennaPair
GU,String
"GU"),(ViennaPair
UG,String
"UG"),(ViennaPair
NS,String
"NS"),(ViennaPair
NP,String
"NP")]