module Bio.Location.OnSeq ( SeqName 
                          , OnSeq(..), withSeqData, andSameSeq, onSameSeq
                          , OnSeqs, perSeq, perSeqUpdate, withNameAndSeq
                          )
    where 

import Control.Monad.Error
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.List
import qualified Data.Map as M
import Data.Monoid

import Bio.Sequence.SeqData

type SeqName = SeqData

data OnSeq a = OnSeq { onSeqName :: !SeqName
                     , onSeqObj :: !a
                     } deriving (Eq, Ord, Show)

instance Functor OnSeq where
    fmap f (OnSeq seqname x) = OnSeq seqname (f x)

withSeqData :: (Error e, MonadError e m) => (SeqData -> a -> m b) -> (SeqName -> m SeqData) -> OnSeq a -> m b
withSeqData f lookupSeq (OnSeq seqname x) = lookupSeq seqname >>= flip f x

andSameSeq :: (a -> b -> Bool) -> OnSeq a -> OnSeq b -> Bool
andSameSeq f (OnSeq xname x) (OnSeq yname y) | xname == yname = f x y
                                             | otherwise = False

onSameSeq :: (Monad m) => (a -> b -> m c) -> OnSeq a -> OnSeq b -> m c
onSameSeq f (OnSeq xname x) (OnSeq yname y) 
    | xname == yname = f x y
    | otherwise      = fail $ "onSameSeq: " ++ show (LBS.unpack xname) ++ " /= " ++ show (LBS.unpack yname)


type OnSeqs a = M.Map SeqName a

perSeq :: (Monoid b) => (a -> b -> c) -> OnSeq a -> OnSeqs b -> c
perSeq f (OnSeq seqname x) = f x . M.findWithDefault mempty seqname

perSeqUpdate :: (Monoid b) => (a -> b -> b) -> OnSeq a -> OnSeqs b -> OnSeqs b
perSeqUpdate upd onseq@(OnSeq seqname _) seqmap0 = M.insert seqname (perSeq upd onseq seqmap0) seqmap0

withNameAndSeq :: (Monad m) => (SeqName -> a -> b -> m c) -> OnSeq a -> OnSeqs b -> m c
withNameAndSeq f (OnSeq seqname x) = mylookup seqname >=> f seqname x
    where mylookup k = maybe nameNotFound return . M.lookup k
              where nameNotFound = fail $ "withNameAndSeq: sequence " ++ show (LBS.unpack k) ++ " not found"