{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns         #-}

module Bio.Sequence.Functions.Sequence
  ( drop
  , getRange, unsafeGetRange
  , length, null
  , reverse
  , tail
  , take
  , toList
  , (!), (!?)
  ) where

import           Control.Lens
import           Control.Monad.Except (MonadError, throwError)
import qualified Data.Foldable        as F (length, null, toList)
import qualified Data.List            as L (drop, take)
import           Data.Maybe           (fromMaybe)
import           Data.Text            (Text)
import qualified Data.Vector          as V
import           Prelude              hiding (drop, length, null, reverse, tail, take)


import Bio.NucleicAcid.Nucleotide (Complementary (..))
import Bio.Sequence.Class         (ContainsNoMarking, IsSequence (..), _sequenceInner, markings,
                                   sequ, weights)
import Bio.Sequence.Range         (Range (..), RangeBorder (..), checkRange, mapRange, swapRange)
import Bio.Sequence.Utilities     (unsafeEither)

-- | Get elements from sequence that belong to given 'Range'. If the range is a Span, then both lower and upper bounds are included.
-- If given 'Range' is out of bounds, an error will be thrown.
--
-- > sequ = Sequence ['a', 'a', 'b', 'a'] [("Letter A", (0, 2)), ("Letter A", (3, 4)), ("Letter B", (2, 3))] mempty
-- > getRange sequ (0, 3) == Just ['a', 'a', 'b']
--
getRange :: (IsSequence s, MonadError Text m, Complementary (Element s)) => s -> Range -> m [Element s]
getRange :: s -> Range -> m [Element s]
getRange s
s Range
r | Int -> Range -> Bool
checkRange (s -> Int
forall s. IsSequence s => s -> Int
length s
s) Range
r = [Element s] -> m [Element s]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Element s] -> m [Element s]) -> [Element s] -> m [Element s]
forall a b. (a -> b) -> a -> b
$ s -> Range -> [Element s]
forall s.
(IsSequence s, Complementary (Element s)) =>
s -> Range -> [Element s]
extractRange s
s Range
r 
             | Bool
otherwise               = Text -> m [Element s]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"Bio.Sequence.Functions.Sequence: invalid range in getRange."

extractRange :: (IsSequence s, Complementary (Element s)) => s -> Range -> [Element s]
extractRange :: s -> Range -> [Element s]
extractRange s
s (Point Int
pos)                                  = [s
s s -> Int -> Element s
forall s. IsSequence s => s -> Int -> Element s
! Int
pos]
extractRange s
s (Span (RangeBorder Border
_ Int
lo) (RangeBorder Border
_ Int
hi)) = Int -> [Element s] -> [Element s]
forall a. Int -> [a] -> [a]
L.drop Int
lo ([Element s] -> [Element s])
-> (s -> [Element s]) -> s -> [Element s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Element s] -> [Element s]
forall a. Int -> [a] -> [a]
L.take (Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Element s] -> [Element s])
-> (s -> [Element s]) -> s -> [Element s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> [Element s]
forall s. IsSequence s => s -> [Element s]
toList (s -> [Element s]) -> s -> [Element s]
forall a b. (a -> b) -> a -> b
$ s
s
extractRange s
_ (Between Int
_ Int
_)                                = []
extractRange s
s (Join [Range]
ranges)                                = (Range -> [Element s]) -> [Range] -> [Element s]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (s -> Range -> [Element s]
forall s.
(IsSequence s, Complementary (Element s)) =>
s -> Range -> [Element s]
extractRange s
s) [Range]
ranges
extractRange s
s (Complement Range
range)                           = [Element s] -> [Element s]
forall a. Complementary a => a -> a
rcNA ([Element s] -> [Element s]) -> [Element s] -> [Element s]
forall a b. (a -> b) -> a -> b
$ s -> Range -> [Element s]
forall s.
(IsSequence s, Complementary (Element s)) =>
s -> Range -> [Element s]
extractRange s
s Range
range

unsafeGetRange :: (IsSequence s, Complementary (Element s)) => s -> Range -> [Element s]
unsafeGetRange :: s -> Range -> [Element s]
unsafeGetRange s
s = Either Text [Element s] -> [Element s]
forall a. Either Text a -> a
unsafeEither (Either Text [Element s] -> [Element s])
-> (Range -> Either Text [Element s]) -> Range -> [Element s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Range -> Either Text [Element s]
forall s (m :: * -> *).
(IsSequence s, MonadError Text m, Complementary (Element s)) =>
s -> Range -> m [Element s]
getRange s
s

-- | Unsafe operator to get elemnt at given position in @s@.
--
infixl 9 !
(!) :: IsSequence s => s -> Int -> Element s
(!) s
s = Element s -> Maybe (Element s) -> Element s
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Element s
forall a. HasCallStack => [Char] -> a
error [Char]
"Bio.Sequence.Functions.Sequence: index out of Sequence's length.") (Maybe (Element s) -> Element s)
-> (Int -> Maybe (Element s)) -> Int -> Element s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s
s s -> Int -> Maybe (Element s)
forall s. IsSequence s => s -> Int -> Maybe (Element s)
!?)

-- | Safe operator to get element at given position in @s@.
--
infixl 9 !?
(!?) :: IsSequence s => s -> Int -> Maybe (Element s)
!? :: s -> Int -> Maybe (Element s)
(!?) (s -> Sequence (Marking s) (Weight s) (Element s)
forall s.
IsSequence s =>
s -> Sequence (Marking s) (Weight s) (Element s)
toSequence -> Sequence (Marking s) (Weight s) (Element s)
s) = ((Sequence (Marking s) (Weight s) (Element s)
s Sequence (Marking s) (Weight s) (Element s)
-> Getting
     (Vector (Element s))
     (Sequence (Marking s) (Weight s) (Element s))
     (Vector (Element s))
-> Vector (Element s)
forall s a. s -> Getting a s a -> a
^. Getting
  (Vector (Element s))
  (Sequence (Marking s) (Weight s) (Element s))
  (Vector (Element s))
forall mk w a. Getter (Sequence mk w a) (Vector a)
sequ) Vector (Element s) -> Int -> Maybe (Element s)
forall a. Vector a -> Int -> Maybe a
V.!?)

-- | List all elemnts of @s@.
--
toList :: IsSequence s => s -> [Element s]
toList :: s -> [Element s]
toList = Sequence (Marking s) (Weight s) (Element s) -> [Element s]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Sequence (Marking s) (Weight s) (Element s) -> [Element s])
-> (s -> Sequence (Marking s) (Weight s) (Element s))
-> s
-> [Element s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Sequence (Marking s) (Weight s) (Element s)
forall s.
IsSequence s =>
s -> Sequence (Marking s) (Weight s) (Element s)
toSequence

-- | Calculates length of @s@.
--
length :: IsSequence s => s -> Int
length :: s -> Int
length = Sequence (Marking s) (Weight s) (Element s) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length (Sequence (Marking s) (Weight s) (Element s) -> Int)
-> (s -> Sequence (Marking s) (Weight s) (Element s)) -> s -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Sequence (Marking s) (Weight s) (Element s)
forall s.
IsSequence s =>
s -> Sequence (Marking s) (Weight s) (Element s)
toSequence

-- | Returns 'True' if @s@ is empty. Returns 'False' otherwise.
--
null :: IsSequence s => s -> Bool
null :: s -> Bool
null = Sequence (Marking s) (Weight s) (Element s) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null (Sequence (Marking s) (Weight s) (Element s) -> Bool)
-> (s -> Sequence (Marking s) (Weight s) (Element s)) -> s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Sequence (Marking s) (Weight s) (Element s)
forall s.
IsSequence s =>
s -> Sequence (Marking s) (Weight s) (Element s)
toSequence

-- | Reverses given 'IsSequence' @s@. 'Marking's and 'Weight's are reversed, too.
--
-- > sequ = Sequence ['a', 'a', 'b', 'a'] [("Letter A", (0, 2)), ("Letter A", (3, 4)), ("Letter B", (2, 3))] [1, 2, 3, 4]
-- > reverse sequ == Sequence ['a', 'b', 'a', 'a'] [("Letter A", (2, 4)), ("Letter A", (0, 1)), ("Letter B", (1, 2))] [4, 3, 2, 1]
--
reverse :: IsSequence s => s -> s
reverse :: s -> s
reverse (s -> Sequence (Marking s) (Weight s) (Element s)
forall s.
IsSequence s =>
s -> Sequence (Marking s) (Weight s) (Element s)
toSequence -> Sequence (Marking s) (Weight s) (Element s)
s) = s
res
  where
    newMaxInd :: Int
newMaxInd = Sequence (Marking s) (Weight s) (Element s) -> Int
forall s. IsSequence s => s -> Int
length Sequence (Marking s) (Weight s) (Element s)
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

    newSequ :: Vector (Element s)
newSequ     = Vector (Element s) -> Vector (Element s)
forall a. Vector a -> Vector a
V.reverse (Vector (Element s) -> Vector (Element s))
-> Vector (Element s) -> Vector (Element s)
forall a b. (a -> b) -> a -> b
$ Sequence (Marking s) (Weight s) (Element s)
s Sequence (Marking s) (Weight s) (Element s)
-> Getting
     (Vector (Element s))
     (Sequence (Marking s) (Weight s) (Element s))
     (Vector (Element s))
-> Vector (Element s)
forall s a. s -> Getting a s a -> a
^. Getting
  (Vector (Element s))
  (Sequence (Marking s) (Weight s) (Element s))
  (Vector (Element s))
forall mk w a. Getter (Sequence mk w a) (Vector a)
sequ
    newMarkings :: [(Marking s, Range)]
newMarkings = ((Marking s, Range) -> (Marking s, Range))
-> [(Marking s, Range)] -> [(Marking s, Range)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Range -> Range) -> (Marking s, Range) -> (Marking s, Range)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Range -> Range) -> (Marking s, Range) -> (Marking s, Range))
-> (Range -> Range) -> (Marking s, Range) -> (Marking s, Range)
forall a b. (a -> b) -> a -> b
$ Range -> Range
swapRange (Range -> Range) -> (Range -> Range) -> Range -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Range -> Range
mapRange ((-) Int
newMaxInd)) ([(Marking s, Range)] -> [(Marking s, Range)])
-> [(Marking s, Range)] -> [(Marking s, Range)]
forall a b. (a -> b) -> a -> b
$ Sequence (Marking s) (Weight s) (Element s)
s Sequence (Marking s) (Weight s) (Element s)
-> Getting
     [(Marking s, Range)]
     (Sequence (Marking s) (Weight s) (Element s))
     [(Marking s, Range)]
-> [(Marking s, Range)]
forall s a. s -> Getting a s a -> a
^. Getting
  [(Marking s, Range)]
  (Sequence (Marking s) (Weight s) (Element s))
  [(Marking s, Range)]
forall mk w a. Getter (Sequence mk w a) [(mk, Range)]
markings
    newWeights :: Vector (Weight s)
newWeights  = Vector (Weight s) -> Vector (Weight s)
forall a. Vector a -> Vector a
V.reverse (Vector (Weight s) -> Vector (Weight s))
-> Vector (Weight s) -> Vector (Weight s)
forall a b. (a -> b) -> a -> b
$ Sequence (Marking s) (Weight s) (Element s)
s Sequence (Marking s) (Weight s) (Element s)
-> Getting
     (Vector (Weight s))
     (Sequence (Marking s) (Weight s) (Element s))
     (Vector (Weight s))
-> Vector (Weight s)
forall s a. s -> Getting a s a -> a
^. Getting
  (Vector (Weight s))
  (Sequence (Marking s) (Weight s) (Element s))
  (Vector (Weight s))
forall mk w a. Getter (Sequence mk w a) (Vector w)
weights

    res :: s
res = Sequence (Marking s) (Weight s) (Element s) -> s
forall s.
IsSequence s =>
Sequence (Marking s) (Weight s) (Element s) -> s
fromSequence (Sequence (Marking s) (Weight s) (Element s) -> s)
-> Sequence (Marking s) (Weight s) (Element s) -> s
forall a b. (a -> b) -> a -> b
$ Vector (Element s)
-> [(Marking s, Range)]
-> Vector (Weight s)
-> Sequence (Marking s) (Weight s) (Element s)
forall a mk w.
Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
_sequenceInner Vector (Element s)
newSequ [(Marking s, Range)]
newMarkings Vector (Weight s)
newWeights

-- | Unsafe drop:
--     * if n < 0, an error is thrown;
--     * if n >= length @s@, an error is thrown.
--
-- > sequWeighted = Sequence ['a', 'a', 'b', 'a'] mempty [0.1, 0.2, 0.3, 0.4]
-- > drop 2 sequWeighted == Sequence [b', 'a'] mempty [0.3, 0.4]
-- > drop (-1) sequWeighted == error
-- > drop 4 sequWeighted == error
--
drop :: ContainsNoMarking s => Int -> s -> s
drop :: Int -> s -> s
drop Int
n (s -> Sequence (Marking s) (Weight s) (Element s)
forall s.
IsSequence s =>
s -> Sequence (Marking s) (Weight s) (Element s)
toSequence -> Sequence (Marking s) (Weight s) (Element s)
s) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0         = [Char] -> s
forall a. HasCallStack => [Char] -> a
error [Char]
"Bio.Sequence.Functions.Sequence: drop with negative value."
                         | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Sequence (Marking s) (Weight s) (Element s) -> Int
forall s. IsSequence s => s -> Int
length Sequence (Marking s) (Weight s) (Element s)
s = [Char] -> s
forall a. HasCallStack => [Char] -> a
error [Char]
"Bio.Sequence.Functions.Sequence: empty sequence as result of drop."
                         | Bool
otherwise     = s
res
  where
    droppedSequ :: Vector (Element s)
droppedSequ = Int -> Vector (Element s) -> Vector (Element s)
forall a. Int -> Vector a -> Vector a
V.drop Int
n (Vector (Element s) -> Vector (Element s))
-> Vector (Element s) -> Vector (Element s)
forall a b. (a -> b) -> a -> b
$ Sequence (Marking s) (Weight s) (Element s)
s Sequence (Marking s) (Weight s) (Element s)
-> Getting
     (Vector (Element s))
     (Sequence (Marking s) (Weight s) (Element s))
     (Vector (Element s))
-> Vector (Element s)
forall s a. s -> Getting a s a -> a
^. Getting
  (Vector (Element s))
  (Sequence (Marking s) (Weight s) (Element s))
  (Vector (Element s))
forall mk w a. Getter (Sequence mk w a) (Vector a)
sequ
    newWeights :: Vector (Weight s)
newWeights  = Int -> Vector (Weight s) -> Vector (Weight s)
forall a. Int -> Vector a -> Vector a
V.drop Int
n (Vector (Weight s) -> Vector (Weight s))
-> Vector (Weight s) -> Vector (Weight s)
forall a b. (a -> b) -> a -> b
$ Sequence (Marking s) (Weight s) (Element s)
s Sequence (Marking s) (Weight s) (Element s)
-> Getting
     (Vector (Weight s))
     (Sequence (Marking s) (Weight s) (Element s))
     (Vector (Weight s))
-> Vector (Weight s)
forall s a. s -> Getting a s a -> a
^. Getting
  (Vector (Weight s))
  (Sequence (Marking s) (Weight s) (Element s))
  (Vector (Weight s))
forall mk w a. Getter (Sequence mk w a) (Vector w)
weights

    res :: s
res = Sequence (Marking s) (Weight s) (Element s) -> s
forall s.
IsSequence s =>
Sequence (Marking s) (Weight s) (Element s) -> s
fromSequence (Sequence (Marking s) (Weight s) (Element s) -> s)
-> Sequence (Marking s) (Weight s) (Element s) -> s
forall a b. (a -> b) -> a -> b
$ Vector (Element s)
-> [(Marking s, Range)]
-> Vector (Weight s)
-> Sequence (Marking s) (Weight s) (Element s)
forall a mk w.
Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
_sequenceInner Vector (Element s)
droppedSequ [(Marking s, Range)]
forall a. Monoid a => a
mempty Vector (Weight s)
newWeights

-- | Unsafe take:
--     * if n < 0, an error is thrown;
--     * if n == 0, an error is thrown.
--
-- > sequWeighted = Sequence ['a', 'a', 'b', 'a'] mempty [0.1, 0.2, 0.3, 0.4]
-- > take 2 sequWeighted == Sequence ['a', 'a'] mempty [0.1, 0.2]
-- > take -1 sequWeighted == error
-- > take 0 sequWeighted == error
--
take :: ContainsNoMarking s => Int -> s -> s
take :: Int -> s -> s
take Int
n (s -> Sequence (Marking s) (Weight s) (Element s)
forall s.
IsSequence s =>
s -> Sequence (Marking s) (Weight s) (Element s)
toSequence -> Sequence (Marking s) (Weight s) (Element s)
s) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = [Char] -> s
forall a. HasCallStack => [Char] -> a
error [Char]
"Bio.Sequence.Functions.Sequence: take with negative value."
                         | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = [Char] -> s
forall a. HasCallStack => [Char] -> a
error [Char]
"Bio.Sequence.Functions.Sequence: empty sequence as result of take."
                         | Bool
otherwise = s
res
  where
    takenSequ :: Vector (Element s)
takenSequ  = Int -> Vector (Element s) -> Vector (Element s)
forall a. Int -> Vector a -> Vector a
V.take Int
n (Vector (Element s) -> Vector (Element s))
-> Vector (Element s) -> Vector (Element s)
forall a b. (a -> b) -> a -> b
$ Sequence (Marking s) (Weight s) (Element s)
s Sequence (Marking s) (Weight s) (Element s)
-> Getting
     (Vector (Element s))
     (Sequence (Marking s) (Weight s) (Element s))
     (Vector (Element s))
-> Vector (Element s)
forall s a. s -> Getting a s a -> a
^. Getting
  (Vector (Element s))
  (Sequence (Marking s) (Weight s) (Element s))
  (Vector (Element s))
forall mk w a. Getter (Sequence mk w a) (Vector a)
sequ
    newWeights :: Vector (Weight s)
newWeights = Int -> Vector (Weight s) -> Vector (Weight s)
forall a. Int -> Vector a -> Vector a
V.take Int
n (Vector (Weight s) -> Vector (Weight s))
-> Vector (Weight s) -> Vector (Weight s)
forall a b. (a -> b) -> a -> b
$ Sequence (Marking s) (Weight s) (Element s)
s Sequence (Marking s) (Weight s) (Element s)
-> Getting
     (Vector (Weight s))
     (Sequence (Marking s) (Weight s) (Element s))
     (Vector (Weight s))
-> Vector (Weight s)
forall s a. s -> Getting a s a -> a
^. Getting
  (Vector (Weight s))
  (Sequence (Marking s) (Weight s) (Element s))
  (Vector (Weight s))
forall mk w a. Getter (Sequence mk w a) (Vector w)
weights

    res :: s
res = Sequence (Marking s) (Weight s) (Element s) -> s
forall s.
IsSequence s =>
Sequence (Marking s) (Weight s) (Element s) -> s
fromSequence (Sequence (Marking s) (Weight s) (Element s) -> s)
-> Sequence (Marking s) (Weight s) (Element s) -> s
forall a b. (a -> b) -> a -> b
$ Vector (Element s)
-> [(Marking s, Range)]
-> Vector (Weight s)
-> Sequence (Marking s) (Weight s) (Element s)
forall a mk w.
Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
_sequenceInner Vector (Element s)
takenSequ [(Marking s, Range)]
forall a. Monoid a => a
mempty Vector (Weight s)
newWeights

-- | Unsafe tail:
--     * length @s@ == 0, an error is thrown;
--     * length @s@ == 1, an error is thrown.
--
-- > sequWeighted = Sequence ['a', 'a', 'b', 'a'] mempty [0.1, 0.2, 0.3, 0.4]
-- > tail sequWeighted == Sequence [a', 'b', 'a'] mempty [0.2, 0.3, 0.4]
-- > tail (tail (tail (tail (tail sequWeighted)))) == error
--
tail :: ContainsNoMarking s => s -> s
tail :: s -> s
tail s
s | s -> Int
forall s. IsSequence s => s -> Int
length s
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [Char] -> s
forall a. HasCallStack => [Char] -> a
error [Char]
"Bio.Sequence.Functions.Sequence: tail from empty sequence."
       | Bool
otherwise     = Int -> s -> s
forall s. ContainsNoMarking s => Int -> s -> s
drop Int
1 s
s