module Biobase.Primary.Nuc.DNA where

import           Control.Category ((>>>))
import           Control.Lens (Iso', iso)
import           Data.Aeson
import           Data.Char (toUpper)
import           Data.Ix (Ix(..))
import           Data.Primitive.Types
import           Data.String
import           Data.Tuple (swap)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Unboxed as VU

import           Biobase.Types.BioSequence (DNA)

import           Biobase.Primary.Bounds
import           Biobase.Primary.Letter



-- Single-character names for nucleotides.

pattern $bA :: Letter DNA n
$mA :: forall r k (n :: k).
Letter DNA n -> (Void# -> r) -> (Void# -> r) -> r
A = Letter 0 :: Letter DNA n
pattern $bC :: Letter DNA n
$mC :: forall r k (n :: k).
Letter DNA n -> (Void# -> r) -> (Void# -> r) -> r
C = Letter 1 :: Letter DNA n
pattern $bG :: Letter DNA n
$mG :: forall r k (n :: k).
Letter DNA n -> (Void# -> r) -> (Void# -> r) -> r
G = Letter 2 :: Letter DNA n
pattern $bT :: Letter DNA n
$mT :: forall r k (n :: k).
Letter DNA n -> (Void# -> r) -> (Void# -> r) -> r
T = Letter 3 :: Letter DNA n
pattern $bN :: Letter DNA n
$mN :: forall r k (n :: k).
Letter DNA n -> (Void# -> r) -> (Void# -> r) -> r
N = Letter 4 :: Letter DNA n

instance Enum (Letter DNA n) where
    succ :: Letter DNA n -> Letter DNA n
succ Letter DNA n
N          = [Char] -> Letter DNA n
forall a. HasCallStack => [Char] -> a
error [Char]
"succ/N:DNA"
    succ (Letter Int
x) = Int -> Letter DNA n
forall k seqTy (nameTy :: k). Int -> Letter seqTy nameTy
Letter (Int -> Letter DNA n) -> Int -> Letter DNA n
forall a b. (a -> b) -> a -> b
$ Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
    pred :: Letter DNA n -> Letter DNA n
pred Letter DNA n
A          = [Char] -> Letter DNA n
forall a. HasCallStack => [Char] -> a
error [Char]
"pred/A:DNA"
    pred (Letter Int
x) = Int -> Letter DNA n
forall k seqTy (nameTy :: k). Int -> Letter seqTy nameTy
Letter (Int -> Letter DNA n) -> Int -> Letter DNA n
forall a b. (a -> b) -> a -> b
$ Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
    toEnum :: Int -> Letter DNA n
toEnum Int
k | Int
kInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0 Bool -> Bool -> Bool
&& Int
kInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
4 = Int -> Letter DNA n
forall k seqTy (nameTy :: k). Int -> Letter seqTy nameTy
Letter Int
k
    toEnum Int
k                = [Char] -> Letter DNA n
forall a. HasCallStack => [Char] -> a
error ([Char] -> Letter DNA n) -> [Char] -> Letter DNA n
forall a b. (a -> b) -> a -> b
$ [Char]
"toEnum/Letter DNA " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k
    fromEnum :: Letter DNA n -> Int
fromEnum (Letter Int
k) = Int
k

instance LetterChar DNA n where
  letterChar :: Letter DNA n -> Char
letterChar = Letter DNA n -> Char
forall k (n :: k). Letter DNA n -> Char
dnaChar
  charLetter :: Char -> Letter DNA n
charLetter = Char -> Letter DNA n
forall k (n :: k). Char -> Letter DNA n
charDNA

--instance (LetterChar DNA) => ToJSON (Primary DNA) where
--  toJSON = toJSON . VU.toList . VU.map letterChar
--
--instance (MkPrimary (VU.Vector Char) DNA) => FromJSON (Primary DNA) where
--  parseJSON = fmap (primary :: String -> Primary DNA) . parseJSON

acgt :: [Letter DNA n]
acgt :: [Letter DNA n]
acgt = [Letter DNA n
forall k (n :: k). Letter DNA n
A .. Letter DNA n
forall k (n :: k). Letter DNA n
T]

charDNA :: Char -> Letter DNA n
charDNA = Char -> Char
toUpper (Char -> Char) -> (Char -> Letter DNA n) -> Char -> Letter DNA n
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
    Char
'A' -> Letter DNA n
forall k (n :: k). Letter DNA n
A
    Char
'C' -> Letter DNA n
forall k (n :: k). Letter DNA n
C
    Char
'G' -> Letter DNA n
forall k (n :: k). Letter DNA n
G
    Char
'T' -> Letter DNA n
forall k (n :: k). Letter DNA n
T
    Char
_   -> Letter DNA n
forall k (n :: k). Letter DNA n
N
{-# INLINE charDNA #-}

dnaChar :: Letter DNA n -> Char
dnaChar = \case
  Letter DNA n
A -> Char
'A'
  Letter DNA n
C -> Char
'C'
  Letter DNA n
G -> Char
'G'
  Letter DNA n
T -> Char
'T'
  Letter DNA n
N -> Char
'N'
{-# INLINE dnaChar #-}

-- | An isomorphism from 'Char' to 'Letter DNA'. This assumes that the
-- underlying @Char@s actually represent a DNA sequence. This allows typesafe
-- modification of DNA sequences since only @[A,C,G,T,N]@ are allowed.

cdna ∷ Iso' Char (Letter DNA n)
cdna :: p (Letter DNA n) (f (Letter DNA n)) -> p Char (f Char)
cdna = (Char -> Letter DNA n)
-> (Letter DNA n -> Char)
-> Iso Char Char (Letter DNA n) (Letter DNA n)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Char -> Letter DNA n
forall k (n :: k). Char -> Letter DNA n
charDNA Letter DNA n -> Char
forall k (n :: k). Letter DNA n -> Char
dnaChar

instance Show (Letter DNA n) where
    show :: Letter DNA n -> [Char]
show Letter DNA n
c = [Letter DNA n -> Char
forall k (n :: k). Letter DNA n -> Char
dnaChar Letter DNA n
c]

instance Read (Letter DNA n) where
  readsPrec :: Int -> ReadS (Letter DNA n)
readsPrec Int
p [] = []
  readsPrec Int
p (Char
x:[Char]
xs)
    | Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ' = Int -> ReadS (Letter DNA n)
forall a. Read a => Int -> ReadS a
readsPrec Int
p [Char]
xs
    | Bool
otherwise = [(Char -> Letter DNA n
forall k (n :: k). Char -> Letter DNA n
charDNA Char
x, [Char]
xs)]

dnaSeq :: MkPrimary p DNA n => p -> Primary DNA n
dnaSeq :: p -> Primary DNA n
dnaSeq = p -> Primary DNA n
forall k c t (n :: k). MkPrimary c t n => c -> Primary t n
primary

instance Bounded (Letter DNA n) where
    minBound :: Letter DNA n
minBound = Letter DNA n
forall k (n :: k). Letter DNA n
A
    maxBound :: Letter DNA n
maxBound = Letter DNA n
forall k (n :: k). Letter DNA n
N

instance MkPrimary (VU.Vector Char) DNA n where
    primary :: Vector Char -> Primary DNA n
primary = (Char -> Letter DNA n) -> Vector Char -> Primary DNA n
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
VU.map Char -> Letter DNA n
forall k (n :: k). Char -> Letter DNA n
charDNA

instance IsString [Letter DNA n] where
    fromString :: [Char] -> [Letter DNA n]
fromString = (Char -> Letter DNA n) -> [Char] -> [Letter DNA n]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Letter DNA n
forall k (n :: k). Char -> Letter DNA n
charDNA