{-# LANGUAGE ViewPatterns #-}
module Bio.Sequence.Functions.Marking
( getMarking
, unsafeGetMarking
, toMarked
, unsafeToMarked
, addMarkings
, unsafeAddMarkings
, listMarkings
) where
import Bio.Sequence.Class (ContainsMarking,
IsBareSequence,
IsMarkedSequence,
IsSequence (..),
markedSequence, markings,
sequ, unsafeMarkedSequence,
weights, _sequenceInner)
import Bio.Sequence.Functions.Sequence (length, unsafeGetRange)
import Bio.Sequence.Utilities (Range, checkRange,
unsafeEither)
import Control.Lens
import Control.Monad.Except (MonadError, throwError)
import Data.List (nub)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Text (Text)
import qualified Data.Vector as V (toList)
import Prelude hiding (drop, head, length,
null, reverse, tail, take,
(!!))
getMarking :: (ContainsMarking s, MonadError Text m) => s -> Marking s -> m (NonEmpty [Element s])
getMarking (toSequence -> s) mk | not $ mk `member` (s ^. markings) = throwError markingNotFoundError
| otherwise = pure $ res
where
res = foldl1 (<>) $ fmap ((:| []) . unsafeGetRange s) $ mk `lookupAll` (s ^. markings)
markingNotFoundError :: Text
markingNotFoundError = "Bio.Sequence.Functions.Marking: given marking not found in Sequence."
unsafeGetMarking :: ContainsMarking s => s -> Marking s -> NonEmpty [Element s]
unsafeGetMarking mk = unsafeEither . getMarking mk
toMarked :: (IsBareSequence s, IsMarkedSequence s', Marking s' ~ mk, Element s ~ Element s', MonadError Text m) => s -> [(mk, Range)] -> m s'
toMarked (toSequence -> s) = markedSequence (V.toList $ s ^. sequ)
unsafeToMarked :: (IsBareSequence s, IsMarkedSequence s', Marking s' ~ mk, Element s ~ Element s') => s -> [(mk, Range)] -> s'
unsafeToMarked (toSequence -> s) = unsafeMarkedSequence (V.toList $ s ^. sequ)
addMarkings :: (ContainsMarking s, Marking s ~ mk, MonadError Text m) => s -> [(mk, Range)] -> m s
addMarkings (toSequence -> s) markings' | all (checkRange (length s) . snd) markings' = pure res
| otherwise = throwError rangesError
where
res = fromSequence $ _sequenceInner (s ^. sequ) (s ^. markings <> markings') (s ^. weights)
rangesError :: Text
rangesError = "Bio.Sequence.Functions.Marking: can't add markings to Sequence, because some of them are out of range."
unsafeAddMarkings :: (ContainsMarking s, Marking s ~ mk) => s -> [(mk, Range)] -> s
unsafeAddMarkings s = unsafeEither . addMarkings s
listMarkings :: ContainsMarking s => s -> [Marking s]
listMarkings (toSequence -> s) = nub $ fst <$> s ^. markings
member :: Eq a => a -> [(a, b)] -> Bool
member a = (a `elem`) . fmap fst
lookupAll :: Eq a => a -> [(a, b)] -> [b]
lookupAll a = fmap snd . filter ((== a) . fst)