{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE StandaloneDeriving #-}

module Bio.Chain.Alignment.Type where

import           Bio.Chain          (ChainLike (..))
import           Control.DeepSeq    (NFData (..))
import           Control.Lens       (Index, IxValue)
import           Data.Array.Unboxed (Ix, UArray)
import           Data.Kind          (Type)
import           GHC.Generics       (Generic (..))

-- | Scoring function, returns substitution score for a couple of elements
--
-- type Scoring = Char -> Char -> Int

type Scoring a b = a -> b -> Int

-- | Simple gap penalty
--
type SimpleGap = Int

-- | Gap penalty with different 'SimpleGap' penalties for sequences.
--
-- First element of pair is penalty for first sequence passed to alignment
-- algorithm, second element — penalty for second passed sequence.
--
type SimpleGap2 = (SimpleGap, SimpleGap)

-- | Affine gap penalty
--
data AffineGap = AffineGap { AffineGap -> SimpleGap
gapOpen   :: Int
                           , AffineGap -> SimpleGap
gapExtend :: Int
                           }
  deriving (SimpleGap -> AffineGap -> ShowS
[AffineGap] -> ShowS
AffineGap -> String
forall a.
(SimpleGap -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AffineGap] -> ShowS
$cshowList :: [AffineGap] -> ShowS
show :: AffineGap -> String
$cshow :: AffineGap -> String
showsPrec :: SimpleGap -> AffineGap -> ShowS
$cshowsPrec :: SimpleGap -> AffineGap -> ShowS
Show, AffineGap -> AffineGap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AffineGap -> AffineGap -> Bool
$c/= :: AffineGap -> AffineGap -> Bool
== :: AffineGap -> AffineGap -> Bool
$c== :: AffineGap -> AffineGap -> Bool
Eq, forall x. Rep AffineGap x -> AffineGap
forall x. AffineGap -> Rep AffineGap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AffineGap x -> AffineGap
$cfrom :: forall x. AffineGap -> Rep AffineGap x
Generic, AffineGap -> ()
forall a. (a -> ()) -> NFData a
rnf :: AffineGap -> ()
$crnf :: AffineGap -> ()
NFData)

-- | Gap penalty with different 'AffineGap' penalties for sequences.
--
-- First element of pair is penalty for first sequence passed to alignment
-- algorithm, second element — penalty for second passed sequence.
--
type AffineGap2 = (AffineGap, AffineGap)

-- | Type class that describes possible gaps in alignments.
--
class IsGap a where
  -- | Insertions are gaps in the first argument of an alignment function.
  --
  insertCostOpen :: a -> Int
  insertCostExtend :: a -> Int

  -- | Deletions are gaps in the second argument of an alignment function.
  --
  deleteCostOpen :: a -> Int
  deleteCostExtend :: a -> Int

  isAffine :: a -> Bool
  isAffine a
x = forall a. IsGap a => a -> SimpleGap
insertCostOpen a
x forall a. Eq a => a -> a -> Bool
/= forall a. IsGap a => a -> SimpleGap
insertCostExtend a
x Bool -> Bool -> Bool
|| forall a. IsGap a => a -> SimpleGap
deleteCostOpen a
x forall a. Eq a => a -> a -> Bool
/= forall a. IsGap a => a -> SimpleGap
deleteCostExtend a
x

instance IsGap SimpleGap where
  insertCostOpen :: SimpleGap -> SimpleGap
insertCostOpen = forall a. a -> a
id
  insertCostExtend :: SimpleGap -> SimpleGap
insertCostExtend = forall a. a -> a
id

  deleteCostOpen :: SimpleGap -> SimpleGap
deleteCostOpen = forall a. a -> a
id
  deleteCostExtend :: SimpleGap -> SimpleGap
deleteCostExtend = forall a. a -> a
id

instance IsGap SimpleGap2 where
  insertCostOpen :: SimpleGap2 -> SimpleGap
insertCostOpen = forall a b. (a, b) -> a
fst
  insertCostExtend :: SimpleGap2 -> SimpleGap
insertCostExtend = forall a b. (a, b) -> a
fst

  deleteCostOpen :: SimpleGap2 -> SimpleGap
deleteCostOpen = forall a b. (a, b) -> b
snd
  deleteCostExtend :: SimpleGap2 -> SimpleGap
deleteCostExtend = forall a b. (a, b) -> b
snd

instance IsGap AffineGap where
  insertCostOpen :: AffineGap -> SimpleGap
insertCostOpen = AffineGap -> SimpleGap
gapOpen
  insertCostExtend :: AffineGap -> SimpleGap
insertCostExtend = AffineGap -> SimpleGap
gapExtend

  deleteCostOpen :: AffineGap -> SimpleGap
deleteCostOpen = AffineGap -> SimpleGap
gapOpen
  deleteCostExtend :: AffineGap -> SimpleGap
deleteCostExtend = AffineGap -> SimpleGap
gapExtend

instance IsGap AffineGap2 where
  insertCostOpen :: AffineGap2 -> SimpleGap
insertCostOpen = AffineGap -> SimpleGap
gapOpen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
  insertCostExtend :: AffineGap2 -> SimpleGap
insertCostExtend = AffineGap -> SimpleGap
gapExtend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst

  deleteCostOpen :: AffineGap2 -> SimpleGap
deleteCostOpen = AffineGap -> SimpleGap
gapOpen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
  deleteCostExtend :: AffineGap2 -> SimpleGap
deleteCostExtend = AffineGap -> SimpleGap
gapExtend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd

-- | Edit operation could be insertion, deletion or match/mismatch
--
data EditOp = Insert | Delete | Match
  deriving (SimpleGap -> EditOp -> ShowS
[EditOp] -> ShowS
EditOp -> String
forall a.
(SimpleGap -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EditOp] -> ShowS
$cshowList :: [EditOp] -> ShowS
show :: EditOp -> String
$cshow :: EditOp -> String
showsPrec :: SimpleGap -> EditOp -> ShowS
$cshowsPrec :: SimpleGap -> EditOp -> ShowS
Show, EditOp -> EditOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EditOp -> EditOp -> Bool
$c/= :: EditOp -> EditOp -> Bool
== :: EditOp -> EditOp -> Bool
$c== :: EditOp -> EditOp -> Bool
Eq, Eq EditOp
EditOp -> EditOp -> Bool
EditOp -> EditOp -> Ordering
EditOp -> EditOp -> EditOp
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 :: EditOp -> EditOp -> EditOp
$cmin :: EditOp -> EditOp -> EditOp
max :: EditOp -> EditOp -> EditOp
$cmax :: EditOp -> EditOp -> EditOp
>= :: EditOp -> EditOp -> Bool
$c>= :: EditOp -> EditOp -> Bool
> :: EditOp -> EditOp -> Bool
$c> :: EditOp -> EditOp -> Bool
<= :: EditOp -> EditOp -> Bool
$c<= :: EditOp -> EditOp -> Bool
< :: EditOp -> EditOp -> Bool
$c< :: EditOp -> EditOp -> Bool
compare :: EditOp -> EditOp -> Ordering
$ccompare :: EditOp -> EditOp -> Ordering
Ord, EditOp
forall a. a -> a -> Bounded a
maxBound :: EditOp
$cmaxBound :: EditOp
minBound :: EditOp
$cminBound :: EditOp
Bounded, SimpleGap -> EditOp
EditOp -> SimpleGap
EditOp -> [EditOp]
EditOp -> EditOp
EditOp -> EditOp -> [EditOp]
EditOp -> EditOp -> EditOp -> [EditOp]
forall a.
(a -> a)
-> (a -> a)
-> (SimpleGap -> a)
-> (a -> SimpleGap)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EditOp -> EditOp -> EditOp -> [EditOp]
$cenumFromThenTo :: EditOp -> EditOp -> EditOp -> [EditOp]
enumFromTo :: EditOp -> EditOp -> [EditOp]
$cenumFromTo :: EditOp -> EditOp -> [EditOp]
enumFromThen :: EditOp -> EditOp -> [EditOp]
$cenumFromThen :: EditOp -> EditOp -> [EditOp]
enumFrom :: EditOp -> [EditOp]
$cenumFrom :: EditOp -> [EditOp]
fromEnum :: EditOp -> SimpleGap
$cfromEnum :: EditOp -> SimpleGap
toEnum :: SimpleGap -> EditOp
$ctoEnum :: SimpleGap -> EditOp
pred :: EditOp -> EditOp
$cpred :: EditOp -> EditOp
succ :: EditOp -> EditOp
$csucc :: EditOp -> EditOp
Enum, Ord EditOp
(EditOp, EditOp) -> SimpleGap
(EditOp, EditOp) -> [EditOp]
(EditOp, EditOp) -> EditOp -> Bool
(EditOp, EditOp) -> EditOp -> SimpleGap
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> SimpleGap)
-> ((a, a) -> a -> SimpleGap)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> SimpleGap)
-> ((a, a) -> SimpleGap)
-> Ix a
unsafeRangeSize :: (EditOp, EditOp) -> SimpleGap
$cunsafeRangeSize :: (EditOp, EditOp) -> SimpleGap
rangeSize :: (EditOp, EditOp) -> SimpleGap
$crangeSize :: (EditOp, EditOp) -> SimpleGap
inRange :: (EditOp, EditOp) -> EditOp -> Bool
$cinRange :: (EditOp, EditOp) -> EditOp -> Bool
unsafeIndex :: (EditOp, EditOp) -> EditOp -> SimpleGap
$cunsafeIndex :: (EditOp, EditOp) -> EditOp -> SimpleGap
index :: (EditOp, EditOp) -> EditOp -> SimpleGap
$cindex :: (EditOp, EditOp) -> EditOp -> SimpleGap
range :: (EditOp, EditOp) -> [EditOp]
$crange :: (EditOp, EditOp) -> [EditOp]
Ix, forall x. Rep EditOp x -> EditOp
forall x. EditOp -> Rep EditOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EditOp x -> EditOp
$cfrom :: forall x. EditOp -> Rep EditOp x
Generic, EditOp -> ()
forall a. (a -> ()) -> NFData a
rnf :: EditOp -> ()
$crnf :: EditOp -> ()
NFData)

-- | Operation that was performed on current step of alignment
--
data Operation i j = INSERT {            forall i j. Operation i j -> j
getJ :: j }
                   | DELETE { forall i j. Operation i j -> i
getI :: i            }
                   | MATCH  { getI :: i, getJ :: j }
  deriving (SimpleGap -> Operation i j -> ShowS
forall a.
(SimpleGap -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
forall i j. (Show j, Show i) => SimpleGap -> Operation i j -> ShowS
forall i j. (Show j, Show i) => [Operation i j] -> ShowS
forall i j. (Show j, Show i) => Operation i j -> String
showList :: [Operation i j] -> ShowS
$cshowList :: forall i j. (Show j, Show i) => [Operation i j] -> ShowS
show :: Operation i j -> String
$cshow :: forall i j. (Show j, Show i) => Operation i j -> String
showsPrec :: SimpleGap -> Operation i j -> ShowS
$cshowsPrec :: forall i j. (Show j, Show i) => SimpleGap -> Operation i j -> ShowS
Show, Operation i j -> Operation i j -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall i j. (Eq j, Eq i) => Operation i j -> Operation i j -> Bool
/= :: Operation i j -> Operation i j -> Bool
$c/= :: forall i j. (Eq j, Eq i) => Operation i j -> Operation i j -> Bool
== :: Operation i j -> Operation i j -> Bool
$c== :: forall i j. (Eq j, Eq i) => Operation i j -> Operation i j -> Bool
Eq, Operation i j -> Operation i j -> Bool
Operation i j -> Operation i j -> Ordering
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
forall {i} {j}. (Ord j, Ord i) => Eq (Operation i j)
forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Bool
forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Ordering
forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Operation i j
min :: Operation i j -> Operation i j -> Operation i j
$cmin :: forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Operation i j
max :: Operation i j -> Operation i j -> Operation i j
$cmax :: forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Operation i j
>= :: Operation i j -> Operation i j -> Bool
$c>= :: forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Bool
> :: Operation i j -> Operation i j -> Bool
$c> :: forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Bool
<= :: Operation i j -> Operation i j -> Bool
$c<= :: forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Bool
< :: Operation i j -> Operation i j -> Bool
$c< :: forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Bool
compare :: Operation i j -> Operation i j -> Ordering
$ccompare :: forall i j.
(Ord j, Ord i) =>
Operation i j -> Operation i j -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall i j x. Rep (Operation i j) x -> Operation i j
forall i j x. Operation i j -> Rep (Operation i j) x
$cto :: forall i j x. Rep (Operation i j) x -> Operation i j
$cfrom :: forall i j x. Operation i j -> Rep (Operation i j) x
Generic, forall a. (a -> ()) -> NFData a
forall i j. (NFData j, NFData i) => Operation i j -> ()
rnf :: Operation i j -> ()
$crnf :: forall i j. (NFData j, NFData i) => Operation i j -> ()
NFData)

isInsert, isDelete, isMatch :: Operation i j -> Bool

isInsert :: forall i j. Operation i j -> Bool
isInsert INSERT{} = Bool
True
isInsert Operation i j
_        = Bool
False

isDelete :: forall i j. Operation i j -> Bool
isDelete DELETE{} = Bool
True
isDelete Operation i j
_        = Bool
False

isMatch :: forall i j. Operation i j -> Bool
isMatch MATCH{} = Bool
True
isMatch Operation i j
_       = Bool
False

-- | Alignment matrix type
--
type Matrix m m' = UArray (Index m, Index m', EditOp) Int

-- | Traceback stop condition type
--
type Stop m m' = Matrix m m' -> m -> m' -> Index m -> Index m' -> Bool

-- | Traceback next move generator type
--
type Move m m'
  =  Matrix m m'
  -> m -> m'
  -> Index m -> Index m'
  -> EditOp -- ^ Current matrix, used in affine alignment
  -> (EditOp, Index m, Index m', Operation (Index m) (Index m'))
     -- ^ Next matrix, next indices, new operation

-- | A set of traceback conditions
--
data Conditions m m' = Conditions { forall m m'. Conditions m m' -> Stop m m'
isStop :: Stop m m' -- ^ Should we stop?
                                  , forall m m'. Conditions m m' -> Move m m'
doMove :: Move m m' -- ^ Where to go next?
                                  }

-- | Sequence Alignment result
--
data AlignmentResult m m' = AlignmentResult { forall m m'. AlignmentResult m m' -> SimpleGap
score     :: Int                              -- ^ Resulting score of alignment
                                            , forall m m'.
AlignmentResult m m' -> [Operation (Index m) (Index m')]
alignment :: [Operation (Index m) (Index m')] -- ^ Alignment structure
                                            , forall m m'. AlignmentResult m m' -> m
sequence1 :: m                                -- ^ First chain
                                            , forall m m'. AlignmentResult m m' -> m'
sequence2 :: m'                               -- ^ Second chain
                                            }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall m m' x. Rep (AlignmentResult m m') x -> AlignmentResult m m'
forall m m' x. AlignmentResult m m' -> Rep (AlignmentResult m m') x
$cto :: forall m m' x. Rep (AlignmentResult m m') x -> AlignmentResult m m'
$cfrom :: forall m m' x. AlignmentResult m m' -> Rep (AlignmentResult m m') x
Generic)

instance (NFData a, NFData b) => NFData (UArray (a, b, EditOp) Int) where
  rnf :: UArray (a, b, EditOp) SimpleGap -> ()
rnf UArray (a, b, EditOp) SimpleGap
a = seq :: forall a b. a -> b -> b
seq UArray (a, b, EditOp) SimpleGap
a ()

deriving instance (NFData a, NFData b, NFData (Index a), NFData (Index b))
         => NFData (AlignmentResult a b)

-- | Chain, that can be used for alignment
--
type Alignable m = (ChainLike m, Ix (Index m))

-- |Method of sequence alignment
--
class SequenceAlignment (a :: Type -> Type -> Type) where
    -- | Defines wheater the alignment is semiglobal or not
    --
    semi :: a e1 e2 -> Bool
    {-# INLINABLE semi #-}
    semi = forall a b. a -> b -> a
const Bool
False

    -- | Traceback conditions of alignment
    --
    cond :: (Alignable m, Alignable m') => a (IxValue m) (IxValue m') -> Conditions m m'

    -- | Starting position in matrix for traceback procedure
    --
    traceStart :: (Alignable m, Alignable m') => a (IxValue m) (IxValue m') -> Matrix m m' -> m -> m' -> (Index m, Index m')

    -- | Distance matrix element
    --
    scoreMatrix :: (Alignable m, Alignable m') => a (IxValue m) (IxValue m') -> m -> m' -> Matrix m m'