-- | Annotate the genomic @position@ of features or elements. A @position@ has strand information,
-- and different ways to encode where a feature is located. The @position@ points to the first
-- element (e.g. nucleotide).
--
-- Together with the 'Biobase.Types.Location' module, it becomes possible to annotate substrings.

module Biobase.Types.Position where

import Control.DeepSeq
import Control.Lens hiding (Index, index)
import Data.Data
import GHC.Generics (Generic)
import GHC.TypeNats
import Prelude hiding (length)
import Text.Printf

import Biobase.Types.Index
import Biobase.Types.Strand
import Data.Info

{-

-- | Location information.

data Location = Location
  { _lStrand :: !Strand
  -- ^ On which strand are we
  , _lStart  :: !(Index 0)
  -- ^ Start, 0-based
  , _lLength :: !Int
  -- ^ number of characters in this location
  , _lTotalLength :: !Int
  -- ^ the total length of the "contig" (or whatever) this location is positioned in.
  } deriving (Eq,Ord,Read,Show,Generic)
makeLenses ''Location
makePrisms ''Location

instance NFData Location

instance Semigroup Location where
  x <> y = let f z = z { _lLength = _lLength x + _lLength y }
    in case x^.lStrand of
      MinusStrand  -> f y
      _otherStrand -> f x
  {-# Inline (<>) #-}

--instance Reversing Location where
--  {-# Inline reversing #-}
--  reversing = undefined


-- | An isomorphism between locations, and triples of @Strand,Start,End@, where
-- end is inclusive. For @length==0@ locations, this will mean @start<end@ on
-- the plus strand.
--
-- This should hold for all @k@, in @Index k@.

startEndInclusive :: (KnownNat k) => Iso' Location (Strand, (Index k, Index k), Int)
{-# Inline startEndInclusive #-}
startEndInclusive = iso l2r r2l
  where l2r z = let s = z^.lStrand; f = z^.lStart; l = z^.lLength
                in  (s, (reIndex f, reIndex $ f +. l -. 1), z^.lTotalLength)
        r2l (s,(f,t),ttl) = Location s (reIndex f) (delta f t + 1) ttl

-}



-- | During streaming construction, it is possible that we know a feature is on the @-@ strand, but
-- the length of the contig is not known yet. In that case, 'FwdPosition' allows expressing the hit
-- in the coordinate system of the plus strand. Tools like blast do something similar, and express
-- locations on the minus as @y-x@ with @y>x@.
--
-- @
-- 0123456789
--  >-->
--      <--<
-- 9876543210
-- @
--
-- 

data FwdPosition
  -- | "Plus"-based location.
  = FwdPosition
      { FwdPosition -> Strand
_fwdStrand :: !Strand
      -- ^ Strand we are on
      , FwdPosition -> Index 0
_fwdStart  :: !(Index 0)
      -- ^ Start of the hit on the plus strand
      }
  deriving (FwdPosition -> FwdPosition -> Bool
(FwdPosition -> FwdPosition -> Bool)
-> (FwdPosition -> FwdPosition -> Bool) -> Eq FwdPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FwdPosition -> FwdPosition -> Bool
$c/= :: FwdPosition -> FwdPosition -> Bool
== :: FwdPosition -> FwdPosition -> Bool
$c== :: FwdPosition -> FwdPosition -> Bool
Eq,Eq FwdPosition
Eq FwdPosition
-> (FwdPosition -> FwdPosition -> Ordering)
-> (FwdPosition -> FwdPosition -> Bool)
-> (FwdPosition -> FwdPosition -> Bool)
-> (FwdPosition -> FwdPosition -> Bool)
-> (FwdPosition -> FwdPosition -> Bool)
-> (FwdPosition -> FwdPosition -> FwdPosition)
-> (FwdPosition -> FwdPosition -> FwdPosition)
-> Ord FwdPosition
FwdPosition -> FwdPosition -> Bool
FwdPosition -> FwdPosition -> Ordering
FwdPosition -> FwdPosition -> FwdPosition
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 :: FwdPosition -> FwdPosition -> FwdPosition
$cmin :: FwdPosition -> FwdPosition -> FwdPosition
max :: FwdPosition -> FwdPosition -> FwdPosition
$cmax :: FwdPosition -> FwdPosition -> FwdPosition
>= :: FwdPosition -> FwdPosition -> Bool
$c>= :: FwdPosition -> FwdPosition -> Bool
> :: FwdPosition -> FwdPosition -> Bool
$c> :: FwdPosition -> FwdPosition -> Bool
<= :: FwdPosition -> FwdPosition -> Bool
$c<= :: FwdPosition -> FwdPosition -> Bool
< :: FwdPosition -> FwdPosition -> Bool
$c< :: FwdPosition -> FwdPosition -> Bool
compare :: FwdPosition -> FwdPosition -> Ordering
$ccompare :: FwdPosition -> FwdPosition -> Ordering
$cp1Ord :: Eq FwdPosition
Ord,ReadPrec [FwdPosition]
ReadPrec FwdPosition
Int -> ReadS FwdPosition
ReadS [FwdPosition]
(Int -> ReadS FwdPosition)
-> ReadS [FwdPosition]
-> ReadPrec FwdPosition
-> ReadPrec [FwdPosition]
-> Read FwdPosition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FwdPosition]
$creadListPrec :: ReadPrec [FwdPosition]
readPrec :: ReadPrec FwdPosition
$creadPrec :: ReadPrec FwdPosition
readList :: ReadS [FwdPosition]
$creadList :: ReadS [FwdPosition]
readsPrec :: Int -> ReadS FwdPosition
$creadsPrec :: Int -> ReadS FwdPosition
Read,Int -> FwdPosition -> ShowS
[FwdPosition] -> ShowS
FwdPosition -> String
(Int -> FwdPosition -> ShowS)
-> (FwdPosition -> String)
-> ([FwdPosition] -> ShowS)
-> Show FwdPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FwdPosition] -> ShowS
$cshowList :: [FwdPosition] -> ShowS
show :: FwdPosition -> String
$cshow :: FwdPosition -> String
showsPrec :: Int -> FwdPosition -> ShowS
$cshowsPrec :: Int -> FwdPosition -> ShowS
Show,Typeable FwdPosition
DataType
Constr
Typeable FwdPosition
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FwdPosition -> c FwdPosition)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FwdPosition)
-> (FwdPosition -> Constr)
-> (FwdPosition -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FwdPosition))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FwdPosition))
-> ((forall b. Data b => b -> b) -> FwdPosition -> FwdPosition)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FwdPosition -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FwdPosition -> r)
-> (forall u. (forall d. Data d => d -> u) -> FwdPosition -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FwdPosition -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FwdPosition -> m FwdPosition)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FwdPosition -> m FwdPosition)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FwdPosition -> m FwdPosition)
-> Data FwdPosition
FwdPosition -> DataType
FwdPosition -> Constr
(forall b. Data b => b -> b) -> FwdPosition -> FwdPosition
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FwdPosition -> c FwdPosition
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FwdPosition
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FwdPosition -> u
forall u. (forall d. Data d => d -> u) -> FwdPosition -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FwdPosition -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FwdPosition -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FwdPosition -> m FwdPosition
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FwdPosition -> m FwdPosition
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FwdPosition
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FwdPosition -> c FwdPosition
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FwdPosition)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FwdPosition)
$cFwdPosition :: Constr
$tFwdPosition :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> FwdPosition -> m FwdPosition
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FwdPosition -> m FwdPosition
gmapMp :: (forall d. Data d => d -> m d) -> FwdPosition -> m FwdPosition
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FwdPosition -> m FwdPosition
gmapM :: (forall d. Data d => d -> m d) -> FwdPosition -> m FwdPosition
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FwdPosition -> m FwdPosition
gmapQi :: Int -> (forall d. Data d => d -> u) -> FwdPosition -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FwdPosition -> u
gmapQ :: (forall d. Data d => d -> u) -> FwdPosition -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FwdPosition -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FwdPosition -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FwdPosition -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FwdPosition -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FwdPosition -> r
gmapT :: (forall b. Data b => b -> b) -> FwdPosition -> FwdPosition
$cgmapT :: (forall b. Data b => b -> b) -> FwdPosition -> FwdPosition
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FwdPosition)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FwdPosition)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c FwdPosition)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FwdPosition)
dataTypeOf :: FwdPosition -> DataType
$cdataTypeOf :: FwdPosition -> DataType
toConstr :: FwdPosition -> Constr
$ctoConstr :: FwdPosition -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FwdPosition
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FwdPosition
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FwdPosition -> c FwdPosition
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FwdPosition -> c FwdPosition
$cp1Data :: Typeable FwdPosition
Data,Typeable,(forall x. FwdPosition -> Rep FwdPosition x)
-> (forall x. Rep FwdPosition x -> FwdPosition)
-> Generic FwdPosition
forall x. Rep FwdPosition x -> FwdPosition
forall x. FwdPosition -> Rep FwdPosition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FwdPosition x -> FwdPosition
$cfrom :: forall x. FwdPosition -> Rep FwdPosition x
Generic)
makeLenses ''FwdPosition
makePrisms ''FwdPosition

instance NFData FwdPosition

instance Info FwdPosition where
  info :: FwdPosition -> String
info (FwdPosition Strand
s Index 0
x) = String -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%s %d" (Strand -> String
forall a. Show a => a -> String
show Strand
s) (Index 0 -> Int
forall (t :: Nat). KnownNat t => Index t -> Int
toInt0 Index 0
x)

-- | Reversing a reversible location means moving the start to the end.

instance Reversing FwdPosition where
  {-# Inline reversing #-}
  reversing :: FwdPosition -> FwdPosition
reversing FwdPosition
x = case FwdPosition
xFwdPosition -> Getting Strand FwdPosition Strand -> Strand
forall s a. s -> Getting a s a -> a
^.Getting Strand FwdPosition Strand
Lens' FwdPosition Strand
fwdStrand of
    Strand
PlusStrand    -> ASetter FwdPosition FwdPosition Strand Strand
-> Strand -> FwdPosition -> FwdPosition
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter FwdPosition FwdPosition Strand Strand
Lens' FwdPosition Strand
fwdStrand Strand
MinusStrand (FwdPosition -> FwdPosition) -> FwdPosition -> FwdPosition
forall a b. (a -> b) -> a -> b
$ FwdPosition
x
    Strand
MinusStrand   -> ASetter FwdPosition FwdPosition Strand Strand
-> Strand -> FwdPosition -> FwdPosition
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter FwdPosition FwdPosition Strand Strand
Lens' FwdPosition Strand
fwdStrand Strand
PlusStrand  (FwdPosition -> FwdPosition) -> FwdPosition -> FwdPosition
forall a b. (a -> b) -> a -> b
$ FwdPosition
x
    Strand
UnknownStrand -> FwdPosition
x

{-


-- | Combining two FwdLocations yields the sum of their lengths. This assumes
-- that @x@ and @y@ are next to each other, or that it is ok if the @y@
-- @fwdStart@ information may be lost.
--
-- TODO provide associativity test in @properties@.

instance Semigroup FwdLocation where
  x <> y = over fwdLength (+ view fwdLength y) x
  {-# Inline (<>) #-}

instance ModifyLocation FwdLocation where
  locMoveLeftEnd k = over fwdStart (+. k) . over fwdLength (subtract k)
  locMoveRightEnd k = over fwdLength (+k)

-- | Given a location, take at most @k@ elements, and return a location after
-- this change.

fwdLocationTake :: Int -> FwdLocation -> FwdLocation
{-# Inline fwdLocationTake #-}
fwdLocationTake k' x =
  let l = x^.fwdLength
      k = max 0 $ min k' l      -- deal with at most the length of the location
  in case x^.fwdStrand of
    MinusStrand  -> set fwdLength k $ over fwdStart (+. (l-k)) x
    _otherStrand -> set fwdLength k $                          x

-- | Given a location, drop at most @k@ elements, and return a location after
-- this change.
--
-- Note that @fwdLocationDrop 4 (FwdLocation PlusStrand 0 4) == FwdLocation 4 0@

fwdLocationDrop :: Int -> FwdLocation -> FwdLocation
{-# Inline fwdLocationDrop #-}
fwdLocationDrop k' x =
  let l = x^.fwdLength
      k = max 0 $ min k' l
  in case x^.fwdStrand of
    MinusStrand  -> set fwdLength (l-k) $                            x
    _otherStrand -> set fwdLength (l-k) $ over fwdStart (+. min k l) x

-- -- An isomorphism between a 'Location' and the pair @('FwdLocation',Int)@
-- -- exists.
-- 
-- locationPartial :: Iso' Location (FwdLocation,Int)
-- {-# Inline locationPartial #-}
-- locationPartial = iso l2r r2l where
--   l2r l = undefined
--   r2l (p,z) = undefined

-}