{-# LANGUAGE UndecidableInstances #-}

module Bio.Sequence.Class
  (
  -- class for decoding into sequence
    SequenceDecodable (..)

  -- 'Sequence' type itself
  , Sequence
  , WeightedSequence
  , MarkedSequence
  , BareSequence
  , Range
  , sequ
  , markings
  , weights
  , bareSequ

  -- classes for weights and markings of sequence
  , IsMarking
  , IsWeight (..)

  -- classes that are abstractions over 'Sequence'
  , IsSequence (..)
  , IsWeightedSequence
  , IsMarkedSequence
  , IsBareSequence
  , ContainsMarking
  , ContainsNoMarking
  , ContainsWeight
  , ContainsNoWeight

  -- constructors for 'IsSequence'
  , createSequence
  , unsafeCreateSequence
  , bareSequence
  , weightedSequence
  , unsafeWeightedSequence
  , markedSequence
  , unsafeMarkedSequence

  -- inner unsafe constructor that should be used only in module Bio.Sequence
  , _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)

--------------------------------------------------------------------------------
-- Sequence datatype.
--------------------------------------------------------------------------------

-- 'Sequence' represents sequence of objects of type 'a' that
-- can have different markings of type 'mk' and weights of type 'w'.
--
data Sequence mk w a
  = Sequence
      { Sequence mk w a -> Vector a
_sequ     :: Vector a
        -- ^ sequence itself
      , Sequence mk w a -> [(mk, Range)]
_markings :: [(mk, Range)]
        -- ^ list of pairs containing marking and 'Range', that corresponds to it
      , Sequence mk w a -> Vector w
_weights  :: Vector w
        -- ^ weights for all elements in sequence
      }
  deriving (Sequence mk w a -> Sequence mk w a -> Bool
(Sequence mk w a -> Sequence mk w a -> Bool)
-> (Sequence mk w a -> Sequence mk w a -> Bool)
-> Eq (Sequence mk w a)
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, Int -> Sequence mk w a -> ShowS
[Sequence mk w a] -> ShowS
Sequence mk w a -> String
(Int -> Sequence mk w a -> ShowS)
-> (Sequence mk w a -> String)
-> ([Sequence mk w a] -> ShowS)
-> Show (Sequence mk w a)
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 x. Sequence mk w a -> Rep (Sequence mk w a) x)
-> (forall x. Rep (Sequence mk w a) x -> Sequence mk w a)
-> Generic (Sequence mk w a)
forall x. Rep (Sequence mk w a) x -> Sequence mk w a
forall x. Sequence mk w a -> Rep (Sequence mk w a) x
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, Sequence mk w a -> ()
(Sequence mk w a -> ()) -> NFData (Sequence mk w a)
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, a -> Sequence mk w b -> Sequence mk w a
(a -> b) -> Sequence mk w a -> Sequence mk w b
(forall a b. (a -> b) -> Sequence mk w a -> Sequence mk w b)
-> (forall a b. a -> Sequence mk w b -> Sequence mk w a)
-> Functor (Sequence mk w)
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
<$ :: 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 :: (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 Sequence mk w a
-> Getting (Vector a) (Sequence mk w a) (Vector a) -> Vector a
forall s a. s -> Getting a s a -> a
^. Getting (Vector a) (Sequence mk w a) (Vector a)
forall mk w a. Getter (Sequence mk w a) (Vector a)
sequ     Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Sequence mk w a
sequB Sequence mk w a
-> Getting (Vector a) (Sequence mk w a) (Vector a) -> Vector a
forall s a. s -> Getting a s a -> a
^. Getting (Vector a) (Sequence mk w a) (Vector a)
forall mk w a. Getter (Sequence mk w a) (Vector a)
sequ
      newMarkings :: [(mk, Range)]
newMarkings = Sequence mk w a
sequA Sequence mk w a
-> Getting [(mk, Range)] (Sequence mk w a) [(mk, Range)]
-> [(mk, Range)]
forall s a. s -> Getting a s a -> a
^. Getting [(mk, Range)] (Sequence mk w a) [(mk, Range)]
forall mk w a. Getter (Sequence mk w a) [(mk, Range)]
markings [(mk, Range)] -> [(mk, Range)] -> [(mk, Range)]
forall a. Semigroup a => a -> a -> a
<> ((mk, Range) -> (mk, Range)) -> [(mk, Range)] -> [(mk, Range)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Range -> Range) -> (mk, Range) -> (mk, Range)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Range -> Range
shiftRange Int
addInd)) (Sequence mk w a
sequB Sequence mk w a
-> Getting [(mk, Range)] (Sequence mk w a) [(mk, Range)]
-> [(mk, Range)]
forall s a. s -> Getting a s a -> a
^. Getting [(mk, Range)] (Sequence mk w a) [(mk, Range)]
forall mk w a. Getter (Sequence mk w a) [(mk, Range)]
markings)
      newWeights :: Vector w
newWeights  = Sequence mk w a
sequA Sequence mk w a
-> Getting (Vector w) (Sequence mk w a) (Vector w) -> Vector w
forall s a. s -> Getting a s a -> a
^. Getting (Vector w) (Sequence mk w a) (Vector w)
forall mk w a. Getter (Sequence mk w a) (Vector w)
weights  Vector w -> Vector w -> Vector w
forall a. Semigroup a => a -> a -> a
<> Sequence mk w a
sequB Sequence mk w a
-> Getting (Vector w) (Sequence mk w a) (Vector w) -> Vector w
forall s a. s -> Getting a s a -> a
^. Getting (Vector w) (Sequence mk w a) (Vector w)
forall mk w a. Getter (Sequence mk w a) (Vector w)
weights

      res :: Sequence mk w a
res = Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
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 = Vector a -> Int
forall a. Vector a -> Int
V.length (Sequence mk w a
sequA Sequence mk w a
-> Getting (Vector a) (Sequence mk w a) (Vector a) -> Vector a
forall s a. s -> Getting a s a -> a
^. Getting (Vector a) (Sequence mk w a) (Vector a)
forall mk w a. Getter (Sequence mk w a) (Vector a)
sequ)

instance Monoid (Sequence mk () a) where
  mempty :: Sequence mk () a
mempty = Vector a -> [(mk, Range)] -> Vector () -> Sequence mk () a
forall mk w a.
Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
Sequence Vector a
forall a. Monoid a => a
mempty [(mk, Range)]
forall a. Monoid a => a
mempty Vector ()
forall a. Monoid a => a
mempty

instance Foldable (Sequence mk w) where
  foldMap :: (a -> m) -> Sequence mk w a -> m
foldMap a -> m
f = (a -> m) -> Vector a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (Vector a -> m)
-> (Sequence mk w a -> Vector a) -> Sequence mk w a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sequence mk w a -> Vector a
forall mk w a. Sequence mk w a -> Vector a
_sequ

  length :: Sequence mk w a -> Int
length = Vector a -> Int
forall a. Vector a -> Int
V.length (Vector a -> Int)
-> (Sequence mk w a -> Vector a) -> Sequence mk w a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sequence mk w a -> Vector a
forall mk w a. Sequence mk w a -> Vector a
_sequ

instance Traversable (Sequence mk w) where
  traverse :: (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 }) (Vector b -> Sequence mk w b)
-> f (Vector b) -> f (Sequence mk w b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Vector a -> f (Vector 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

-- | Exported constructor for 'Sequence'. Should be used ONLY in module Bio.Sequence.
--
_sequenceInner :: Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
_sequenceInner :: Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
_sequenceInner = Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
forall mk w a.
Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
Sequence

--------------------------------------------------------------------------------
-- Aliases for 'Sequence'.
--------------------------------------------------------------------------------

-- | Type alias for sequence that has no marking but is weighted.
--
type WeightedSequence w a = Sequence () w a

-- | Type alias for sequence that is not weighted, but has markings.
--
type MarkedSequence mk a = Sequence mk () a

-- | Type alias for sequence that is not weighted and has no markings.
--
type BareSequence a = Sequence () () a

--------------------------------------------------------------------------------
-- Lenses for 'Sequence'.
-- We create only getters, so user that couldn't ruin 'Sequence's invariant.
-- But we can create a Lens for 'BareSequence', and it won't ruin any invariants.
--------------------------------------------------------------------------------

sequ :: Getter (Sequence mk w a) (Vector a)
sequ :: (Vector a -> f (Vector a))
-> Sequence mk w a -> f (Sequence mk w a)
sequ = (Sequence mk w a -> Vector a)
-> (Vector a -> f (Vector a))
-> Sequence mk w a
-> f (Sequence mk w a)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Sequence mk w a -> Vector a
forall mk w a. Sequence mk w a -> Vector a
_sequ

markings :: Getter (Sequence mk w a) [(mk, Range)]
markings :: ([(mk, Range)] -> f [(mk, Range)])
-> Sequence mk w a -> f (Sequence mk w a)
markings = (Sequence mk w a -> [(mk, Range)])
-> ([(mk, Range)] -> f [(mk, Range)])
-> Sequence mk w a
-> f (Sequence mk w a)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Sequence mk w a -> [(mk, Range)]
forall mk w a. Sequence mk w a -> [(mk, Range)]
_markings

weights :: Getter (Sequence mk w a) (Vector w)
weights :: (Vector w -> f (Vector w))
-> Sequence mk w a -> f (Sequence mk w a)
weights  = (Sequence mk w a -> Vector w)
-> (Vector w -> f (Vector w))
-> Sequence mk w a
-> f (Sequence mk w a)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Sequence mk w a -> Vector w
forall mk w a. Sequence mk w a -> Vector w
_weights

bareSequ :: Lens' (BareSequence a) (Vector a)
bareSequ :: (Vector a -> f (Vector a)) -> BareSequence a -> f (BareSequence a)
bareSequ = (BareSequence a -> Vector a)
-> (BareSequence a -> Vector a -> BareSequence a)
-> Lens (BareSequence a) (BareSequence a) (Vector a) (Vector a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BareSequence a -> Vector a
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 })


--------------------------------------------------------------------------------
-- IsMarking class.
--------------------------------------------------------------------------------

-- | Class that reprsents objects that can be markings of 'IsSequence'.
--
class (Eq mk, Ord mk) => IsMarking mk where

instance IsMarking ()


--------------------------------------------------------------------------------
-- IsWeight class.
--------------------------------------------------------------------------------

-- | Class that represents objects that can be weights of 'IsSequence's 'Element's.
--
class IsWeight w where
  toDouble :: w -> Double

instance IsWeight () where
  toDouble :: () -> Double
toDouble = String -> () -> Double
forall a. HasCallStack => String -> a
error String
"Bio.Sequence.Class: () can't be valid 'Weight'."

instance IsWeight Double where
  toDouble :: Double -> Double
toDouble = Double -> Double
forall a. a -> a
id


--------------------------------------------------------------------------------
-- IsSequence class.
--------------------------------------------------------------------------------

-- | Type class that describes object that is isomorphisc to 'Sequence'
-- and contains elements of type 'Element', is marked with marking of type
-- 'Marking' and is weighted with weights of type 'Weight'.
--
-- Special cases, when 'IsSequence' has no markings, has no weights, or
-- has no weights and no markings at the same time are aliased:
--  * 'IsWeightedSequence' is alias for sequence with 'Marking' type set to () and 'Weight' not set to ()
--  * 'IsMarkedSequence' is alias for sequence with 'Weight' type set to () and 'Marking' not set to ().
--  * 'IsBareSequence' is alias for sequence with 'Marking' and 'Weight' types
--     set to ().
--
-- Instances of 'IsSequence' can be built only using special constructors:
--  * 'createSequence' creates 'IsSequence' that has 'Marking' and 'Weight'
--    that are not set to ().
--  * 'bareSequence' creates 'IsSequence' that has 'Marking' and 'Weight'
--    that are set to ().
--  * 'weightedSequence' creates 'IsSequence' that has 'Marking' set to () and
--    'Weight' that is not ().
--  * 'markedSequence' creates 'IsSequence' that has 'Weight' set to () and
--    'Marking' that is not ().
--
-- Constraints and constructors mentioned above gaurantee that 'IsSequence'
-- instances that have no 'Weight's will in compile-time
-- have () as types assosiated with their 'Weight's.
-- That is used to make functions that rely on 'IsSequence' instance
-- having not null weights type-safe.
--
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 = Sequence mk w a
-> Sequence
     (Marking (Sequence mk w a))
     (Weight (Sequence mk w a))
     (Element (Sequence mk w a))
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 = Sequence
  (Marking (Sequence mk w a))
  (Weight (Sequence mk w a))
  (Element (Sequence mk w a))
-> Sequence mk w a
forall a. a -> a
id

-- | Class that allows to decode something into Sequence representation
--
class IsSequence s => SequenceDecodable a s where
  sequenceDecode :: a -> Either Text s


--------------------------------------------------------------------------------
-- Aliases for 'IsSequence'.
--------------------------------------------------------------------------------

-- | Type alias for constraint that checks whether given instance of 'IsSequence'
-- has no markings, but is weighted.
--
type IsWeightedSequence s = (IsSequence s, Unit (Marking s), NotUnit (Weight s))

-- | Type alias for constraint that checks whether given instance of 'IsSequence'
-- has markings, but is not weighted.
--
type IsMarkedSequence s = (IsSequence s, NotUnit (Marking s), Unit (Weight s))

-- | Type alias for constraint that checks whether given instance of 'IsSequence'
-- has no markings and is not weighted.
--
type IsBareSequence s = (IsSequence s, Unit (Marking s), Unit (Weight s))

-- | Type alias for constraint that checks whether given instance @s@ of 'IsSequence'
-- has markings, weights of @s@ are not checked.
--
type ContainsMarking s = (IsSequence s, NotUnit (Marking s))

-- | Type alias for constraint that checks whether given instance @s@ of 'IsSequence'
-- has no markings, weights of @s@ are not checked.
--
type ContainsNoMarking s = (IsSequence s, Unit (Marking s))

-- | Type alias for constraint that checks whether given instance @s@ of 'IsSequence'
-- has weights, markings of @s@ are not checked.
--
type ContainsWeight s = (IsSequence s, NotUnit (Weight s))

-- | Type alias for constraint that checks whether given instance @s@ of 'IsSequence'
-- has no weights, markings of @s@ are not checked.
--
type ContainsNoWeight s = (IsSequence s, Unit (Weight s))


--------------------------------------------------------------------------------
-- Constructors for 'IsSequence's.
--------------------------------------------------------------------------------

-- | Create 'IsSequence' @s@ that has both markings and weights.
-- If any of the markings is invalid or length of weights list is not equal to length
-- of sequence, an error will be thrown.
--
createSequence :: (ContainsMarking s, ContainsWeight s, MonadError Text m) => [Element s] -> [(Marking s, Range)] -> [Weight s] -> m s
createSequence :: [Element s] -> [(Marking s, Range)] -> [Weight s] -> m s
createSequence = Bool
-> Bool -> [Element s] -> [(Marking s, Range)] -> [Weight s] -> m s
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 :: [Element s] -> [(Marking s, Range)] -> [Weight s] -> s
unsafeCreateSequence [Element s]
s [(Marking s, Range)]
markings' = Either Text s -> s
forall a. Either Text a -> a
unsafeEither (Either Text s -> s)
-> ([Weight s] -> Either Text s) -> [Weight s] -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Element s] -> [(Marking s, Range)] -> [Weight s] -> Either Text s
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'

-- | Create 'IsBareSequence' @s@, simple sequence without markings and weights.
--
bareSequence :: IsBareSequence s => [Element s] -> s
bareSequence :: [Element s] -> s
bareSequence [Element s]
s = Sequence (Marking s) (Weight s) (Element s) -> s
forall s.
IsSequence s =>
Sequence (Marking s) (Weight s) (Element s) -> s
fromSequence (Sequence (Marking s) (Weight s) (Element s) -> s)
-> Sequence (Marking s) (Weight s) (Element s) -> s
forall a b. (a -> b) -> a -> b
$ Vector (Element s)
-> [(Marking s, Range)]
-> Vector (Weight s)
-> Sequence (Marking s) (Weight s) (Element s)
forall mk w a.
Vector a -> [(mk, Range)] -> Vector w -> Sequence mk w a
Sequence ([Element s] -> Vector (Element s)
forall a. [a] -> Vector a
V.fromList [Element s]
s) [(Marking s, Range)]
forall a. Monoid a => a
mempty Vector (Weight s)
forall a. Monoid a => a
mempty

-- | Create 'IsMarkedSequence' @s@ from list of 'Element's and 'Marking's that
-- mark it. If at least one of ranges in given list of 'Marking's is out of bounds,
-- an error will be thrown.
--
markedSequence :: (IsMarkedSequence s, MonadError Text m) => [Element s] -> [(Marking s, Range)] -> m s
markedSequence :: [Element s] -> [(Marking s, Range)] -> m s
markedSequence [Element s]
s [(Marking s, Range)]
markings' = Bool
-> Bool -> [Element s] -> [(Marking s, Range)] -> [Weight s] -> m s
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 :: [Element s] -> [(Marking s, Range)] -> s
unsafeMarkedSequence [Element s]
s = Either Text s -> s
forall a. Either Text a -> a
unsafeEither (Either Text s -> s)
-> ([(Marking s, Range)] -> Either Text s)
-> [(Marking s, Range)]
-> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Element s] -> [(Marking s, Range)] -> Either Text s
forall s (m :: * -> *).
(IsMarkedSequence s, MonadError Text m) =>
[Element s] -> [(Marking s, Range)] -> m s
markedSequence [Element s]
s

-- | Create 'IsWeightedSequence' @s@ from list of 'Element's and 'Weight's
-- that correspond to each 'Element'. If length of list of 'Weight's
-- is not equal to length of sequence or lis is null, an error will be thrown.
--
weightedSequence :: (IsWeightedSequence s, MonadError Text m) => [Element s] -> [Weight s] -> m s
weightedSequence :: [Element s] -> [Weight s] -> m s
weightedSequence [Element s]
s = Bool
-> Bool -> [Element s] -> [(Marking s, Range)] -> [Weight s] -> m 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 :: [Element s] -> [Weight s] -> s
unsafeWeightedSequence [Element s]
s = Either Text s -> s
forall a. Either Text a -> a
unsafeEither (Either Text s -> s)
-> ([Weight s] -> Either Text s) -> [Weight s] -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Element s] -> [Weight s] -> Either Text s
forall s (m :: * -> *).
(IsWeightedSequence s, MonadError Text m) =>
[Element s] -> [Weight s] -> m s
weightedSequence [Element s]
s

--------------------------------------------------------------------------------
-- Utility functions.
--------------------------------------------------------------------------------

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 :: 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     = Text -> m s
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
rangesError 
                                                        | Bool
checkW Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
checkNullWeights = Text -> m s
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
weightsNullError
                                                        | Bool
checkW Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
checkLenWeights  = Text -> m s
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
weightsLenError
                                                        | Bool
otherwise                      = s -> m s
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
resSequence
  where
    seqVector :: Vector (Element s)
seqVector     = [Element s] -> Vector (Element s)
forall a. [a] -> Vector a
V.fromList [Element s]
s
    weightsVector :: Vector (Weight s)
weightsVector = [Weight s] -> Vector (Weight s)
forall a. [a] -> Vector a
V.fromList [Weight s]
weights'

    resSequence :: s
resSequence = Sequence (Marking s) (Weight s) (Element s) -> s
forall s.
IsSequence s =>
Sequence (Marking s) (Weight s) (Element s) -> s
fromSequence (Sequence (Marking s) (Weight s) (Element s) -> s)
-> Sequence (Marking s) (Weight s) (Element s) -> s
forall a b. (a -> b) -> a -> b
$ Vector (Element s)
-> [(Marking s, Range)]
-> Vector (Weight s)
-> Sequence (Marking s) (Weight s) (Element s)
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 = [Range] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Range]
faultyRanges 

    faultyRanges :: [Range]
    faultyRanges :: [Range]
faultyRanges = (Range -> Bool) -> [Range] -> [Range]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Range -> Bool) -> Range -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Range -> Bool
checkRange ([Element s] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Element s]
s)) ([Range] -> [Range]) -> [Range] -> [Range]
forall a b. (a -> b) -> a -> b
$ ((Marking s, Range) -> Range) -> [(Marking s, Range)] -> [Range]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Marking s, Range) -> Range
forall a b. (a, b) -> b
snd [(Marking s, Range)]
markings'

    checkNullWeights :: Bool
    checkNullWeights :: Bool
checkNullWeights = Bool -> Bool
not ([Weight s] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Weight s]
weights')

    checkLenWeights :: Bool
    checkLenWeights :: Bool
checkLenWeights = [Element s] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Element s]
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Weight s] -> Int
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" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ([String] -> String
unlines (Range -> String
forall a. Show a => a -> String
show (Range -> String) -> [Range] -> [String]
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."