module Bio.Sequence.Range 
  ( Range (..)
  , Border (..)
  , RangeBorder (..)
  , borderType
  , borderLocation
  , location
  , lower
  , upper
  , before
  , after
  , ranges
  , range
  , checkRange
  , shiftRange
  , mapRange
  , swapRange
  , point
  , preciseSpan
  , between
  , extendRight
  , extendLeft
  , overlap
  , rangeMargins
  ) where

import Control.DeepSeq (NFData)
import Control.Lens    (makeLenses)
import GHC.Generics    (Generic)

-- | The type of range border. A border is @Exceeded@ when its end point is beyond the
-- specified base number, otherwise it is @Precise@.
-- In GenBank, for example, @Exceeded@ borders are marked with < and >.
--
data Border
  = Precise
  | Exceeded
  deriving (Border -> Border -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Border -> Border -> Bool
$c/= :: Border -> Border -> Bool
== :: Border -> Border -> Bool
$c== :: Border -> Border -> Bool
Eq, Int -> Border -> ShowS
[Border] -> ShowS
Border -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Border] -> ShowS
$cshowList :: [Border] -> ShowS
show :: Border -> String
$cshow :: Border -> String
showsPrec :: Int -> Border -> ShowS
$cshowsPrec :: Int -> Border -> ShowS
Show, forall x. Rep Border x -> Border
forall x. Border -> Rep Border x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Border x -> Border
$cfrom :: forall x. Border -> Rep Border x
Generic, Border -> ()
forall a. (a -> ()) -> NFData a
rnf :: Border -> ()
$crnf :: Border -> ()
NFData)

-- | The end point of a range with indication whether it is @Precise@ of @Exceeded@ (see @Border@).
--
data RangeBorder
  = RangeBorder
      { RangeBorder -> Border
_borderType     :: Border
      , RangeBorder -> Int
_borderLocation :: Int
      }
  deriving (RangeBorder -> RangeBorder -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RangeBorder -> RangeBorder -> Bool
$c/= :: RangeBorder -> RangeBorder -> Bool
== :: RangeBorder -> RangeBorder -> Bool
$c== :: RangeBorder -> RangeBorder -> Bool
Eq, Int -> RangeBorder -> ShowS
[RangeBorder] -> ShowS
RangeBorder -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RangeBorder] -> ShowS
$cshowList :: [RangeBorder] -> ShowS
show :: RangeBorder -> String
$cshow :: RangeBorder -> String
showsPrec :: Int -> RangeBorder -> ShowS
$cshowsPrec :: Int -> RangeBorder -> ShowS
Show, forall x. Rep RangeBorder x -> RangeBorder
forall x. RangeBorder -> Rep RangeBorder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RangeBorder x -> RangeBorder
$cfrom :: forall x. RangeBorder -> Rep RangeBorder x
Generic, RangeBorder -> ()
forall a. (a -> ()) -> NFData a
rnf :: RangeBorder -> ()
$crnf :: RangeBorder -> ()
NFData)

makeLenses ''RangeBorder

data Range
  = Point
      { Range -> Int
_location :: Int
      }
  -- ^ The exact location of a single base feature
  -- Example in GB:  conf            258
  | Span
      { Range -> RangeBorder
_lower :: RangeBorder
      , Range -> RangeBorder
_upper :: RangeBorder
      }
  -- ^ A region consisting of a simple span of bases.
  -- The symbols `<`and `>' are used to indicate that the beginning or end of the
  -- feature is beyond the range of the presented sequence.
  -- Examples in GB: tRNA            1..87
  --                 tRNA            <1..87     
  --                 tRNA            1..>87  
  | Between
      { Range -> Int
_before :: Int
      , Range -> Int
_after  :: Int
      }
  -- ^ The feature is between bases.
  -- Example in GB:  misc_recomb     105^106
  | Join
      { Range -> [Range]
_ranges :: [Range]
      }
  -- ^ The feature consists of the union of several ranges.
  -- Example in GB:  origin          join(1, 23..50, 77..>100)
  | Complement
      { Range -> Range
_range :: Range
      }
  -- ^ Indicates that the range is complementary.
  -- Example in GB:  rep             complement(69..420)
  deriving (Range -> Range -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c== :: Range -> Range -> Bool
Eq, Int -> Range -> ShowS
[Range] -> ShowS
Range -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Range] -> ShowS
$cshowList :: [Range] -> ShowS
show :: Range -> String
$cshow :: Range -> String
showsPrec :: Int -> Range -> ShowS
$cshowsPrec :: Int -> Range -> ShowS
Show, forall x. Rep Range x -> Range
forall x. Range -> Rep Range x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Range x -> Range
$cfrom :: forall x. Range -> Rep Range x
Generic, Range -> ()
forall a. (a -> ()) -> NFData a
rnf :: Range -> ()
$crnf :: Range -> ()
NFData)

makeLenses ''Range

point :: Int -> Range
point :: Int -> Range
point = Int -> Range
Point

preciseSpan :: (Int, Int) -> Range
preciseSpan :: (Int, Int) -> Range
preciseSpan (Int
lo, Int
hi) = RangeBorder -> RangeBorder -> Range
Span (Border -> Int -> RangeBorder
RangeBorder Border
Precise Int
lo) (Border -> Int -> RangeBorder
RangeBorder Border
Precise Int
hi)

between :: (Int, Int) -> Range
between :: (Int, Int) -> Range
between = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Range
Between

checkRange :: Int -> Range -> Bool
checkRange :: Int -> Range -> Bool
checkRange Int
len (Point Int
pos) = Int
0 forall a. Ord a => a -> a -> Bool
<= Int
pos Bool -> Bool -> Bool
&& Int
pos forall a. Ord a => a -> a -> Bool
< Int
len
checkRange Int
len (Span (RangeBorder Border
_ Int
lInd) (RangeBorder Border
_ Int
rInd)) = Int
lInd forall a. Ord a => a -> a -> Bool
< Int
rInd Bool -> Bool -> Bool
&& Int
0 forall a. Ord a => a -> a -> Bool
<= Int
lInd Bool -> Bool -> Bool
&& Int
rInd forall a. Ord a => a -> a -> Bool
< Int
len
checkRange Int
len (Between Int
lInd Int
rInd) = Int
lInd forall a. Ord a => a -> a -> Bool
< Int
rInd Bool -> Bool -> Bool
&& Int
0 forall a. Ord a => a -> a -> Bool
<= Int
lInd Bool -> Bool -> Bool
&& Int
rInd forall a. Ord a => a -> a -> Bool
<= Int
len
checkRange Int
len (Join [Range]
ranges') = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Range -> Bool
checkRange Int
len) [Range]
ranges'
checkRange Int
len (Complement Range
range') = Int -> Range -> Bool
checkRange Int
len Range
range'

mapRange :: (Int -> Int) -> Range -> Range
mapRange :: (Int -> Int) -> Range -> Range
mapRange Int -> Int
f (Point Int
pos) = Int -> Range
Point (Int -> Int
f Int
pos)
mapRange Int -> Int
f (Span (RangeBorder Border
bLo Int
lo) (RangeBorder Border
bHi Int
hi)) = RangeBorder -> RangeBorder -> Range
Span (Border -> Int -> RangeBorder
RangeBorder Border
bLo (Int -> Int
f Int
lo)) (Border -> Int -> RangeBorder
RangeBorder Border
bHi (Int -> Int
f Int
hi))
mapRange Int -> Int
f (Between Int
lo Int
hi) = Int -> Int -> Range
Between (Int -> Int
f Int
lo) (Int -> Int
f Int
hi)
mapRange Int -> Int
f (Join [Range]
ranges') = [Range] -> Range
Join forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Int) -> Range -> Range
mapRange Int -> Int
f) [Range]
ranges'
mapRange Int -> Int
f (Complement Range
range') = Range -> Range
Complement forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Range -> Range
mapRange Int -> Int
f Range
range'

shiftRange :: Int -> Range -> Range
shiftRange :: Int -> Range -> Range
shiftRange Int
delta = (Int -> Int) -> Range -> Range
mapRange (forall a. Num a => a -> a -> a
+ Int
delta) 

swapRange :: Range -> Range
swapRange :: Range -> Range
swapRange r :: Range
r@Point{}           = Range
r
swapRange (Span RangeBorder
brLo RangeBorder
brHi)    = RangeBorder -> RangeBorder -> Range
Span RangeBorder
brHi RangeBorder
brLo
swapRange (Between Int
lo Int
hi)     = Int -> Int -> Range
Between Int
hi Int
lo
swapRange (Join [Range]
ranges')      = [Range] -> Range
Join forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Range
swapRange [Range]
ranges'
swapRange (Complement Range
range') = Range -> Range
Complement forall a b. (a -> b) -> a -> b
$ Range -> Range
swapRange Range
range'

extendRight :: Int -> Range -> Range
extendRight :: Int -> Range -> Range
extendRight Int
delta (Point Int
a) = RangeBorder -> RangeBorder -> Range
Span (Border -> Int -> RangeBorder
RangeBorder Border
Precise Int
a) (Border -> Int -> RangeBorder
RangeBorder Border
Precise (Int
a forall a. Num a => a -> a -> a
+ Int
delta))
extendRight Int
delta (Span RangeBorder
lo (RangeBorder Border
r Int
hi)) = RangeBorder -> RangeBorder -> Range
Span RangeBorder
lo (Border -> Int -> RangeBorder
RangeBorder Border
r (Int
hi forall a. Num a => a -> a -> a
+ Int
delta))
extendRight Int
_ b :: Range
b@Between{} = Range
b
extendRight Int
delta (Join [Range]
ranges') = [Range] -> Range
Join forall a b. (a -> b) -> a -> b
$ Int -> Range -> Range
extendRight Int
delta forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Range]
ranges'
extendRight Int
delta (Complement Range
range') = Range -> Range
Complement forall a b. (a -> b) -> a -> b
$ Int -> Range -> Range
extendRight Int
delta Range
range'

extendLeft :: Int -> Range -> Range
extendLeft :: Int -> Range -> Range
extendLeft Int
delta (Point Int
a) = RangeBorder -> RangeBorder -> Range
Span (Border -> Int -> RangeBorder
RangeBorder Border
Precise (Int
a forall a. Num a => a -> a -> a
- Int
delta)) (Border -> Int -> RangeBorder
RangeBorder Border
Precise Int
a)
extendLeft Int
delta (Span (RangeBorder Border
r Int
lo) RangeBorder
hi) = RangeBorder -> RangeBorder -> Range
Span (Border -> Int -> RangeBorder
RangeBorder Border
r (Int
lo forall a. Num a => a -> a -> a
- Int
delta)) RangeBorder
hi
extendLeft Int
_ b :: Range
b@Between{} = Range
b
extendLeft Int
delta (Join [Range]
ranges') = [Range] -> Range
Join forall a b. (a -> b) -> a -> b
$ Int -> Range -> Range
extendLeft Int
delta forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Range]
ranges'
extendLeft Int
delta (Complement Range
range') = Range -> Range
Complement forall a b. (a -> b) -> a -> b
$ Int -> Range -> Range
extendLeft Int
delta Range
range'

overlap :: Range -> Range -> Bool
overlap :: Range -> Range -> Bool
overlap (Point Int
a) (Point Int
b) = Int
a forall a. Eq a => a -> a -> Bool
== Int
b
overlap (Point Int
a) (Span (RangeBorder Border
_ Int
lo) (RangeBorder Border
_ Int
hi)) = Int
lo forall a. Ord a => a -> a -> Bool
<= Int
a Bool -> Bool -> Bool
&& Int
a forall a. Ord a => a -> a -> Bool
<= Int
hi
overlap (Point Int
_) (Between Int
_ Int
_) = Bool
False

overlap (Span (RangeBorder Border
_ Int
lo1) (RangeBorder Border
_ Int
hi1)) (Span (RangeBorder Border
_ Int
lo2) (RangeBorder Border
_ Int
hi2)) = 
    (Int
lo1 forall a. Ord a => a -> a -> Bool
<= Int
lo2 Bool -> Bool -> Bool
&& Int
hi1 forall a. Ord a => a -> a -> Bool
>= Int
lo2) Bool -> Bool -> Bool
||
    (Int
lo1 forall a. Ord a => a -> a -> Bool
>= Int
lo2 Bool -> Bool -> Bool
&& Int
lo1 forall a. Ord a => a -> a -> Bool
<= Int
hi2) Bool -> Bool -> Bool
||
    (Int
lo1 forall a. Ord a => a -> a -> Bool
<= Int
lo2 Bool -> Bool -> Bool
&& Int
hi1 forall a. Ord a => a -> a -> Bool
>= Int
hi2)
overlap (Span (RangeBorder Border
_ Int
lo) (RangeBorder Border
_ Int
hi)) (Between Int
b1 Int
b2) = Int
b1 forall a. Ord a => a -> a -> Bool
>= Int
lo Bool -> Bool -> Bool
&& Int
b2 forall a. Ord a => a -> a -> Bool
<= Int
hi

overlap b1 :: Range
b1@Between{} b2 :: Range
b2@Between{} = Range
b1 forall a. Eq a => a -> a -> Bool
== Range
b2

overlap Range
r1 (Join [Range]
ranges') = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Range -> Range -> Bool
overlap Range
r1) [Range]
ranges'
overlap Range
r1 (Complement Range
range') = Range -> Range -> Bool
overlap Range
r1 Range
range'

overlap Range
r1 Range
r2 = Range -> Range -> Bool
overlap Range
r2 Range
r1

rangeMargins :: Range -> (Int, Int)
rangeMargins :: Range -> (Int, Int)
rangeMargins Range
rng = 
    case Range
rng of
      Point Int
x -> (Int
x, Int
x)
      Span (RangeBorder Border
_ Int
lo) (RangeBorder Border
_ Int
hi) -> (Int
lo, Int
hi)
      Between Int
lo Int
hi -> (Int
lo, Int
hi)
      Join [Range]
children -> let ([Int]
los, [Int]
his) = forall a b. [(a, b)] -> ([a], [b])
unzip (Range -> (Int, Int)
rangeMargins forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Range]
children) 
                        in (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int]
los, forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
his)
      Complement Range
child -> Range -> (Int, Int)
rangeMargins Range
child