{-# LANGUAGE CPP #-}
-- | Common data types used everywhere.  This module is a collection of
-- very basic "bioinformatics" data types that are simple, but don't
-- make sense to define over and over.

module Bio.Base(
    Nucleotide(..), Nucleotides(..),
    Qual(..), toQual, fromQual, fromQualRaised, probToQual,
    Prob'(..), Prob, toProb, fromProb, qualToProb, pow,

    Pair(..),
    Word8,
    nucA, nucC, nucG, nucT,
    nucsA, nucsC, nucsG, nucsT, nucsN, gap,
    toNucleotide, toNucleotides, nucToNucs,
    showNucleotide, showNucleotides,
    isGap,
    isBase,
    isProperBase,
    properBases,
    compl, compls,

    Position(..),
    shiftPosition,
    p_is_reverse,

    Range(..),
    shiftRange,
    reverseRange,
    extendRange,
    insideRange,
    wrapRange
) where

import BasePrelude
#if MIN_VERSION_base(4,9,0)
                             hiding ( log1pexp, log1mexp, (<>) )
#else
                             hiding ( (<>) )
#endif
import Bio.Util.Numeric             ( log1pexp, log1mexp )

import Data.ByteString.Internal     ( c2w )
import Data.Semigroup               ( Semigroup(..) )
import qualified Data.ByteString.Char8 as C
import qualified Data.Vector.Unboxed   as U

-- | A nucleotide base.  We only represent A,C,G,T.  The contained
-- 'Word8' ist guaranteed to be 0..3.
newtype Nucleotide = N { Nucleotide -> Word8
unN :: Word8 } deriving ( Nucleotide -> Nucleotide -> Bool
(Nucleotide -> Nucleotide -> Bool)
-> (Nucleotide -> Nucleotide -> Bool) -> Eq Nucleotide
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nucleotide -> Nucleotide -> Bool
$c/= :: Nucleotide -> Nucleotide -> Bool
== :: Nucleotide -> Nucleotide -> Bool
$c== :: Nucleotide -> Nucleotide -> Bool
Eq, Eq Nucleotide
Eq Nucleotide =>
(Nucleotide -> Nucleotide -> Ordering)
-> (Nucleotide -> Nucleotide -> Bool)
-> (Nucleotide -> Nucleotide -> Bool)
-> (Nucleotide -> Nucleotide -> Bool)
-> (Nucleotide -> Nucleotide -> Bool)
-> (Nucleotide -> Nucleotide -> Nucleotide)
-> (Nucleotide -> Nucleotide -> Nucleotide)
-> Ord Nucleotide
Nucleotide -> Nucleotide -> Bool
Nucleotide -> Nucleotide -> Ordering
Nucleotide -> Nucleotide -> Nucleotide
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
min :: Nucleotide -> Nucleotide -> Nucleotide
$cmin :: Nucleotide -> Nucleotide -> Nucleotide
max :: Nucleotide -> Nucleotide -> Nucleotide
$cmax :: Nucleotide -> Nucleotide -> Nucleotide
>= :: Nucleotide -> Nucleotide -> Bool
$c>= :: Nucleotide -> Nucleotide -> Bool
> :: Nucleotide -> Nucleotide -> Bool
$c> :: Nucleotide -> Nucleotide -> Bool
<= :: Nucleotide -> Nucleotide -> Bool
$c<= :: Nucleotide -> Nucleotide -> Bool
< :: Nucleotide -> Nucleotide -> Bool
$c< :: Nucleotide -> Nucleotide -> Bool
compare :: Nucleotide -> Nucleotide -> Ordering
$ccompare :: Nucleotide -> Nucleotide -> Ordering
$cp1Ord :: Eq Nucleotide
Ord, Int -> Nucleotide
Nucleotide -> Int
Nucleotide -> [Nucleotide]
Nucleotide -> Nucleotide
Nucleotide -> Nucleotide -> [Nucleotide]
Nucleotide -> Nucleotide -> Nucleotide -> [Nucleotide]
(Nucleotide -> Nucleotide)
-> (Nucleotide -> Nucleotide)
-> (Int -> Nucleotide)
-> (Nucleotide -> Int)
-> (Nucleotide -> [Nucleotide])
-> (Nucleotide -> Nucleotide -> [Nucleotide])
-> (Nucleotide -> Nucleotide -> [Nucleotide])
-> (Nucleotide -> Nucleotide -> Nucleotide -> [Nucleotide])
-> Enum Nucleotide
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Nucleotide -> Nucleotide -> Nucleotide -> [Nucleotide]
$cenumFromThenTo :: Nucleotide -> Nucleotide -> Nucleotide -> [Nucleotide]
enumFromTo :: Nucleotide -> Nucleotide -> [Nucleotide]
$cenumFromTo :: Nucleotide -> Nucleotide -> [Nucleotide]
enumFromThen :: Nucleotide -> Nucleotide -> [Nucleotide]
$cenumFromThen :: Nucleotide -> Nucleotide -> [Nucleotide]
enumFrom :: Nucleotide -> [Nucleotide]
$cenumFrom :: Nucleotide -> [Nucleotide]
fromEnum :: Nucleotide -> Int
$cfromEnum :: Nucleotide -> Int
toEnum :: Int -> Nucleotide
$ctoEnum :: Int -> Nucleotide
pred :: Nucleotide -> Nucleotide
$cpred :: Nucleotide -> Nucleotide
succ :: Nucleotide -> Nucleotide
$csucc :: Nucleotide -> Nucleotide
Enum, Ord Nucleotide
Ord Nucleotide =>
((Nucleotide, Nucleotide) -> [Nucleotide])
-> ((Nucleotide, Nucleotide) -> Nucleotide -> Int)
-> ((Nucleotide, Nucleotide) -> Nucleotide -> Int)
-> ((Nucleotide, Nucleotide) -> Nucleotide -> Bool)
-> ((Nucleotide, Nucleotide) -> Int)
-> ((Nucleotide, Nucleotide) -> Int)
-> Ix Nucleotide
(Nucleotide, Nucleotide) -> Int
(Nucleotide, Nucleotide) -> [Nucleotide]
(Nucleotide, Nucleotide) -> Nucleotide -> Bool
(Nucleotide, Nucleotide) -> Nucleotide -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Nucleotide, Nucleotide) -> Int
$cunsafeRangeSize :: (Nucleotide, Nucleotide) -> Int
rangeSize :: (Nucleotide, Nucleotide) -> Int
$crangeSize :: (Nucleotide, Nucleotide) -> Int
inRange :: (Nucleotide, Nucleotide) -> Nucleotide -> Bool
$cinRange :: (Nucleotide, Nucleotide) -> Nucleotide -> Bool
unsafeIndex :: (Nucleotide, Nucleotide) -> Nucleotide -> Int
$cunsafeIndex :: (Nucleotide, Nucleotide) -> Nucleotide -> Int
index :: (Nucleotide, Nucleotide) -> Nucleotide -> Int
$cindex :: (Nucleotide, Nucleotide) -> Nucleotide -> Int
range :: (Nucleotide, Nucleotide) -> [Nucleotide]
$crange :: (Nucleotide, Nucleotide) -> [Nucleotide]
$cp1Ix :: Ord Nucleotide
Ix, Ptr b -> Int -> IO Nucleotide
Ptr b -> Int -> Nucleotide -> IO ()
Ptr Nucleotide -> IO Nucleotide
Ptr Nucleotide -> Int -> IO Nucleotide
Ptr Nucleotide -> Int -> Nucleotide -> IO ()
Ptr Nucleotide -> Nucleotide -> IO ()
Nucleotide -> Int
(Nucleotide -> Int)
-> (Nucleotide -> Int)
-> (Ptr Nucleotide -> Int -> IO Nucleotide)
-> (Ptr Nucleotide -> Int -> Nucleotide -> IO ())
-> (forall b. Ptr b -> Int -> IO Nucleotide)
-> (forall b. Ptr b -> Int -> Nucleotide -> IO ())
-> (Ptr Nucleotide -> IO Nucleotide)
-> (Ptr Nucleotide -> Nucleotide -> IO ())
-> Storable Nucleotide
forall b. Ptr b -> Int -> IO Nucleotide
forall b. Ptr b -> Int -> Nucleotide -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Nucleotide -> Nucleotide -> IO ()
$cpoke :: Ptr Nucleotide -> Nucleotide -> IO ()
peek :: Ptr Nucleotide -> IO Nucleotide
$cpeek :: Ptr Nucleotide -> IO Nucleotide
pokeByteOff :: Ptr b -> Int -> Nucleotide -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Nucleotide -> IO ()
peekByteOff :: Ptr b -> Int -> IO Nucleotide
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Nucleotide
pokeElemOff :: Ptr Nucleotide -> Int -> Nucleotide -> IO ()
$cpokeElemOff :: Ptr Nucleotide -> Int -> Nucleotide -> IO ()
peekElemOff :: Ptr Nucleotide -> Int -> IO Nucleotide
$cpeekElemOff :: Ptr Nucleotide -> Int -> IO Nucleotide
alignment :: Nucleotide -> Int
$calignment :: Nucleotide -> Int
sizeOf :: Nucleotide -> Int
$csizeOf :: Nucleotide -> Int
Storable )

instance Bounded Nucleotide where
    minBound :: Nucleotide
minBound = Word8 -> Nucleotide
N 0
    maxBound :: Nucleotide
maxBound = Word8 -> Nucleotide
N 3

-- | A nucleotide base in an alignment.
-- Experience says we're dealing with Ns and gaps all the type, so
-- purity be damned, they are included as if they were real bases.
--
-- To allow @Nucleotides@s to be unpacked and incorporated into
-- containers, we choose to represent them the same way as the BAM file
-- format:  as a 4 bit wide field.  Gaps are encoded as 0 where they
-- make sense, N is 15.  The contained 'Word8' is guaranteed to be
-- 0..15.

newtype Nucleotides = Ns { Nucleotides -> Word8
unNs :: Word8 } deriving ( Nucleotides -> Nucleotides -> Bool
(Nucleotides -> Nucleotides -> Bool)
-> (Nucleotides -> Nucleotides -> Bool) -> Eq Nucleotides
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nucleotides -> Nucleotides -> Bool
$c/= :: Nucleotides -> Nucleotides -> Bool
== :: Nucleotides -> Nucleotides -> Bool
$c== :: Nucleotides -> Nucleotides -> Bool
Eq, Eq Nucleotides
Eq Nucleotides =>
(Nucleotides -> Nucleotides -> Ordering)
-> (Nucleotides -> Nucleotides -> Bool)
-> (Nucleotides -> Nucleotides -> Bool)
-> (Nucleotides -> Nucleotides -> Bool)
-> (Nucleotides -> Nucleotides -> Bool)
-> (Nucleotides -> Nucleotides -> Nucleotides)
-> (Nucleotides -> Nucleotides -> Nucleotides)
-> Ord Nucleotides
Nucleotides -> Nucleotides -> Bool
Nucleotides -> Nucleotides -> Ordering
Nucleotides -> Nucleotides -> Nucleotides
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
min :: Nucleotides -> Nucleotides -> Nucleotides
$cmin :: Nucleotides -> Nucleotides -> Nucleotides
max :: Nucleotides -> Nucleotides -> Nucleotides
$cmax :: Nucleotides -> Nucleotides -> Nucleotides
>= :: Nucleotides -> Nucleotides -> Bool
$c>= :: Nucleotides -> Nucleotides -> Bool
> :: Nucleotides -> Nucleotides -> Bool
$c> :: Nucleotides -> Nucleotides -> Bool
<= :: Nucleotides -> Nucleotides -> Bool
$c<= :: Nucleotides -> Nucleotides -> Bool
< :: Nucleotides -> Nucleotides -> Bool
$c< :: Nucleotides -> Nucleotides -> Bool
compare :: Nucleotides -> Nucleotides -> Ordering
$ccompare :: Nucleotides -> Nucleotides -> Ordering
$cp1Ord :: Eq Nucleotides
Ord, Int -> Nucleotides
Nucleotides -> Int
Nucleotides -> [Nucleotides]
Nucleotides -> Nucleotides
Nucleotides -> Nucleotides -> [Nucleotides]
Nucleotides -> Nucleotides -> Nucleotides -> [Nucleotides]
(Nucleotides -> Nucleotides)
-> (Nucleotides -> Nucleotides)
-> (Int -> Nucleotides)
-> (Nucleotides -> Int)
-> (Nucleotides -> [Nucleotides])
-> (Nucleotides -> Nucleotides -> [Nucleotides])
-> (Nucleotides -> Nucleotides -> [Nucleotides])
-> (Nucleotides -> Nucleotides -> Nucleotides -> [Nucleotides])
-> Enum Nucleotides
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Nucleotides -> Nucleotides -> Nucleotides -> [Nucleotides]
$cenumFromThenTo :: Nucleotides -> Nucleotides -> Nucleotides -> [Nucleotides]
enumFromTo :: Nucleotides -> Nucleotides -> [Nucleotides]
$cenumFromTo :: Nucleotides -> Nucleotides -> [Nucleotides]
enumFromThen :: Nucleotides -> Nucleotides -> [Nucleotides]
$cenumFromThen :: Nucleotides -> Nucleotides -> [Nucleotides]
enumFrom :: Nucleotides -> [Nucleotides]
$cenumFrom :: Nucleotides -> [Nucleotides]
fromEnum :: Nucleotides -> Int
$cfromEnum :: Nucleotides -> Int
toEnum :: Int -> Nucleotides
$ctoEnum :: Int -> Nucleotides
pred :: Nucleotides -> Nucleotides
$cpred :: Nucleotides -> Nucleotides
succ :: Nucleotides -> Nucleotides
$csucc :: Nucleotides -> Nucleotides
Enum, Ord Nucleotides
Ord Nucleotides =>
((Nucleotides, Nucleotides) -> [Nucleotides])
-> ((Nucleotides, Nucleotides) -> Nucleotides -> Int)
-> ((Nucleotides, Nucleotides) -> Nucleotides -> Int)
-> ((Nucleotides, Nucleotides) -> Nucleotides -> Bool)
-> ((Nucleotides, Nucleotides) -> Int)
-> ((Nucleotides, Nucleotides) -> Int)
-> Ix Nucleotides
(Nucleotides, Nucleotides) -> Int
(Nucleotides, Nucleotides) -> [Nucleotides]
(Nucleotides, Nucleotides) -> Nucleotides -> Bool
(Nucleotides, Nucleotides) -> Nucleotides -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Nucleotides, Nucleotides) -> Int
$cunsafeRangeSize :: (Nucleotides, Nucleotides) -> Int
rangeSize :: (Nucleotides, Nucleotides) -> Int
$crangeSize :: (Nucleotides, Nucleotides) -> Int
inRange :: (Nucleotides, Nucleotides) -> Nucleotides -> Bool
$cinRange :: (Nucleotides, Nucleotides) -> Nucleotides -> Bool
unsafeIndex :: (Nucleotides, Nucleotides) -> Nucleotides -> Int
$cunsafeIndex :: (Nucleotides, Nucleotides) -> Nucleotides -> Int
index :: (Nucleotides, Nucleotides) -> Nucleotides -> Int
$cindex :: (Nucleotides, Nucleotides) -> Nucleotides -> Int
range :: (Nucleotides, Nucleotides) -> [Nucleotides]
$crange :: (Nucleotides, Nucleotides) -> [Nucleotides]
$cp1Ix :: Ord Nucleotides
Ix, Ptr b -> Int -> IO Nucleotides
Ptr b -> Int -> Nucleotides -> IO ()
Ptr Nucleotides -> IO Nucleotides
Ptr Nucleotides -> Int -> IO Nucleotides
Ptr Nucleotides -> Int -> Nucleotides -> IO ()
Ptr Nucleotides -> Nucleotides -> IO ()
Nucleotides -> Int
(Nucleotides -> Int)
-> (Nucleotides -> Int)
-> (Ptr Nucleotides -> Int -> IO Nucleotides)
-> (Ptr Nucleotides -> Int -> Nucleotides -> IO ())
-> (forall b. Ptr b -> Int -> IO Nucleotides)
-> (forall b. Ptr b -> Int -> Nucleotides -> IO ())
-> (Ptr Nucleotides -> IO Nucleotides)
-> (Ptr Nucleotides -> Nucleotides -> IO ())
-> Storable Nucleotides
forall b. Ptr b -> Int -> IO Nucleotides
forall b. Ptr b -> Int -> Nucleotides -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Nucleotides -> Nucleotides -> IO ()
$cpoke :: Ptr Nucleotides -> Nucleotides -> IO ()
peek :: Ptr Nucleotides -> IO Nucleotides
$cpeek :: Ptr Nucleotides -> IO Nucleotides
pokeByteOff :: Ptr b -> Int -> Nucleotides -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Nucleotides -> IO ()
peekByteOff :: Ptr b -> Int -> IO Nucleotides
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Nucleotides
pokeElemOff :: Ptr Nucleotides -> Int -> Nucleotides -> IO ()
$cpokeElemOff :: Ptr Nucleotides -> Int -> Nucleotides -> IO ()
peekElemOff :: Ptr Nucleotides -> Int -> IO Nucleotides
$cpeekElemOff :: Ptr Nucleotides -> Int -> IO Nucleotides
alignment :: Nucleotides -> Int
$calignment :: Nucleotides -> Int
sizeOf :: Nucleotides -> Int
$csizeOf :: Nucleotides -> Int
Storable )

instance Bounded Nucleotides where
    minBound :: Nucleotides
minBound = Word8 -> Nucleotides
Ns  0
    maxBound :: Nucleotides
maxBound = Word8 -> Nucleotides
Ns 15

instance Semigroup Nucleotides where Ns a :: Word8
a <> :: Nucleotides -> Nucleotides -> Nucleotides
<> Ns b :: Word8
b = Word8 -> Nucleotides
Ns (Word8
a Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
b)
instance Monoid Nucleotides where mempty :: Nucleotides
mempty = Word8 -> Nucleotides
Ns 0 ; mappend :: Nucleotides -> Nucleotides -> Nucleotides
mappend = Nucleotides -> Nucleotides -> Nucleotides
forall a. Semigroup a => a -> a -> a
(<>)

nucToNucs :: Nucleotide -> Nucleotides
nucToNucs :: Nucleotide -> Nucleotides
nucToNucs (N x :: Word8
x) = Word8 -> Nucleotides
Ns (Word8 -> Nucleotides) -> Word8 -> Nucleotides
forall a b. (a -> b) -> a -> b
$ 1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 3)

-- | Qualities are stored in deciban, also known as the Phred scale.  To
-- represent a value @p@, we store @-10 * log_10 p@.  Operations work
-- directly on the \"Phred\" value, as the name suggests.  The same goes
-- for the 'Ord' instance:  greater quality means higher \"Phred\"
-- score, which means lower error probability.

newtype Qual = Q { Qual -> Word8
unQ :: Word8 } deriving ( Qual -> Qual -> Bool
(Qual -> Qual -> Bool) -> (Qual -> Qual -> Bool) -> Eq Qual
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Qual -> Qual -> Bool
$c/= :: Qual -> Qual -> Bool
== :: Qual -> Qual -> Bool
$c== :: Qual -> Qual -> Bool
Eq, Eq Qual
Eq Qual =>
(Qual -> Qual -> Ordering)
-> (Qual -> Qual -> Bool)
-> (Qual -> Qual -> Bool)
-> (Qual -> Qual -> Bool)
-> (Qual -> Qual -> Bool)
-> (Qual -> Qual -> Qual)
-> (Qual -> Qual -> Qual)
-> Ord Qual
Qual -> Qual -> Bool
Qual -> Qual -> Ordering
Qual -> Qual -> Qual
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
min :: Qual -> Qual -> Qual
$cmin :: Qual -> Qual -> Qual
max :: Qual -> Qual -> Qual
$cmax :: Qual -> Qual -> Qual
>= :: Qual -> Qual -> Bool
$c>= :: Qual -> Qual -> Bool
> :: Qual -> Qual -> Bool
$c> :: Qual -> Qual -> Bool
<= :: Qual -> Qual -> Bool
$c<= :: Qual -> Qual -> Bool
< :: Qual -> Qual -> Bool
$c< :: Qual -> Qual -> Bool
compare :: Qual -> Qual -> Ordering
$ccompare :: Qual -> Qual -> Ordering
$cp1Ord :: Eq Qual
Ord, Ptr b -> Int -> IO Qual
Ptr b -> Int -> Qual -> IO ()
Ptr Qual -> IO Qual
Ptr Qual -> Int -> IO Qual
Ptr Qual -> Int -> Qual -> IO ()
Ptr Qual -> Qual -> IO ()
Qual -> Int
(Qual -> Int)
-> (Qual -> Int)
-> (Ptr Qual -> Int -> IO Qual)
-> (Ptr Qual -> Int -> Qual -> IO ())
-> (forall b. Ptr b -> Int -> IO Qual)
-> (forall b. Ptr b -> Int -> Qual -> IO ())
-> (Ptr Qual -> IO Qual)
-> (Ptr Qual -> Qual -> IO ())
-> Storable Qual
forall b. Ptr b -> Int -> IO Qual
forall b. Ptr b -> Int -> Qual -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Qual -> Qual -> IO ()
$cpoke :: Ptr Qual -> Qual -> IO ()
peek :: Ptr Qual -> IO Qual
$cpeek :: Ptr Qual -> IO Qual
pokeByteOff :: Ptr b -> Int -> Qual -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Qual -> IO ()
peekByteOff :: Ptr b -> Int -> IO Qual
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Qual
pokeElemOff :: Ptr Qual -> Int -> Qual -> IO ()
$cpokeElemOff :: Ptr Qual -> Int -> Qual -> IO ()
peekElemOff :: Ptr Qual -> Int -> IO Qual
$cpeekElemOff :: Ptr Qual -> Int -> IO Qual
alignment :: Qual -> Int
$calignment :: Qual -> Int
sizeOf :: Qual -> Int
$csizeOf :: Qual -> Int
Storable, Qual
Qual -> Qual -> Bounded Qual
forall a. a -> a -> Bounded a
maxBound :: Qual
$cmaxBound :: Qual
minBound :: Qual
$cminBound :: Qual
Bounded )

instance Show Qual where
    showsPrec :: Int -> Qual -> ShowS
showsPrec p :: Int
p (Q q :: Word8
q) = (:) 'q' ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Word8 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p Word8
q

toQual :: (Floating a, RealFrac a) => a -> Qual
toQual :: a -> Qual
toQual a :: a
a = Word8 -> Qual
Q (Word8 -> Qual) -> Word8 -> Qual
forall a b. (a -> b) -> a -> b
$ a -> Word8
forall a b. (RealFrac a, Integral b) => a -> b
round (-10 a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
log a
a a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a. Floating a => a -> a
log 10)

fromQual :: Qual -> Double
fromQual :: Qual -> Double
fromQual (Q q :: Word8
q) = 10 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (- Word8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
q Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 10)

fromQualRaised :: Double -> Qual -> Double
fromQualRaised :: Double -> Qual -> Double
fromQualRaised k :: Double
k (Q q :: Word8
q) = 10 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (- Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
* Word8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
q Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 10)

-- | A positive floating point value stored in log domain.  We store the
-- natural logarithm (makes computation easier), but allow conversions
-- to the familiar \"Phred\" scale used for 'Qual' values.
newtype Prob' a = Pr { Prob' a -> a
unPr :: a } deriving ( Prob' a -> Prob' a -> Bool
(Prob' a -> Prob' a -> Bool)
-> (Prob' a -> Prob' a -> Bool) -> Eq (Prob' a)
forall a. Eq a => Prob' a -> Prob' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prob' a -> Prob' a -> Bool
$c/= :: forall a. Eq a => Prob' a -> Prob' a -> Bool
== :: Prob' a -> Prob' a -> Bool
$c== :: forall a. Eq a => Prob' a -> Prob' a -> Bool
Eq, Eq (Prob' a)
Eq (Prob' a) =>
(Prob' a -> Prob' a -> Ordering)
-> (Prob' a -> Prob' a -> Bool)
-> (Prob' a -> Prob' a -> Bool)
-> (Prob' a -> Prob' a -> Bool)
-> (Prob' a -> Prob' a -> Bool)
-> (Prob' a -> Prob' a -> Prob' a)
-> (Prob' a -> Prob' a -> Prob' a)
-> Ord (Prob' a)
Prob' a -> Prob' a -> Bool
Prob' a -> Prob' a -> Ordering
Prob' a -> Prob' a -> Prob' a
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 a. Ord a => Eq (Prob' a)
forall a. Ord a => Prob' a -> Prob' a -> Bool
forall a. Ord a => Prob' a -> Prob' a -> Ordering
forall a. Ord a => Prob' a -> Prob' a -> Prob' a
min :: Prob' a -> Prob' a -> Prob' a
$cmin :: forall a. Ord a => Prob' a -> Prob' a -> Prob' a
max :: Prob' a -> Prob' a -> Prob' a
$cmax :: forall a. Ord a => Prob' a -> Prob' a -> Prob' a
>= :: Prob' a -> Prob' a -> Bool
$c>= :: forall a. Ord a => Prob' a -> Prob' a -> Bool
> :: Prob' a -> Prob' a -> Bool
$c> :: forall a. Ord a => Prob' a -> Prob' a -> Bool
<= :: Prob' a -> Prob' a -> Bool
$c<= :: forall a. Ord a => Prob' a -> Prob' a -> Bool
< :: Prob' a -> Prob' a -> Bool
$c< :: forall a. Ord a => Prob' a -> Prob' a -> Bool
compare :: Prob' a -> Prob' a -> Ordering
$ccompare :: forall a. Ord a => Prob' a -> Prob' a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Prob' a)
Ord, Ptr b -> Int -> IO (Prob' a)
Ptr b -> Int -> Prob' a -> IO ()
Ptr (Prob' a) -> IO (Prob' a)
Ptr (Prob' a) -> Int -> IO (Prob' a)
Ptr (Prob' a) -> Int -> Prob' a -> IO ()
Ptr (Prob' a) -> Prob' a -> IO ()
Prob' a -> Int
(Prob' a -> Int)
-> (Prob' a -> Int)
-> (Ptr (Prob' a) -> Int -> IO (Prob' a))
-> (Ptr (Prob' a) -> Int -> Prob' a -> IO ())
-> (forall b. Ptr b -> Int -> IO (Prob' a))
-> (forall b. Ptr b -> Int -> Prob' a -> IO ())
-> (Ptr (Prob' a) -> IO (Prob' a))
-> (Ptr (Prob' a) -> Prob' a -> IO ())
-> Storable (Prob' a)
forall b. Ptr b -> Int -> IO (Prob' a)
forall b. Ptr b -> Int -> Prob' a -> IO ()
forall a. Storable a => Ptr (Prob' a) -> IO (Prob' a)
forall a. Storable a => Ptr (Prob' a) -> Int -> IO (Prob' a)
forall a. Storable a => Ptr (Prob' a) -> Int -> Prob' a -> IO ()
forall a. Storable a => Ptr (Prob' a) -> Prob' a -> IO ()
forall a. Storable a => Prob' a -> Int
forall a b. Storable a => Ptr b -> Int -> IO (Prob' a)
forall a b. Storable a => Ptr b -> Int -> Prob' a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr (Prob' a) -> Prob' a -> IO ()
$cpoke :: forall a. Storable a => Ptr (Prob' a) -> Prob' a -> IO ()
peek :: Ptr (Prob' a) -> IO (Prob' a)
$cpeek :: forall a. Storable a => Ptr (Prob' a) -> IO (Prob' a)
pokeByteOff :: Ptr b -> Int -> Prob' a -> IO ()
$cpokeByteOff :: forall a b. Storable a => Ptr b -> Int -> Prob' a -> IO ()
peekByteOff :: Ptr b -> Int -> IO (Prob' a)
$cpeekByteOff :: forall a b. Storable a => Ptr b -> Int -> IO (Prob' a)
pokeElemOff :: Ptr (Prob' a) -> Int -> Prob' a -> IO ()
$cpokeElemOff :: forall a. Storable a => Ptr (Prob' a) -> Int -> Prob' a -> IO ()
peekElemOff :: Ptr (Prob' a) -> Int -> IO (Prob' a)
$cpeekElemOff :: forall a. Storable a => Ptr (Prob' a) -> Int -> IO (Prob' a)
alignment :: Prob' a -> Int
$calignment :: forall a. Storable a => Prob' a -> Int
sizeOf :: Prob' a -> Int
$csizeOf :: forall a. Storable a => Prob' a -> Int
Storable )

-- | Common way of using 'Prob''.
type Prob = Prob' Double

instance RealFloat a => Show (Prob' a) where
    showsPrec :: Int -> Prob' a -> ShowS
showsPrec _ (Pr p :: a
p) = (:) 'q' ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just 1) a
q
      where q :: a
q = - 10 a -> a -> a
forall a. Num a => a -> a -> a
* a
p a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a. Floating a => a -> a
log 10

instance (Floating a, Ord a) => Num (Prob' a) where
    {-# INLINE fromInteger #-}
    fromInteger :: Integer -> Prob' a
fromInteger a :: Integer
a = a -> Prob' a
forall a. a -> Prob' a
Pr (a -> a
forall a. Floating a => a -> a
log (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
a))
    {-# INLINE (+) #-}
    Pr x :: a
x + :: Prob' a -> Prob' a -> Prob' a
+ Pr y :: a
y = a -> Prob' a
forall a. a -> Prob' a
Pr (a -> Prob' a) -> a -> Prob' a
forall a b. (a -> b) -> a -> b
$ if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
y then a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. (Floating a, Ord a) => a -> a
log1pexp (a
ya -> a -> a
forall a. Num a => a -> a -> a
-a
x) else a
y a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. (Floating a, Ord a) => a -> a
log1pexp (a
xa -> a -> a
forall a. Num a => a -> a -> a
-a
y)
    {-# INLINE (-) #-}
    Pr x :: a
x - :: Prob' a -> Prob' a -> Prob' a
- Pr y :: a
y = a -> Prob' a
forall a. a -> Prob' a
Pr (a -> Prob' a) -> a -> Prob' a
forall a b. (a -> b) -> a -> b
$ if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
y then a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. (Floating a, Ord a) => a -> a
log1mexp (a
ya -> a -> a
forall a. Num a => a -> a -> a
-a
x) else String -> a
forall a. HasCallStack => String -> a
error "no negative error probabilities"
    {-# INLINE (*) #-}
    Pr a :: a
a * :: Prob' a -> Prob' a -> Prob' a
* Pr b :: a
b = a -> Prob' a
forall a. a -> Prob' a
Pr (a -> Prob' a) -> a -> Prob' a
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
b
    {-# INLINE negate #-}
    negate :: Prob' a -> Prob' a
negate    _ = a -> Prob' a
forall a. a -> Prob' a
Pr (a -> Prob' a) -> a -> Prob' a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. HasCallStack => String -> a
error "no negative error probabilities"
    {-# INLINE abs #-}
    abs :: Prob' a -> Prob' a
abs       x :: Prob' a
x = Prob' a
x
    {-# INLINE signum #-}
    signum :: Prob' a -> Prob' a
signum    _ = a -> Prob' a
forall a. a -> Prob' a
Pr 0

instance (Floating a, Fractional a, Ord a) => Fractional (Prob' a) where
    fromRational :: Rational -> Prob' a
fromRational a :: Rational
a = a -> Prob' a
forall a. a -> Prob' a
Pr (a -> a
forall a. Floating a => a -> a
log (Rational -> a
forall a. Fractional a => Rational -> a
fromRational Rational
a))
    Pr a :: a
a  / :: Prob' a -> Prob' a -> Prob' a
/  Pr b :: a
b = a -> Prob' a
forall a. a -> Prob' a
Pr (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
b)
    recip :: Prob' a -> Prob' a
recip  (Pr a :: a
a) = a -> Prob' a
forall a. a -> Prob' a
Pr (a -> a
forall a. Num a => a -> a
negate a
a)

infixr 8 `pow`
pow :: Num a => Prob' a -> a -> Prob' a
pow :: Prob' a -> a -> Prob' a
pow (Pr a :: a
a) e :: a
e = a -> Prob' a
forall a. a -> Prob' a
Pr (a -> Prob' a) -> a -> Prob' a
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
e


toProb :: Floating a => a -> Prob' a
toProb :: a -> Prob' a
toProb p :: a
p = a -> Prob' a
forall a. a -> Prob' a
Pr (a -> a
forall a. Floating a => a -> a
log a
p)

fromProb :: Floating a => Prob' a -> a
fromProb :: Prob' a -> a
fromProb (Pr q :: a
q) = a -> a
forall a. Floating a => a -> a
exp a
q

qualToProb :: Floating a => Qual -> Prob' a
qualToProb :: Qual -> Prob' a
qualToProb (Q q :: Word8
q) = a -> Prob' a
forall a. a -> Prob' a
Pr (- a -> a
forall a. Floating a => a -> a
log 10 a -> a -> a
forall a. Num a => a -> a -> a
* Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
q a -> a -> a
forall a. Fractional a => a -> a -> a
/ 10)

probToQual :: (Floating a, RealFrac a) => Prob' a -> Qual
probToQual :: Prob' a -> Qual
probToQual (Pr p :: a
p) = Word8 -> Qual
Q (a -> Word8
forall a b. (RealFrac a, Integral b) => a -> b
round (- 10 a -> a -> a
forall a. Num a => a -> a -> a
* a
p a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a. Floating a => a -> a
log 10))

nucA, nucC, nucG, nucT :: Nucleotide
nucA :: Nucleotide
nucA = Word8 -> Nucleotide
N 0
nucC :: Nucleotide
nucC = Word8 -> Nucleotide
N 1
nucG :: Nucleotide
nucG = Word8 -> Nucleotide
N 2
nucT :: Nucleotide
nucT = Word8 -> Nucleotide
N 3

gap, nucsA, nucsC, nucsG, nucsT, nucsN :: Nucleotides
gap :: Nucleotides
gap   = Word8 -> Nucleotides
Ns 0
nucsA :: Nucleotides
nucsA = Word8 -> Nucleotides
Ns 1
nucsC :: Nucleotides
nucsC = Word8 -> Nucleotides
Ns 2
nucsG :: Nucleotides
nucsG = Word8 -> Nucleotides
Ns 4
nucsT :: Nucleotides
nucsT = Word8 -> Nucleotides
Ns 8
nucsN :: Nucleotides
nucsN = Word8 -> Nucleotides
Ns 15


-- | Coordinates in a genome.
-- The position is zero-based, no questions about it.  Think of the
-- position as pointing to the crack between two bases: looking forward
-- you see the next base to the right, looking in the reverse direction
-- you see the complement of the first base to the left.
--
-- To encode the strand, we (virtually) reverse-complement any sequence
-- and prepend it to the normal one.  That way, reversed coordinates
-- have a negative sign and automatically make sense.  Position 0 could
-- either be the beginning of the sequence or the end on the reverse
-- strand... that ambiguity shouldn't really matter.

data Position = Pos {
        Position -> ByteString
p_seq   :: {-# UNPACK #-} !C.ByteString,    -- ^ sequence (e.g. some chromosome)
        Position -> Int
p_start :: {-# UNPACK #-} !Int              -- ^ offset, zero-based
    } deriving (Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
(Int -> Position -> ShowS)
-> (Position -> String) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> String
$cshow :: Position -> String
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show, Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq, Eq Position
Eq Position =>
(Position -> Position -> Ordering)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Position)
-> (Position -> Position -> Position)
-> Ord Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
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
min :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
$cp1Ord :: Eq Position
Ord)

p_is_reverse :: Position -> Bool
p_is_reverse :: Position -> Bool
p_is_reverse = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (Int -> Bool) -> (Position -> Int) -> Position -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Position -> Int
p_start

-- | Ranges in genomes
-- We combine a position with a length.  In 'Range pos len', 'pos' is
-- always the start of a stretch of length 'len'.  Positions therefore
-- move in the opposite direction on the reverse strand.  To get the
-- same stretch on the reverse strand, shift r_pos by r_length, then
-- reverse direction (or call reverseRange).
data Range = Range {
        Range -> Position
r_pos    :: {-# UNPACK #-} !Position,
        Range -> Int
r_length :: {-# UNPACK #-} !Int
    } deriving (Int -> Range -> ShowS
[Range] -> ShowS
Range -> String
(Int -> Range -> ShowS)
-> (Range -> String) -> ([Range] -> ShowS) -> Show Range
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Range] -> ShowS
$cshowList :: [Range] -> ShowS
show :: Range -> String
$cshow :: Range -> String
showsPrec :: Int -> Range -> ShowS
$cshowsPrec :: Int -> Range -> ShowS
Show, Range -> Range -> Bool
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c== :: Range -> Range -> Bool
Eq, Eq Range
Eq Range =>
(Range -> Range -> Ordering)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Range)
-> (Range -> Range -> Range)
-> Ord Range
Range -> Range -> Bool
Range -> Range -> Ordering
Range -> Range -> Range
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
min :: Range -> Range -> Range
$cmin :: Range -> Range -> Range
max :: Range -> Range -> Range
$cmax :: Range -> Range -> Range
>= :: Range -> Range -> Bool
$c>= :: Range -> Range -> Bool
> :: Range -> Range -> Bool
$c> :: Range -> Range -> Bool
<= :: Range -> Range -> Bool
$c<= :: Range -> Range -> Bool
< :: Range -> Range -> Bool
$c< :: Range -> Range -> Bool
compare :: Range -> Range -> Ordering
$ccompare :: Range -> Range -> Ordering
$cp1Ord :: Eq Range
Ord)


-- | Converts a character into a 'Nucleotide'.
-- The codes for A,C,G understood, everything else is a T.  (Error
-- detection is the caller's responsibility.
toNucleotide :: Word8 -> Nucleotide
toNucleotide :: Word8 -> Nucleotide
toNucleotide x :: Word8
x | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'a'  =  Nucleotide
nucA
               | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'c'  =  Nucleotide
nucC
               | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'g'  =  Nucleotide
nucG
               | Bool
otherwise            =  Nucleotide
nucT
{-# INLINABLE toNucleotide #-}

-- | Converts a character into a 'Nucleotides'.
-- The usual codes for A,C,G,T and U are understood along with the IUPAC
-- ambiguity codes, '-' and '.' become gaps and everything else is an N.
toNucleotides :: Word8 -> Nucleotides
toNucleotides :: Word8 -> Nucleotides
toNucleotides x :: Word8
x | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'a'  =  Nucleotides
nucsA
                | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'c'  =  Nucleotides
nucsC
                | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'g'  =  Nucleotides
nucsG
                | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 't'  =  Nucleotides
nucsT
                | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'n'  =  Nucleotides
nucsN
                | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'u'  =  Nucleotides
nucsT
                | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'b'  =  Nucleotides
nucsC Nucleotides -> Nucleotides -> Nucleotides
forall a. Semigroup a => a -> a -> a
<> Nucleotides
nucsG Nucleotides -> Nucleotides -> Nucleotides
forall a. Semigroup a => a -> a -> a
<> Nucleotides
nucsT
                | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'd'  =  Nucleotides
nucsA Nucleotides -> Nucleotides -> Nucleotides
forall a. Semigroup a => a -> a -> a
<> Nucleotides
nucsG Nucleotides -> Nucleotides -> Nucleotides
forall a. Semigroup a => a -> a -> a
<> Nucleotides
nucsT
                | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'h'  =  Nucleotides
nucsA Nucleotides -> Nucleotides -> Nucleotides
forall a. Semigroup a => a -> a -> a
<> Nucleotides
nucsC Nucleotides -> Nucleotides -> Nucleotides
forall a. Semigroup a => a -> a -> a
<> Nucleotides
nucsT
                | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'v'  =  Nucleotides
nucsA Nucleotides -> Nucleotides -> Nucleotides
forall a. Semigroup a => a -> a -> a
<> Nucleotides
nucsC Nucleotides -> Nucleotides -> Nucleotides
forall a. Semigroup a => a -> a -> a
<> Nucleotides
nucsG
                | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'w'  =  Nucleotides
nucsA Nucleotides -> Nucleotides -> Nucleotides
forall a. Semigroup a => a -> a -> a
<> Nucleotides
nucsT
                | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 's'  =  Nucleotides
nucsC Nucleotides -> Nucleotides -> Nucleotides
forall a. Semigroup a => a -> a -> a
<> Nucleotides
nucsG
                | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'm'  =  Nucleotides
nucsA Nucleotides -> Nucleotides -> Nucleotides
forall a. Semigroup a => a -> a -> a
<> Nucleotides
nucsC
                | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'k'  =  Nucleotides
nucsG Nucleotides -> Nucleotides -> Nucleotides
forall a. Semigroup a => a -> a -> a
<> Nucleotides
nucsT
                | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'y'  =  Nucleotides
nucsC Nucleotides -> Nucleotides -> Nucleotides
forall a. Semigroup a => a -> a -> a
<> Nucleotides
nucsT
                | Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. 32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w 'r'  =  Nucleotides
nucsA Nucleotides -> Nucleotides -> Nucleotides
forall a. Semigroup a => a -> a -> a
<> Nucleotides
nucsG
                | Bool
otherwise            =  Nucleotides
gap
{-# INLINABLE toNucleotides #-}

-- | Tests if a 'Nucleotides' is a base.
-- Returns 'True' for everything but gaps.
isBase :: Nucleotides -> Bool
isBase :: Nucleotides -> Bool
isBase (Ns n :: Word8
n) = Word8
n Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0

-- | Tests if a 'Nucleotides' is a proper base.
-- Returns 'True' for A,C,G,T only.
isProperBase :: Nucleotides -> Bool
isProperBase :: Nucleotides -> Bool
isProperBase x :: Nucleotides
x = Nucleotides
x Nucleotides -> Nucleotides -> Bool
forall a. Eq a => a -> a -> Bool
== Nucleotides
nucsA Bool -> Bool -> Bool
|| Nucleotides
x Nucleotides -> Nucleotides -> Bool
forall a. Eq a => a -> a -> Bool
== Nucleotides
nucsC Bool -> Bool -> Bool
|| Nucleotides
x Nucleotides -> Nucleotides -> Bool
forall a. Eq a => a -> a -> Bool
== Nucleotides
nucsG Bool -> Bool -> Bool
|| Nucleotides
x Nucleotides -> Nucleotides -> Bool
forall a. Eq a => a -> a -> Bool
== Nucleotides
nucsT

properBases :: [ Nucleotides ]
properBases :: [Nucleotides]
properBases = [ Nucleotides
nucsA, Nucleotides
nucsC, Nucleotides
nucsG, Nucleotides
nucsT ]

-- | Tests if a 'Nucleotides' is a gap.
-- Returns true only for the gap.
isGap :: Nucleotides -> Bool
isGap :: Nucleotides -> Bool
isGap x :: Nucleotides
x = Nucleotides
x Nucleotides -> Nucleotides -> Bool
forall a. Eq a => a -> a -> Bool
== Nucleotides
gap


{-# INLINE showNucleotide #-}
showNucleotide :: Nucleotide -> Char
showNucleotide :: Nucleotide -> Char
showNucleotide (N x :: Word8
x) = ByteString -> Int -> Char
C.index "ACGT" (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 3

{-# INLINE showNucleotides #-}
showNucleotides :: Nucleotides -> Char
showNucleotides :: Nucleotides -> Char
showNucleotides (Ns x :: Word8
x) = ByteString -> Int -> Char
C.index  "-ACMGRSVTWYHKDBN" (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 15

instance Show Nucleotide where
    show :: Nucleotide -> String
show     x :: Nucleotide
x = [ Nucleotide -> Char
showNucleotide Nucleotide
x ]
    showList :: [Nucleotide] -> ShowS
showList l :: [Nucleotide]
l = ((Nucleotide -> Char) -> [Nucleotide] -> String
forall a b. (a -> b) -> [a] -> [b]
map Nucleotide -> Char
showNucleotide [Nucleotide]
l String -> ShowS
forall a. [a] -> [a] -> [a]
++)

instance Read Nucleotide where
    readsPrec :: Int -> ReadS Nucleotide
readsPrec _ ('a':cs :: String
cs) = [(Nucleotide
nucA, String
cs)]
    readsPrec _ ('A':cs :: String
cs) = [(Nucleotide
nucA, String
cs)]
    readsPrec _ ('c':cs :: String
cs) = [(Nucleotide
nucC, String
cs)]
    readsPrec _ ('C':cs :: String
cs) = [(Nucleotide
nucC, String
cs)]
    readsPrec _ ('g':cs :: String
cs) = [(Nucleotide
nucG, String
cs)]
    readsPrec _ ('G':cs :: String
cs) = [(Nucleotide
nucG, String
cs)]
    readsPrec _ ('t':cs :: String
cs) = [(Nucleotide
nucT, String
cs)]
    readsPrec _ ('T':cs :: String
cs) = [(Nucleotide
nucT, String
cs)]
    readsPrec _ ('u':cs :: String
cs) = [(Nucleotide
nucT, String
cs)]
    readsPrec _ ('U':cs :: String
cs) = [(Nucleotide
nucT, String
cs)]
    readsPrec _     _    = [          ]

    readList :: ReadS [Nucleotide]
readList ('-':cs :: String
cs) = ReadS [Nucleotide]
forall a. Read a => ReadS [a]
readList String
cs
    readList (c :: Char
c:cs :: String
cs) | Char -> Bool
isSpace Char
c = ReadS [Nucleotide]
forall a. Read a => ReadS [a]
readList String
cs
                    | Bool
otherwise = case ReadS Nucleotide
forall a. Read a => ReadS a
reads (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs) of
                            [] -> [ ([],Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs) ]
                            xs :: [(Nucleotide, String)]
xs -> [ (Nucleotide
nNucleotide -> [Nucleotide] -> [Nucleotide]
forall a. a -> [a] -> [a]
:[Nucleotide]
ns,String
r2) | (n :: Nucleotide
n,r1 :: String
r1) <- [(Nucleotide, String)]
xs, (ns :: [Nucleotide]
ns,r2 :: String
r2) <- ReadS [Nucleotide]
forall a. Read a => ReadS [a]
readList String
r1 ]
    readList [] = [([],[])]

instance Show Nucleotides where
    show :: Nucleotides -> String
show     x :: Nucleotides
x = [ Nucleotides -> Char
showNucleotides Nucleotides
x ]
    showList :: [Nucleotides] -> ShowS
showList l :: [Nucleotides]
l = ((Nucleotides -> Char) -> [Nucleotides] -> String
forall a b. (a -> b) -> [a] -> [b]
map Nucleotides -> Char
showNucleotides [Nucleotides]
l String -> ShowS
forall a. [a] -> [a] -> [a]
++)

instance Read Nucleotides where
    readsPrec :: Int -> ReadS Nucleotides
readsPrec _ (c :: Char
c:cs :: String
cs) = [(Word8 -> Nucleotides
toNucleotides (Char -> Word8
c2w Char
c), String
cs)]
    readsPrec _ [    ] = []
    readList :: ReadS [Nucleotides]
readList s :: String
s = let (hd :: String
hd,tl :: String
tl) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\c :: Char
c -> Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| '-' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) String
s
                 in [((Char -> Nucleotides) -> String -> [Nucleotides]
forall a b. (a -> b) -> [a] -> [b]
map (Word8 -> Nucleotides
toNucleotides (Word8 -> Nucleotides) -> (Char -> Word8) -> Char -> Nucleotides
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Word8
c2w) (String -> [Nucleotides]) -> String -> [Nucleotides]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Bool
isSpace) String
hd, String
tl)]

-- | Complements a Nucleotides.
{-# INLINE compl #-}
compl :: Nucleotide -> Nucleotide
compl :: Nucleotide -> Nucleotide
compl (N n :: Word8
n) = Word8 -> Nucleotide
N (Word8 -> Nucleotide) -> Word8 -> Nucleotide
forall a b. (a -> b) -> a -> b
$ Word8
n Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` 3

-- | Complements a Nucleotides.
{-# INLINE compls #-}
compls :: Nucleotides -> Nucleotides
compls :: Nucleotides -> Nucleotides
compls (Ns x :: Word8
x) = Word8 -> Nucleotides
Ns (Word8 -> Nucleotides) -> Word8 -> Nucleotides
forall a b. (a -> b) -> a -> b
$ Vector Word8
ar Vector Word8 -> Int -> Word8
forall a. Unbox a => Vector a -> Int -> a
`U.unsafeIndex` Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 15)
  where
    !ar :: Vector Word8
ar = Int -> [Word8] -> Vector Word8
forall a. Unbox a => Int -> [a] -> Vector a
U.fromListN 16 [ 0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15 ]


-- | Moves a @Position@.  The position is moved forward according to the
-- strand, negative indexes move backward accordingly.
shiftPosition :: Int -> Position -> Position
shiftPosition :: Int -> Position -> Position
shiftPosition a :: Int
a p :: Position
p = Position
p { p_start :: Int
p_start = Position -> Int
p_start Position
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
a }

-- | Moves a @Range@.  This is just @shiftPosition@ lifted.
shiftRange :: Int -> Range -> Range
shiftRange :: Int -> Range -> Range
shiftRange a :: Int
a r :: Range
r = Range
r { r_pos :: Position
r_pos = Int -> Position -> Position
shiftPosition Int
a (Range -> Position
r_pos Range
r) }

-- | Reverses a 'Range' to give the same @Range@ on the opposite strand.
reverseRange :: Range -> Range
reverseRange :: Range -> Range
reverseRange (Range (Pos sq :: ByteString
sq pos :: Int
pos) len :: Int
len) = Position -> Int -> Range
Range (ByteString -> Int -> Position
Pos ByteString
sq (-Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
len)) Int
len

-- | Extends a range.  The length of the range is simply increased.
extendRange :: Int -> Range -> Range
extendRange :: Int -> Range -> Range
extendRange a :: Int
a r :: Range
r = Range
r { r_length :: Int
r_length = Range -> Int
r_length Range
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
a }

-- | Expands a subrange.
-- @(range1 `insideRange` range2)@ interprets @range1@ as a subrange of
-- @range2@ and computes its absolute coordinates.  The sequence name of
-- @range1@ is ignored.
insideRange :: Range -> Range -> Range
insideRange :: Range -> Range -> Range
insideRange r1 :: Range
r1@(Range (Pos _ start1 :: Int
start1) length1 :: Int
length1) r2 :: Range
r2@(Range (Pos sq :: ByteString
sq start2 :: Int
start2) length2 :: Int
length2)
    | Int
start2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0         = Range -> Range
reverseRange (Range -> Range -> Range
insideRange Range
r1 (Range -> Range
reverseRange Range
r2))
    | Int
start1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
length2  = Position -> Int -> Range
Range (ByteString -> Int -> Position
Pos ByteString
sq (Int
start2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
start1)) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
length1 (Int
length2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start1))
    | Bool
otherwise          = Position -> Int -> Range
Range (ByteString -> Int -> Position
Pos ByteString
sq (Int
start2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
length2)) 0


-- | Wraps a range to a region.  This simply normalizes the start
-- position to be in the interval '[0,n)', which only makes sense if the
-- @Range@ is to be mapped onto a circular genome.  This works on both
-- strands and the strand information is retained.
wrapRange :: Int -> Range -> Range
wrapRange :: Int -> Range -> Range
wrapRange n :: Int
n (Range (Pos sq :: ByteString
sq s :: Int
s) l :: Int
l) = Position -> Int -> Range
Range (ByteString -> Int -> Position
Pos ByteString
sq (Int
s Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n)) Int
l


-- | A strict pair.
data Pair a b = !a :!: !b deriving(Pair a b -> Pair a b -> Bool
(Pair a b -> Pair a b -> Bool)
-> (Pair a b -> Pair a b -> Bool) -> Eq (Pair a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Pair a b -> Pair a b -> Bool
/= :: Pair a b -> Pair a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Pair a b -> Pair a b -> Bool
== :: Pair a b -> Pair a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Pair a b -> Pair a b -> Bool
Eq, Eq (Pair a b)
Eq (Pair a b) =>
(Pair a b -> Pair a b -> Ordering)
-> (Pair a b -> Pair a b -> Bool)
-> (Pair a b -> Pair a b -> Bool)
-> (Pair a b -> Pair a b -> Bool)
-> (Pair a b -> Pair a b -> Bool)
-> (Pair a b -> Pair a b -> Pair a b)
-> (Pair a b -> Pair a b -> Pair a b)
-> Ord (Pair a b)
Pair a b -> Pair a b -> Bool
Pair a b -> Pair a b -> Ordering
Pair a b -> Pair a b -> Pair a b
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 a b. (Ord a, Ord b) => Eq (Pair a b)
forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Bool
forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Ordering
forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Pair a b
min :: Pair a b -> Pair a b -> Pair a b
$cmin :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Pair a b
max :: Pair a b -> Pair a b -> Pair a b
$cmax :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Pair a b
>= :: Pair a b -> Pair a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Bool
> :: Pair a b -> Pair a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Bool
<= :: Pair a b -> Pair a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Bool
< :: Pair a b -> Pair a b -> Bool
$c< :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Bool
compare :: Pair a b -> Pair a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (Pair a b)
Ord, Int -> Pair a b -> ShowS
[Pair a b] -> ShowS
Pair a b -> String
(Int -> Pair a b -> ShowS)
-> (Pair a b -> String) -> ([Pair a b] -> ShowS) -> Show (Pair a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Pair a b -> ShowS
forall a b. (Show a, Show b) => [Pair a b] -> ShowS
forall a b. (Show a, Show b) => Pair a b -> String
showList :: [Pair a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Pair a b] -> ShowS
show :: Pair a b -> String
$cshow :: forall a b. (Show a, Show b) => Pair a b -> String
showsPrec :: Int -> Pair a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Pair a b -> ShowS
Show, ReadPrec [Pair a b]
ReadPrec (Pair a b)
Int -> ReadS (Pair a b)
ReadS [Pair a b]
(Int -> ReadS (Pair a b))
-> ReadS [Pair a b]
-> ReadPrec (Pair a b)
-> ReadPrec [Pair a b]
-> Read (Pair a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [Pair a b]
forall a b. (Read a, Read b) => ReadPrec (Pair a b)
forall a b. (Read a, Read b) => Int -> ReadS (Pair a b)
forall a b. (Read a, Read b) => ReadS [Pair a b]
readListPrec :: ReadPrec [Pair a b]
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [Pair a b]
readPrec :: ReadPrec (Pair a b)
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (Pair a b)
readList :: ReadS [Pair a b]
$creadList :: forall a b. (Read a, Read b) => ReadS [Pair a b]
readsPrec :: Int -> ReadS (Pair a b)
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (Pair a b)
Read, Pair a b
Pair a b -> Pair a b -> Bounded (Pair a b)
forall a. a -> a -> Bounded a
forall a b. (Bounded a, Bounded b) => Pair a b
maxBound :: Pair a b
$cmaxBound :: forall a b. (Bounded a, Bounded b) => Pair a b
minBound :: Pair a b
$cminBound :: forall a b. (Bounded a, Bounded b) => Pair a b
Bounded, Ord (Pair a b)
Ord (Pair a b) =>
((Pair a b, Pair a b) -> [Pair a b])
-> ((Pair a b, Pair a b) -> Pair a b -> Int)
-> ((Pair a b, Pair a b) -> Pair a b -> Int)
-> ((Pair a b, Pair a b) -> Pair a b -> Bool)
-> ((Pair a b, Pair a b) -> Int)
-> ((Pair a b, Pair a b) -> Int)
-> Ix (Pair a b)
(Pair a b, Pair a b) -> Int
(Pair a b, Pair a b) -> [Pair a b]
(Pair a b, Pair a b) -> Pair a b -> Bool
(Pair a b, Pair a b) -> Pair a b -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
forall a b. (Ix a, Ix b) => Ord (Pair a b)
forall a b. (Ix a, Ix b) => (Pair a b, Pair a b) -> Int
forall a b. (Ix a, Ix b) => (Pair a b, Pair a b) -> [Pair a b]
forall a b.
(Ix a, Ix b) =>
(Pair a b, Pair a b) -> Pair a b -> Bool
forall a b. (Ix a, Ix b) => (Pair a b, Pair a b) -> Pair a b -> Int
unsafeRangeSize :: (Pair a b, Pair a b) -> Int
$cunsafeRangeSize :: forall a b. (Ix a, Ix b) => (Pair a b, Pair a b) -> Int
rangeSize :: (Pair a b, Pair a b) -> Int
$crangeSize :: forall a b. (Ix a, Ix b) => (Pair a b, Pair a b) -> Int
inRange :: (Pair a b, Pair a b) -> Pair a b -> Bool
$cinRange :: forall a b.
(Ix a, Ix b) =>
(Pair a b, Pair a b) -> Pair a b -> Bool
unsafeIndex :: (Pair a b, Pair a b) -> Pair a b -> Int
$cunsafeIndex :: forall a b. (Ix a, Ix b) => (Pair a b, Pair a b) -> Pair a b -> Int
index :: (Pair a b, Pair a b) -> Pair a b -> Int
$cindex :: forall a b. (Ix a, Ix b) => (Pair a b, Pair a b) -> Pair a b -> Int
range :: (Pair a b, Pair a b) -> [Pair a b]
$crange :: forall a b. (Ix a, Ix b) => (Pair a b, Pair a b) -> [Pair a b]
$cp1Ix :: forall a b. (Ix a, Ix b) => Ord (Pair a b)
Ix)
infixl 2 :!: