--  {-# Language CPP #-}
--  
--  #if __GLASGOW_HASKELL__ < 710
--  {-# LANGUAGE OverlappingInstances #-}
--  #endif

-- | Convert between different nucleotide representations

module Biobase.Primary.Nuc.Conversion where

import           Control.Lens (iso, from)
import qualified Data.Vector.Unboxed as VU

import           Biobase.Types.BioSequence (Transcribe(..),RNA,DNA)

import           Biobase.Primary.Letter (Letter(..), Primary)
import qualified Biobase.Primary.Nuc.DNA as D
import qualified Biobase.Primary.Nuc.RNA as R
import qualified Biobase.Primary.Nuc.XNA as X



-- * Single-character translations.

-- | Transform RNA to DNA. That means change @U@ to @T@ and keep the other
-- characters as is.

rnaTdna :: Letter RNA n -> Letter DNA n
rnaTdna = \case
  Letter RNA n
R.A -> Letter DNA n
forall k (n :: k). Letter DNA n
D.A
  Letter RNA n
R.C -> Letter DNA n
forall k (n :: k). Letter DNA n
D.C
  Letter RNA n
R.G -> Letter DNA n
forall k (n :: k). Letter DNA n
D.G
  Letter RNA n
R.U -> Letter DNA n
forall k (n :: k). Letter DNA n
D.T
  Letter RNA n
_   -> Letter DNA n
forall k (n :: k). Letter DNA n
D.N
{-# INLINE rnaTdna #-}

-- | Transform DNA to RNA. That means change @T@ to @U@ and keep the other
-- characters as is.

dnaTrna :: Letter DNA n -> Letter RNA n
dnaTrna = \case
  Letter DNA n
D.A -> Letter RNA n
forall k (n :: k). Letter RNA n
R.A
  Letter DNA n
D.C -> Letter RNA n
forall k (n :: k). Letter RNA n
R.C
  Letter DNA n
D.G -> Letter RNA n
forall k (n :: k). Letter RNA n
R.G
  Letter DNA n
D.T -> Letter RNA n
forall k (n :: k). Letter RNA n
R.U
  Letter DNA n
_   -> Letter RNA n
forall k (n :: k). Letter RNA n
R.N
{-# INLINE dnaTrna #-}

-- | Generalize an RNA character to a XNA character.

rnaGxna :: Letter RNA n -> Letter XNA n
rnaGxna = \case
  Letter RNA n
R.A -> Letter XNA n
forall k (n :: k). Letter XNA n
X.A
  Letter RNA n
R.C -> Letter XNA n
forall k (n :: k). Letter XNA n
X.C
  Letter RNA n
R.G -> Letter XNA n
forall k (n :: k). Letter XNA n
X.G
  Letter RNA n
R.U -> Letter XNA n
forall k (n :: k). Letter XNA n
X.U
  Letter RNA n
_   -> Letter XNA n
forall k (n :: k). Letter XNA n
X.N
{-# INLINE rnaGxna #-}

-- | Generalize a DNA character to a XNA character.

dnaGxna :: Letter DNA n -> Letter XNA n
dnaGxna = \case
  Letter DNA n
D.A -> Letter XNA n
forall k (n :: k). Letter XNA n
X.A
  Letter DNA n
D.C -> Letter XNA n
forall k (n :: k). Letter XNA n
X.C
  Letter DNA n
D.G -> Letter XNA n
forall k (n :: k). Letter XNA n
X.G
  Letter DNA n
D.T -> Letter XNA n
forall k (n :: k). Letter XNA n
X.T
  Letter DNA n
_   -> Letter XNA n
forall k (n :: k). Letter XNA n
X.N
{-# INLINE dnaGxna #-}

-- | Specialize XNA to RNA, @T@ becomes @N@.

xnaSrna :: Letter XNA n -> Letter RNA n
xnaSrna = \case
  Letter XNA n
X.A -> Letter RNA n
forall k (n :: k). Letter RNA n
R.A
  Letter XNA n
X.C -> Letter RNA n
forall k (n :: k). Letter RNA n
R.C
  Letter XNA n
X.G -> Letter RNA n
forall k (n :: k). Letter RNA n
R.G
  Letter XNA n
X.U -> Letter RNA n
forall k (n :: k). Letter RNA n
R.U
  Letter XNA n
_   -> Letter RNA n
forall k (n :: k). Letter RNA n
R.N
{-# INLINE xnaSrna #-}

-- | Specialize XNA to DNA, @U@ becomes @N@.

xnaSdna :: Letter XNA n -> Letter DNA n
xnaSdna = \case
  Letter XNA n
X.A -> Letter DNA n
forall k (n :: k). Letter DNA n
D.A
  Letter XNA n
X.C -> Letter DNA n
forall k (n :: k). Letter DNA n
D.C
  Letter XNA n
X.G -> Letter DNA n
forall k (n :: k). Letter DNA n
D.G
  Letter XNA n
X.T -> Letter DNA n
forall k (n :: k). Letter DNA n
D.T
  Letter XNA n
_   -> Letter DNA n
forall k (n :: k). Letter DNA n
D.N
{-# INLINE xnaSdna #-}



-- ** Transcription between RNA and DNA. Both on the individual sequence level,
-- and on the level of primary sequence data.

instance Transcribe (Letter RNA n) where
  type TranscribeTo (Letter RNA n) = Letter DNA n
  transcribe :: p (TranscribeTo (Letter RNA n)) (f (TranscribeTo (Letter RNA n)))
-> p (Letter RNA n) (f (Letter RNA n))
transcribe = (Letter RNA n -> Letter DNA n)
-> (Letter DNA n -> Letter RNA n)
-> Iso (Letter RNA n) (Letter RNA n) (Letter DNA n) (Letter DNA n)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Letter RNA n -> Letter DNA n
forall k k (n :: k) (n :: k). Letter RNA n -> Letter DNA n
rnaTdna Letter DNA n -> Letter RNA n
forall k k (n :: k) (n :: k). Letter DNA n -> Letter RNA n
dnaTrna
  {-# Inline transcribe #-}

instance Transcribe (Letter DNA n) where
  type TranscribeTo (Letter DNA n) = Letter RNA n
  transcribe :: p (TranscribeTo (Letter DNA n)) (f (TranscribeTo (Letter DNA n)))
-> p (Letter DNA n) (f (Letter DNA n))
transcribe = AnIso (Letter RNA n) (Letter RNA n) (Letter DNA n) (Letter DNA n)
-> Iso (Letter DNA n) (Letter DNA n) (Letter RNA n) (Letter RNA n)
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso (Letter RNA n) (Letter RNA n) (Letter DNA n) (Letter DNA n)
forall f. Transcribe f => Iso' f (TranscribeTo f)
transcribe
  {-# Inline transcribe #-}

instance Transcribe (Primary RNA n) where
  type TranscribeTo (Primary RNA n) = Primary DNA n
  transcribe :: p (TranscribeTo (Primary RNA n)) (f (TranscribeTo (Primary RNA n)))
-> p (Primary RNA n) (f (Primary RNA n))
transcribe = (Primary RNA n -> Vector (Letter DNA n))
-> (Vector (Letter DNA n) -> Primary RNA n)
-> Iso
     (Primary RNA n)
     (Primary RNA n)
     (Vector (Letter DNA n))
     (Vector (Letter DNA n))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((Letter RNA n -> Letter DNA n)
-> Primary RNA n -> Vector (Letter DNA n)
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
VU.map Letter RNA n -> Letter DNA n
forall k k (n :: k) (n :: k). Letter RNA n -> Letter DNA n
rnaTdna) ((Letter DNA n -> Letter RNA n)
-> Vector (Letter DNA n) -> Primary RNA n
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
VU.map Letter DNA n -> Letter RNA n
forall k k (n :: k) (n :: k). Letter DNA n -> Letter RNA n
dnaTrna)
  {-# Inline transcribe #-}

instance Transcribe (Primary DNA n) where
  type TranscribeTo (Primary DNA n) = Primary RNA n
  transcribe :: p (TranscribeTo (Primary DNA n)) (f (TranscribeTo (Primary DNA n)))
-> p (Primary DNA n) (f (Primary DNA n))
transcribe = (Primary DNA n -> Vector (Letter RNA n))
-> (Vector (Letter RNA n) -> Primary DNA n)
-> Iso
     (Primary DNA n)
     (Primary DNA n)
     (Vector (Letter RNA n))
     (Vector (Letter RNA n))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((Letter DNA n -> Letter RNA n)
-> Primary DNA n -> Vector (Letter RNA n)
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
VU.map Letter DNA n -> Letter RNA n
forall k k (n :: k) (n :: k). Letter DNA n -> Letter RNA n
dnaTrna) ((Letter RNA n -> Letter DNA n)
-> Vector (Letter RNA n) -> Primary DNA n
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
VU.map Letter RNA n -> Letter DNA n
forall k k (n :: k) (n :: k). Letter RNA n -> Letter DNA n
rnaTdna)
  {-# Inline transcribe #-}


-- TODO to be removed soon

---- * Reverse-complement of characters.
--
---- | Produce the complement of a RNA or DNA sequence. Does intentionally
---- not work for XNA sequences as it is not possible to uniquely translate
---- @A@ into either @U@ or @T@.
--
--class Complement s t where
--    complement :: s -> t
--
---- | To 'transcribe' a DNA sequence into RNA we reverse the complement of
---- the sequence.
--
--transcribe :: Primary D.DNA -> Primary R.RNA
--transcribe = VU.reverse . complement
--
--instance Complement (Letter R.RNA) (Letter R.RNA) where
--    complement = \case
--      R.A -> R.U
--      R.C -> R.G
--      R.G -> R.C
--      R.U -> R.A
--      R.N -> R.N
--
--instance Complement (Letter D.DNA) (Letter D.DNA) where
--    complement = \case
--      D.A -> D.T
--      D.C -> D.G
--      D.G -> D.C
--      D.T -> D.A
--      D.N -> D.N
--
--instance Complement (Letter D.DNA) (Letter R.RNA) where
--    complement = \case
--      D.A -> R.U
--      D.C -> R.G
--      D.G -> R.C
--      D.T -> R.A
--      D.N -> R.N
--
--instance Complement (Letter R.RNA) (Letter D.DNA) where
--    complement = \case
--      R.A -> D.T
--      R.C -> D.G
--      R.G -> D.C
--      R.U -> D.A
--      R.N -> D.N
--
-- #if __GLASGOW_HASKELL__ >= 710
-- instance {-# OVERLAPPING #-}
-- #else
-- instance
-- #endif
--   ( Complement s t, VU.Unbox s, VU.Unbox t)
--   => Complement (VU.Vector s) (VU.Vector t)
--   where complement = VU.map complement
-- 
-- #if __GLASGOW_HASKELL__ >= 710
-- instance {-# Overlappable #-}
-- #else
-- instance
-- #endif
--   ( Complement s t, Functor f) => Complement (f s) (f t)
--   where complement = fmap complement