{-| 

Data types for sequence locations and sequence positions associated
with specific, named sequences.

-}

module Bio.Location.SeqLocation ( -- * Positions on named sequences
                                  SeqPos

                                -- * Contiguous location spans on named sequences
                                , ContigSeqLoc, withinContigSeqLoc

                                -- * Arbitrary location spans on named sequences
                                , SeqLoc

                                -- * Testing for location intersection on named sequences
                                , isWithin, overlaps

                                -- * Extracting subsequences
                                , seqData

                                -- * Displaying locations on named sequences
                                , displaySeqPos, displayContigSeqLoc, display
                                )
    where 

import Control.Monad.Error
import qualified Data.ByteString.Lazy.Char8 as LBS

import qualified Bio.Location.ContigLocation as CLoc
import qualified Bio.Location.Location as Loc
import Bio.Location.OnSeq
import qualified Bio.Location.Position as Pos
import Bio.Sequence.SeqData

-- | A position on a named sequence
type SeqPos = OnSeq Pos.Pos

-- | Display a human-friendly representation of a 'SeqPos'
displaySeqPos :: SeqPos -> String
displaySeqPos (OnSeq refname pos) = LBS.unpack refname ++ "@" ++ Pos.display pos

-- | A location consisting of a contiguous span of positions on a
-- named sequence.
type ContigSeqLoc = OnSeq CLoc.ContigLoc

-- | Test whether a sequence position lies within a sequence location.
-- This requires that the position lie within the location as per
-- 'CLoc.isWithin' and have the same sequence name.
withinContigSeqLoc :: SeqPos -> ContigSeqLoc -> Bool
withinContigSeqLoc = andSameSeq CLoc.isWithin

-- | Display a human-friendly representation of a 'ContigSeqLoc'
displayContigSeqLoc :: ContigSeqLoc -> String
displayContigSeqLoc (OnSeq refname cloc) = LBS.unpack refname ++ "@" ++ CLoc.display cloc

-- | A general location, consisting of spans of sequence positions on
-- a specific, named sequence.
type SeqLoc = OnSeq Loc.Loc

-- | Test whether a sequence position lies within a sequence location.
-- This requires that the position lie within the location as per
-- 'Loc.isWithin' and have the same sequence name.
isWithin :: SeqPos -> SeqLoc -> Bool
isWithin = andSameSeq Loc.isWithin

-- | Test whether two sequence locations overlap in any position.
-- This requires that the locations overlap as per 'Loc.overlaps' and
-- have the same sequence name.
overlaps :: SeqLoc -> SeqLoc -> Bool
overlaps = andSameSeq Loc.overlaps

-- | Extract the subsequence specified by a sequence location from a
-- sequence database.  The sequence name is used to retrieve the full
-- sequence and the subsequence is extracted as by 'Loc.seqData'
seqData :: (Error e, MonadError e m) => (SeqName -> m SeqData) -> SeqLoc -> m SeqData
seqData = withSeqData Loc.seqData

-- | Display a human-friendly representation of a 'SeqLoc'
display :: SeqLoc -> String
display (OnSeq refname loc) = LBS.unpack refname ++ "@" ++ Loc.display loc