{-# LANGUAGE UndecidableInstances #-}
module Bio.Sequence.Class
(
SequenceDecodable (..)
, Sequence
, WeightedSequence
, MarkedSequence
, BareSequence
, Range
, sequ
, markings
, weights
, bareSequ
, IsMarking
, IsWeight (..)
, IsSequence (..)
, IsWeightedSequence
, IsMarkedSequence
, IsBareSequence
, ContainsMarking
, ContainsNoMarking
, ContainsWeight
, ContainsNoWeight
, createSequence
, unsafeCreateSequence
, bareSequence
, weightedSequence
, unsafeWeightedSequence
, markedSequence
, unsafeMarkedSequence
, _sequenceInner
) where
import Bio.Sequence.Range (Range, checkRange, shiftRange)
import Bio.Sequence.Utilities (unsafeEither)
import Control.DeepSeq (NFData)
import Control.Lens
import Control.Monad.Except (MonadError, throwError)
import Data.Kind (Constraint, Type)
import qualified Data.List as L (length, null)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Vector (Vector)
import qualified Data.Vector as V (fromList, length)
import GHC.Generics (Generic)
import GHC.TypeLits (ErrorMessage (..), TypeError)
data Sequence mk w a
= Sequence
{ forall mk w a. Sequence mk w a -> Vector a
_sequ :: Vector a
, forall mk w a. Sequence mk w a -> [(mk, Range)]
_markings :: [(mk, Range)]
, forall mk w a. Sequence mk w a -> Vector w
_weights :: Vector w
}
deriving (Sequence mk w a -> Sequence mk w a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall mk w a.
(Eq a, Eq mk, Eq w) =>
Sequence mk w a -> Sequence mk w a -> Bool
/= :: Sequence mk w a -> Sequence mk w a -> Bool
$c/= :: forall mk w a.
(Eq a, Eq mk, Eq w) =>
Sequence mk w a -> Sequence mk w a -> Bool
== :: Sequence mk w a -> Sequence mk w a -> Bool
$c== :: forall mk w a.
(Eq a, Eq mk, Eq w) =>
Sequence mk w a -> Sequence mk w a -> Bool
Eq, Sequence mk w a -> Sequence mk w a -> Bool
Sequence mk w a -> Sequence mk w a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {mk} {w} {a}. (Ord a, Ord mk, Ord w) => Eq (Sequence mk w a)
forall mk w a.
(Ord a, Ord mk, Ord w) =>
Sequence mk w a -> Sequence mk w a -> Bool
forall mk w a.
(Ord a, Ord mk, Ord w) =>
Sequence mk w a -> Sequence mk w a -> Ordering
forall mk w a.
(Ord a, Ord mk, Ord w) =>
Sequence mk w a -> Sequence mk w a -> Sequence mk w a
min :: Sequence mk w a -> Sequence mk w a -> Sequence mk w a
$cmin :: forall mk w a.
(Ord a, Ord mk, Ord w) =>
Sequence mk w a -> Sequence mk w a -> Sequence mk w a
max :: Sequence mk w a -> Sequence mk w a -> Sequence mk w a
$cmax :: forall mk w a.
(Ord a, Ord mk, Ord w) =>
Sequence mk w a -> Sequence mk w a -> Sequence mk w a
>= :: Sequence mk w a -> Sequence mk w a -> Bool
$c>= :: forall mk w a.
(Ord a, Ord mk, Ord w) =>
Sequence mk w a -> Sequence mk w a -> Bool
> :: Sequence mk w a -> Sequence mk w a -> Bool
$c> :: forall mk w a.
(Ord a, Ord mk, Ord w) =>
Sequence mk w a -> Sequence mk w a -> Bool
<= :: Sequence mk w a -> Sequence mk w a -> Bool
$c<= :: forall mk w a.
(Ord a, Ord mk, Ord w) =>
Sequence mk w a -> Sequence mk w a -> Bool
< :: Sequence mk w a -> Sequence mk w a -> Bool
$c< :: forall mk w a.
(Ord a, Ord mk, Ord w) =>
Sequence mk w a -> Sequence mk w a -> Bool
compare :: Sequence mk w a -> Sequence mk w a -> Ordering
$ccompare :: forall mk w a.
(Ord a, Ord mk, Ord w) =>
Sequence mk w a -> Sequence mk w a -> Ordering
Ord, Int -> Sequence mk w a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall mk w a.
(Show a, Show mk, Show w) =>
Int -> Sequence mk w a -> ShowS
forall mk w a.
(Show a, Show mk, Show w) =>
[Sequence mk w a] -> ShowS
forall mk w a.
(Show a, Show mk, Show w) =>
Sequence mk w a -> String
showList :: [Sequence mk w a] -> ShowS
$cshowList :: forall mk w a.
(Show a, Show mk, Show w) =>
[Sequence mk w a] -> ShowS
show :: Sequence mk w a -> String
$cshow :: forall mk w a.
(Show a, Show mk, Show w) =>
Sequence mk w a -> String
showsPrec :: Int -> Sequence mk w a -> ShowS
$cshowsPrec :: forall mk w a.
(Show a, Show mk, Show w) =>
Int -> Sequence mk w a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall mk w a x. Rep (Sequence mk w a) x -> Sequence mk w a
forall mk w a x. Sequence mk w a -> Rep (Sequence mk w a) x
$cto :: forall mk w a x. Rep (Sequence mk w a) x -> Sequence mk w a
$cfrom :: forall mk w a x. Sequence mk w a -> Rep (Sequence mk w a) x
Generic, forall a. (a -> ()) -> NFData a
forall mk w a.
(NFData a, NFData mk, NFData w) =>
Sequence mk w a -> ()
rnf :: Sequence mk w a -> ()
$crnf :: forall mk w a.
(NFData a, NFData mk, NFData w) =>
Sequence mk w a -> ()
NFData, forall a b. a -> Sequence mk w b -> Sequence mk w a
forall a b. (a -> b) -> Sequence mk w a -> Sequence mk w b
forall mk w a b. a -> Sequence mk w b -> Sequence mk w a
forall mk w a b. (a -> b) -> Sequence mk w a -> Sequence mk w b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Sequence mk w b -> Sequence mk w a
$c<$ :: forall mk w a b. a -> Sequence mk w b -> Sequence mk w a
fmap :: forall a b. (a -> b) -> Sequence mk w a -> Sequence mk w b
$cfmap :: forall mk w a b. (a -> b) -> Sequence mk w a -> Sequence mk w b
Functor)
instance Semigroup (Sequence mk w a) where
Sequence mk w a
sequA <> :: Sequence mk w a -> Sequence mk w a -> Sequence mk w a
<> Sequence mk w a
sequB = Sequence mk w a
res
where
newSequ :: Vector a
newSequ = Sequence mk w a
sequA forall s a. s -> Getting a s a -> a
^. forall mk w a. Getter (Sequence mk w a) (Vector a)
sequ forall a. Semigroup a => a -> a -> a
<> Sequence mk w a
sequB forall s a. s -> Getting a s a -> a
^. forall mk w a. Getter (Sequence mk w a) (Vector a)
sequ
newMarkings :: [(mk, Range)]
newMarkings = Sequence mk w a
sequA forall s a. s -> Getting a s a -> a
^. forall mk w a. Getter (Sequence mk w a) [(mk, Range)]
markings forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Range -> Range
shiftRange Int
addInd)) (Sequence mk w a
sequB forall s a. s -> Getting a s a -> a
^. forall mk w a. Getter (Sequence mk w a) [(mk, Range)]
markings)
newWeights :: Vector w
newWeights = Sequence mk w a
sequA forall s a. s -> Getting a s a -> a
^. forall mk w a. Getter (Sequence mk w a) (Vector w)
weights forall a. Semigroup a => a -> a -> a
<> Sequence mk w a
sequB forall s a. s -> Getting a s a -> a
^. forall mk w a. Getter (Sequence mk w a) (Vector w)
weights
res :: Sequence mk w a
res = forall mk w a.
Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
Sequence Vector a
newSequ [(mk, Range)]
newMarkings Vector w
newWeights
addInd :: Int
addInd :: Int
addInd = forall a. Vector a -> Int
V.length (Sequence mk w a
sequA forall s a. s -> Getting a s a -> a
^. forall mk w a. Getter (Sequence mk w a) (Vector a)
sequ)
instance Monoid (Sequence mk () a) where
mempty :: Sequence mk () a
mempty = forall mk w a.
Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
Sequence forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
instance Foldable (Sequence mk w) where
foldMap :: forall m a. Monoid m => (a -> m) -> Sequence mk w a -> m
foldMap a -> m
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mk w a. Sequence mk w a -> Vector a
_sequ
length :: forall a. Sequence mk w a -> Int
length = forall a. Vector a -> Int
V.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mk w a. Sequence mk w a -> Vector a
_sequ
instance Traversable (Sequence mk w) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Sequence mk w a -> f (Sequence mk w b)
traverse a -> f b
f s :: Sequence mk w a
s@Sequence{[(mk, Range)]
Vector w
Vector a
_weights :: Vector w
_markings :: [(mk, Range)]
_sequ :: Vector a
_weights :: forall mk w a. Sequence mk w a -> Vector w
_markings :: forall mk w a. Sequence mk w a -> [(mk, Range)]
_sequ :: forall mk w a. Sequence mk w a -> Vector a
..} = (\Vector b
newSeq -> Sequence mk w a
s { _sequ :: Vector b
_sequ = Vector b
newSeq }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Vector a
_sequ
_sequenceInner :: Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
_sequenceInner :: forall a mk w.
Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
_sequenceInner = forall mk w a.
Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
Sequence
type WeightedSequence w a = Sequence () w a
type MarkedSequence mk a = Sequence mk () a
type BareSequence a = Sequence () () a
sequ :: Getter (Sequence mk w a) (Vector a)
sequ :: forall mk w a. Getter (Sequence mk w a) (Vector a)
sequ = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall mk w a. Sequence mk w a -> Vector a
_sequ
markings :: Getter (Sequence mk w a) [(mk, Range)]
markings :: forall mk w a. Getter (Sequence mk w a) [(mk, Range)]
markings = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall mk w a. Sequence mk w a -> [(mk, Range)]
_markings
weights :: Getter (Sequence mk w a) (Vector w)
weights :: forall mk w a. Getter (Sequence mk w a) (Vector w)
weights = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall mk w a. Sequence mk w a -> Vector w
_weights
bareSequ :: Lens' (BareSequence a) (Vector a)
bareSequ :: forall a. Lens' (BareSequence a) (Vector a)
bareSequ = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall mk w a. Sequence mk w a -> Vector a
_sequ (\BareSequence a
s Vector a
v -> BareSequence a
s { _sequ :: Vector a
_sequ = Vector a
v })
class (Eq mk, Ord mk) => IsMarking mk where
instance IsMarking ()
class IsWeight w where
toDouble :: w -> Double
instance IsWeight () where
toDouble :: () -> Double
toDouble = forall a. HasCallStack => String -> a
error String
"Bio.Sequence.Class: () can't be valid 'Weight'."
instance IsWeight Double where
toDouble :: Double -> Double
toDouble = forall a. a -> a
id
class (IsMarking (Marking s), IsWeight (Weight s)) => IsSequence s where
type Element s :: Type
type Marking s :: Type
type Weight s :: Type
toSequence :: s -> Sequence (Marking s) (Weight s) (Element s)
fromSequence :: Sequence (Marking s) (Weight s) (Element s) -> s
instance (IsMarking mk, IsWeight w) => IsSequence (Sequence mk w a) where
type Element (Sequence mk w a) = a
type Marking (Sequence mk w a) = mk
type Weight (Sequence mk w a) = w
toSequence :: Sequence mk w a
-> Sequence
(Marking (Sequence mk w a))
(Weight (Sequence mk w a))
(Element (Sequence mk w a))
toSequence = forall a. a -> a
id
fromSequence :: Sequence
(Marking (Sequence mk w a))
(Weight (Sequence mk w a))
(Element (Sequence mk w a))
-> Sequence mk w a
fromSequence = forall a. a -> a
id
class IsSequence s => SequenceDecodable a s where
sequenceDecode :: a -> Either Text s
type IsWeightedSequence s = (IsSequence s, Unit (Marking s), NotUnit (Weight s))
type IsMarkedSequence s = (IsSequence s, NotUnit (Marking s), Unit (Weight s))
type IsBareSequence s = (IsSequence s, Unit (Marking s), Unit (Weight s))
type ContainsMarking s = (IsSequence s, NotUnit (Marking s))
type ContainsNoMarking s = (IsSequence s, Unit (Marking s))
type ContainsWeight s = (IsSequence s, NotUnit (Weight s))
type ContainsNoWeight s = (IsSequence s, Unit (Weight s))
createSequence :: (ContainsMarking s, ContainsWeight s, MonadError Text m) => [Element s] -> [(Marking s, Range)] -> [Weight s] -> m s
createSequence :: forall s (m :: * -> *).
(ContainsMarking s, ContainsWeight s, MonadError Text m) =>
[Element s] -> [(Marking s, Range)] -> [Weight s] -> m s
createSequence = forall s (m :: * -> *).
(IsSequence s, MonadError Text m) =>
Bool
-> Bool -> [Element s] -> [(Marking s, Range)] -> [Weight s] -> m s
createSequenceInner Bool
True Bool
True
unsafeCreateSequence :: (ContainsMarking s, ContainsWeight s) => [Element s] -> [(Marking s, Range)] -> [Weight s] -> s
unsafeCreateSequence :: forall s.
(ContainsMarking s, ContainsWeight s) =>
[Element s] -> [(Marking s, Range)] -> [Weight s] -> s
unsafeCreateSequence [Element s]
s [(Marking s, Range)]
markings' = forall a. Either Text a -> a
unsafeEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *).
(ContainsMarking s, ContainsWeight s, MonadError Text m) =>
[Element s] -> [(Marking s, Range)] -> [Weight s] -> m s
createSequence [Element s]
s [(Marking s, Range)]
markings'
bareSequence :: IsBareSequence s => [Element s] -> s
bareSequence :: forall s. IsBareSequence s => [Element s] -> s
bareSequence [Element s]
s = forall s.
IsSequence s =>
Sequence (Marking s) (Weight s) (Element s) -> s
fromSequence forall a b. (a -> b) -> a -> b
$ forall mk w a.
Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
Sequence (forall a. [a] -> Vector a
V.fromList [Element s]
s) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
markedSequence :: (IsMarkedSequence s, MonadError Text m) => [Element s] -> [(Marking s, Range)] -> m s
markedSequence :: forall s (m :: * -> *).
(IsMarkedSequence s, MonadError Text m) =>
[Element s] -> [(Marking s, Range)] -> m s
markedSequence [Element s]
s [(Marking s, Range)]
markings' = forall s (m :: * -> *).
(IsSequence s, MonadError Text m) =>
Bool
-> Bool -> [Element s] -> [(Marking s, Range)] -> [Weight s] -> m s
createSequenceInner Bool
True Bool
False [Element s]
s [(Marking s, Range)]
markings' []
unsafeMarkedSequence :: IsMarkedSequence s => [Element s] -> [(Marking s, Range)] -> s
unsafeMarkedSequence :: forall s.
IsMarkedSequence s =>
[Element s] -> [(Marking s, Range)] -> s
unsafeMarkedSequence [Element s]
s = forall a. Either Text a -> a
unsafeEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *).
(IsMarkedSequence s, MonadError Text m) =>
[Element s] -> [(Marking s, Range)] -> m s
markedSequence [Element s]
s
weightedSequence :: (IsWeightedSequence s, MonadError Text m) => [Element s] -> [Weight s] -> m s
weightedSequence :: forall s (m :: * -> *).
(IsWeightedSequence s, MonadError Text m) =>
[Element s] -> [Weight s] -> m s
weightedSequence [Element s]
s = forall s (m :: * -> *).
(IsSequence s, MonadError Text m) =>
Bool
-> Bool -> [Element s] -> [(Marking s, Range)] -> [Weight s] -> m s
createSequenceInner Bool
False Bool
True [Element s]
s []
unsafeWeightedSequence :: IsWeightedSequence s => [Element s] -> [Weight s] -> s
unsafeWeightedSequence :: forall s. IsWeightedSequence s => [Element s] -> [Weight s] -> s
unsafeWeightedSequence [Element s]
s = forall a. Either Text a -> a
unsafeEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *).
(IsWeightedSequence s, MonadError Text m) =>
[Element s] -> [Weight s] -> m s
weightedSequence [Element s]
s
type family NotUnit a :: Constraint where
NotUnit () = TypeError ('Text "cobot-io: this function doesn't work with when parametrized by ().")
NotUnit _ = ()
type family Unit a :: Constraint where
Unit () = ()
Unit _ = TypeError ('Text "cobot-io: this function doesn't work with when not parametrized by ().")
createSequenceInner :: (IsSequence s, MonadError Text m) => Bool -> Bool -> [Element s] -> [(Marking s, Range)] -> [Weight s] -> m s
createSequenceInner :: forall s (m :: * -> *).
(IsSequence s, MonadError Text m) =>
Bool
-> Bool -> [Element s] -> [(Marking s, Range)] -> [Weight s] -> m s
createSequenceInner Bool
checkMk Bool
checkW [Element s]
s [(Marking s, Range)]
markings' [Weight s]
weights' | Bool
checkMk Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
checkRanges = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
rangesError
| Bool
checkW Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
checkNullWeights = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
weightsNullError
| Bool
checkW Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
checkLenWeights = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
weightsLenError
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure s
resSequence
where
seqVector :: Vector (Element s)
seqVector = forall a. [a] -> Vector a
V.fromList [Element s]
s
weightsVector :: Vector (Weight s)
weightsVector = forall a. [a] -> Vector a
V.fromList [Weight s]
weights'
resSequence :: s
resSequence = forall s.
IsSequence s =>
Sequence (Marking s) (Weight s) (Element s) -> s
fromSequence forall a b. (a -> b) -> a -> b
$ forall mk w a.
Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
Sequence Vector (Element s)
seqVector [(Marking s, Range)]
markings' Vector (Weight s)
weightsVector
checkRanges :: Bool
checkRanges :: Bool
checkRanges = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Range]
faultyRanges
faultyRanges :: [Range]
faultyRanges :: [Range]
faultyRanges = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Range -> Bool
checkRange (forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Element s]
s)) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd [(Marking s, Range)]
markings'
checkNullWeights :: Bool
checkNullWeights :: Bool
checkNullWeights = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Weight s]
weights')
checkLenWeights :: Bool
checkLenWeights :: Bool
checkLenWeights = forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Element s]
s forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Weight s]
weights'
rangesError :: Text
rangesError :: Text
rangesError = Text
"Bio.Sequence.Class: invalid 'Range' found in sequence's marking: \n" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ([String] -> String
unlines (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Range]
faultyRanges))
weightsNullError :: Text
weightsNullError :: Text
weightsNullError = Text
"Bio.Sequence.Class: weights are null for sequence."
weightsLenError :: Text
weightsLenError :: Text
weightsLenError = Text
"Bio.Sequence.Class: sequence and weights have different lengths."