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 :: (Monad 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 :: (Error e, MonadError e 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 = throwError $ strMsg $ "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"