{-| 

Efficient lookup of query positions in a collection of target sequence
locations where positions and locations are associated with specific
sequence names.  This is an extension of 'LocMap' to use locations and
positions on named sequences as in 'SeqLocation'.

-}

module Bio.Location.SeqLocMap ( -- * Location lookup maps for named sequences
                                SeqLocMap, empty, fromList

                              -- * Modifying location lookup maps
                              , insert
                              
                              -- * Searching for target locations
                              , lookupWithin, lookupOverlaps
                              )
    where 

import Control.Arrow (first)
import Data.List hiding (insert)
import qualified Data.Map as M

import Bio.Location.OnSeq
import qualified Bio.Location.LocMap as LM
import qualified Bio.Location.SeqLocation as SeqLoc

-- | A data structure for efficiently finding target sequence
-- locations ('SeqLoc.Loc') that overlap query positions or locations.
-- Each target location can be associated with an arbitrary additional
-- value in the lookup map.
type SeqLocMap a = OnSeqs (LM.LocMap a)

-- | Empty lookup map.
empty :: SeqLocMap a
empty = M.empty

-- | Creates a 'SeqLocMap' from a list of target locations and their
-- associated objects
fromList :: [(SeqLoc.SeqLoc, a)] -> SeqLocMap a
fromList = foldl' (\lm (sl,x) -> insert sl x lm) M.empty

-- | Inserts a new target location and associated object into the
-- location lookup map.
insert :: SeqLoc.SeqLoc -> a -> SeqLocMap a -> SeqLocMap a
insert sloc x = perSeqUpdate (\loc locmap -> LM.insert loc x locmap) sloc

-- | Find the (possibly empty) list of target locations and associated
-- objects that contain a sequence position, in the sense of
-- 'Loc.isWithin'.
lookupWithin :: SeqLoc.SeqPos -> SeqLocMap a -> [(SeqLoc.SeqLoc, a)]
lookupWithin = withNameAndSeq namedLookupWithin
    where namedLookupWithin seqname pos = map (first $ OnSeq seqname) . LM.lookupWithin pos

-- | Find the (possibly empty) list of target locations and associated
-- objects that overlap a sequence location, in the sense of
-- 'Loc.overlaps'.
lookupOverlaps :: SeqLoc.SeqLoc -> SeqLocMap a -> [(SeqLoc.SeqLoc, a)]
lookupOverlaps = withNameAndSeq namedLookupOverlaps
    where namedLookupOverlaps seqname loc = map (first $ OnSeq seqname) . LM.lookupOverlaps loc