module Bio.Location.Location ( Loc(..), bounds, length, startPos, endPos
, extend, posInto, posOutof, isWithin, overlaps
, seqData, seqDataPadded
, display
)
where
import Prelude hiding (length)
import Control.Arrow ((***))
import Control.Monad.Error
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.List (intercalate)
import qualified Bio.Location.ContigLocation as CLoc
import qualified Bio.Location.Position as Pos
import Bio.Location.Strand
import Bio.Sequence.SeqData
newtype Loc = Loc [CLoc.ContigLoc] deriving (Eq, Ord, Show)
instance Stranded Loc where
revCompl (Loc contigs) = Loc $ reverse $ map revCompl contigs
length :: Loc -> Offset
length (Loc contigs) = sum $ map CLoc.length contigs
bounds :: Loc -> (Offset, Offset)
bounds (Loc []) = error "locBounds on zero-contig Loc"
bounds (Loc contigs) = (minimum *** maximum) $ unzip $ map CLoc.bounds contigs
startPos :: Loc -> Pos.Pos
startPos (Loc []) = error "startPos: zero-contig Loc"
startPos (Loc contigs) = CLoc.startPos $ head contigs
endPos :: Loc -> Pos.Pos
endPos (Loc []) = error "endPos: zero-contig Loc"
endPos (Loc contigs) = CLoc.endPos $ last contigs
seqData :: (Error e, MonadError e m) => SeqData -> Loc -> m SeqData
seqData sequ (Loc contigs)
= liftM LBS.concat $ mapM (CLoc.seqData sequ) contigs
seqDataPadded :: SeqData -> Loc -> SeqData
seqDataPadded sequ (Loc contigs)
= LBS.concat $ map (CLoc.seqDataPadded sequ) contigs
posInto :: Pos.Pos -> Loc -> Maybe Pos.Pos
posInto seqpos (Loc contigs) = posIntoContigs seqpos contigs
posIntoContigs :: Pos.Pos -> [CLoc.ContigLoc] -> Maybe Pos.Pos
posIntoContigs _ [] = Nothing
posIntoContigs seqpos (contig@(CLoc.ContigLoc _ len _):rest)
= case CLoc.posInto seqpos contig of
just@(Just _) -> just
Nothing -> liftM (flip Pos.slide len) $ posIntoContigs seqpos rest
posOutof :: Pos.Pos -> Loc -> Maybe Pos.Pos
posOutof pos (Loc contigs) = posOutofContigs pos contigs
posOutofContigs :: Pos.Pos -> [CLoc.ContigLoc] -> Maybe Pos.Pos
posOutofContigs _ [] = Nothing
posOutofContigs seqpos (contig@(CLoc.ContigLoc _ len _):rest)
= case CLoc.posOutof seqpos contig of
just@(Just _) -> just
Nothing -> posOutofContigs (Pos.slide seqpos $ negate len) rest
extend :: (Offset, Offset)
-> Loc -> Loc
extend _ (Loc []) = error "extendLoc on zero-contig Loc"
extend (ext5, ext3) (Loc contigs) = Loc $ case extendContigs3 contigs of
[] -> error "Empty contigs after extendContigs3"
(cfirst:crest) -> (CLoc.extend (ext5, 0) cfirst):crest
where extendContigs3 [] = error "Empty contigs in extendContigs3"
extendContigs3 [clast] = [CLoc.extend (0, ext3) clast]
extendContigs3 (contig:crest) = contig : extendContigs3 crest
isWithin :: Pos.Pos -> Loc -> Bool
isWithin seqpos (Loc contigs) = or $ map (CLoc.isWithin seqpos) contigs
overlappingContigs :: Loc -> Loc -> [(CLoc.ContigLoc, CLoc.ContigLoc)]
overlappingContigs (Loc contigs1) (Loc contigs2)
= filter (uncurry CLoc.overlaps) [(c1, c2) | c1 <- contigs1, c2 <- contigs2 ]
overlaps :: Loc -> Loc -> Bool
overlaps l1 l2 = not $ null $ overlappingContigs l1 l2
display :: Loc -> String
display (Loc contigs) = intercalate ";" $ map CLoc.display contigs