-- | Positions on a sequence.  Zero-based 'Int64' indices are used
-- throughout, to facilitate direct use of indexing functions on
-- 'SeqData'.

module Bio.Location.Position ( Pos(..), slide, seqNt, seqNtPadded, display )
    where 

import Control.Monad.Error
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Ix (Ix)
import Data.List

import Bio.Location.Strand
import Bio.Sequence.SeqData

-- | Position in a sequence
data Pos = Pos { offset :: !Offset -- ^ 0-based index of the position
               , strand :: !Strand -- ^ Optional strand of the position
               }
              deriving (Eq, Ord, Show, Read, Ix)

instance Stranded Pos where
    revCompl (Pos off str) = Pos off $ revCompl str

-- | Slide a position by an offset
slide :: Pos -> Offset -> Pos
slide (Pos off str) doff = Pos (off + doff) str

seqNt :: (Error e, MonadError e m) => SeqData -> Pos -> m Char
seqNt sequ (Pos off str) | off >= 0 && off < LBS.length sequ = return $ stranded str $ sequ `LBS.index` off
                         | otherwise = throwError $ strMsg $ "position " ++ show off ++ " out of SeqData bounds"

seqNtPadded :: SeqData -> Pos -> Char
seqNtPadded sequ (Pos off str) | off >= 0 && off < LBS.length sequ = stranded str $ sequ `LBS.index` off
                               | otherwise = 'N'

display :: Pos -> String
display (Pos off str) = show off ++ displayStrand
    where displayStrand = case str of
                            Fwd -> "(+)"
                            RevCompl -> "(-)"