{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Network.QPACK.Types where

import Imports

newtype AbsoluteIndex    = AbsoluteIndex    Int deriving (AbsoluteIndex -> AbsoluteIndex -> Bool
(AbsoluteIndex -> AbsoluteIndex -> Bool)
-> (AbsoluteIndex -> AbsoluteIndex -> Bool) -> Eq AbsoluteIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbsoluteIndex -> AbsoluteIndex -> Bool
$c/= :: AbsoluteIndex -> AbsoluteIndex -> Bool
== :: AbsoluteIndex -> AbsoluteIndex -> Bool
$c== :: AbsoluteIndex -> AbsoluteIndex -> Bool
Eq, Eq AbsoluteIndex
Eq AbsoluteIndex
-> (AbsoluteIndex -> AbsoluteIndex -> Ordering)
-> (AbsoluteIndex -> AbsoluteIndex -> Bool)
-> (AbsoluteIndex -> AbsoluteIndex -> Bool)
-> (AbsoluteIndex -> AbsoluteIndex -> Bool)
-> (AbsoluteIndex -> AbsoluteIndex -> Bool)
-> (AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex)
-> (AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex)
-> Ord AbsoluteIndex
AbsoluteIndex -> AbsoluteIndex -> Bool
AbsoluteIndex -> AbsoluteIndex -> Ordering
AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex
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 :: AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex
$cmin :: AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex
max :: AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex
$cmax :: AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex
>= :: AbsoluteIndex -> AbsoluteIndex -> Bool
$c>= :: AbsoluteIndex -> AbsoluteIndex -> Bool
> :: AbsoluteIndex -> AbsoluteIndex -> Bool
$c> :: AbsoluteIndex -> AbsoluteIndex -> Bool
<= :: AbsoluteIndex -> AbsoluteIndex -> Bool
$c<= :: AbsoluteIndex -> AbsoluteIndex -> Bool
< :: AbsoluteIndex -> AbsoluteIndex -> Bool
$c< :: AbsoluteIndex -> AbsoluteIndex -> Bool
compare :: AbsoluteIndex -> AbsoluteIndex -> Ordering
$ccompare :: AbsoluteIndex -> AbsoluteIndex -> Ordering
$cp1Ord :: Eq AbsoluteIndex
Ord, Int -> AbsoluteIndex -> ShowS
[AbsoluteIndex] -> ShowS
AbsoluteIndex -> String
(Int -> AbsoluteIndex -> ShowS)
-> (AbsoluteIndex -> String)
-> ([AbsoluteIndex] -> ShowS)
-> Show AbsoluteIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbsoluteIndex] -> ShowS
$cshowList :: [AbsoluteIndex] -> ShowS
show :: AbsoluteIndex -> String
$cshow :: AbsoluteIndex -> String
showsPrec :: Int -> AbsoluteIndex -> ShowS
$cshowsPrec :: Int -> AbsoluteIndex -> ShowS
Show, Integer -> AbsoluteIndex
AbsoluteIndex -> AbsoluteIndex
AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex
(AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex)
-> (AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex)
-> (AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex)
-> (AbsoluteIndex -> AbsoluteIndex)
-> (AbsoluteIndex -> AbsoluteIndex)
-> (AbsoluteIndex -> AbsoluteIndex)
-> (Integer -> AbsoluteIndex)
-> Num AbsoluteIndex
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> AbsoluteIndex
$cfromInteger :: Integer -> AbsoluteIndex
signum :: AbsoluteIndex -> AbsoluteIndex
$csignum :: AbsoluteIndex -> AbsoluteIndex
abs :: AbsoluteIndex -> AbsoluteIndex
$cabs :: AbsoluteIndex -> AbsoluteIndex
negate :: AbsoluteIndex -> AbsoluteIndex
$cnegate :: AbsoluteIndex -> AbsoluteIndex
* :: AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex
$c* :: AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex
- :: AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex
$c- :: AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex
+ :: AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex
$c+ :: AbsoluteIndex -> AbsoluteIndex -> AbsoluteIndex
Num)
newtype InsRelativeIndex = InsRelativeIndex Int deriving (InsRelativeIndex -> InsRelativeIndex -> Bool
(InsRelativeIndex -> InsRelativeIndex -> Bool)
-> (InsRelativeIndex -> InsRelativeIndex -> Bool)
-> Eq InsRelativeIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InsRelativeIndex -> InsRelativeIndex -> Bool
$c/= :: InsRelativeIndex -> InsRelativeIndex -> Bool
== :: InsRelativeIndex -> InsRelativeIndex -> Bool
$c== :: InsRelativeIndex -> InsRelativeIndex -> Bool
Eq, Eq InsRelativeIndex
Eq InsRelativeIndex
-> (InsRelativeIndex -> InsRelativeIndex -> Ordering)
-> (InsRelativeIndex -> InsRelativeIndex -> Bool)
-> (InsRelativeIndex -> InsRelativeIndex -> Bool)
-> (InsRelativeIndex -> InsRelativeIndex -> Bool)
-> (InsRelativeIndex -> InsRelativeIndex -> Bool)
-> (InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex)
-> (InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex)
-> Ord InsRelativeIndex
InsRelativeIndex -> InsRelativeIndex -> Bool
InsRelativeIndex -> InsRelativeIndex -> Ordering
InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex
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 :: InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex
$cmin :: InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex
max :: InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex
$cmax :: InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex
>= :: InsRelativeIndex -> InsRelativeIndex -> Bool
$c>= :: InsRelativeIndex -> InsRelativeIndex -> Bool
> :: InsRelativeIndex -> InsRelativeIndex -> Bool
$c> :: InsRelativeIndex -> InsRelativeIndex -> Bool
<= :: InsRelativeIndex -> InsRelativeIndex -> Bool
$c<= :: InsRelativeIndex -> InsRelativeIndex -> Bool
< :: InsRelativeIndex -> InsRelativeIndex -> Bool
$c< :: InsRelativeIndex -> InsRelativeIndex -> Bool
compare :: InsRelativeIndex -> InsRelativeIndex -> Ordering
$ccompare :: InsRelativeIndex -> InsRelativeIndex -> Ordering
$cp1Ord :: Eq InsRelativeIndex
Ord, Int -> InsRelativeIndex -> ShowS
[InsRelativeIndex] -> ShowS
InsRelativeIndex -> String
(Int -> InsRelativeIndex -> ShowS)
-> (InsRelativeIndex -> String)
-> ([InsRelativeIndex] -> ShowS)
-> Show InsRelativeIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InsRelativeIndex] -> ShowS
$cshowList :: [InsRelativeIndex] -> ShowS
show :: InsRelativeIndex -> String
$cshow :: InsRelativeIndex -> String
showsPrec :: Int -> InsRelativeIndex -> ShowS
$cshowsPrec :: Int -> InsRelativeIndex -> ShowS
Show, Integer -> InsRelativeIndex
InsRelativeIndex -> InsRelativeIndex
InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex
(InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex)
-> (InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex)
-> (InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex)
-> (InsRelativeIndex -> InsRelativeIndex)
-> (InsRelativeIndex -> InsRelativeIndex)
-> (InsRelativeIndex -> InsRelativeIndex)
-> (Integer -> InsRelativeIndex)
-> Num InsRelativeIndex
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> InsRelativeIndex
$cfromInteger :: Integer -> InsRelativeIndex
signum :: InsRelativeIndex -> InsRelativeIndex
$csignum :: InsRelativeIndex -> InsRelativeIndex
abs :: InsRelativeIndex -> InsRelativeIndex
$cabs :: InsRelativeIndex -> InsRelativeIndex
negate :: InsRelativeIndex -> InsRelativeIndex
$cnegate :: InsRelativeIndex -> InsRelativeIndex
* :: InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex
$c* :: InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex
- :: InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex
$c- :: InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex
+ :: InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex
$c+ :: InsRelativeIndex -> InsRelativeIndex -> InsRelativeIndex
Num)
newtype HBRelativeIndex  = HBRelativeIndex  Int deriving (HBRelativeIndex -> HBRelativeIndex -> Bool
(HBRelativeIndex -> HBRelativeIndex -> Bool)
-> (HBRelativeIndex -> HBRelativeIndex -> Bool)
-> Eq HBRelativeIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HBRelativeIndex -> HBRelativeIndex -> Bool
$c/= :: HBRelativeIndex -> HBRelativeIndex -> Bool
== :: HBRelativeIndex -> HBRelativeIndex -> Bool
$c== :: HBRelativeIndex -> HBRelativeIndex -> Bool
Eq, Eq HBRelativeIndex
Eq HBRelativeIndex
-> (HBRelativeIndex -> HBRelativeIndex -> Ordering)
-> (HBRelativeIndex -> HBRelativeIndex -> Bool)
-> (HBRelativeIndex -> HBRelativeIndex -> Bool)
-> (HBRelativeIndex -> HBRelativeIndex -> Bool)
-> (HBRelativeIndex -> HBRelativeIndex -> Bool)
-> (HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex)
-> (HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex)
-> Ord HBRelativeIndex
HBRelativeIndex -> HBRelativeIndex -> Bool
HBRelativeIndex -> HBRelativeIndex -> Ordering
HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex
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 :: HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex
$cmin :: HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex
max :: HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex
$cmax :: HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex
>= :: HBRelativeIndex -> HBRelativeIndex -> Bool
$c>= :: HBRelativeIndex -> HBRelativeIndex -> Bool
> :: HBRelativeIndex -> HBRelativeIndex -> Bool
$c> :: HBRelativeIndex -> HBRelativeIndex -> Bool
<= :: HBRelativeIndex -> HBRelativeIndex -> Bool
$c<= :: HBRelativeIndex -> HBRelativeIndex -> Bool
< :: HBRelativeIndex -> HBRelativeIndex -> Bool
$c< :: HBRelativeIndex -> HBRelativeIndex -> Bool
compare :: HBRelativeIndex -> HBRelativeIndex -> Ordering
$ccompare :: HBRelativeIndex -> HBRelativeIndex -> Ordering
$cp1Ord :: Eq HBRelativeIndex
Ord, Int -> HBRelativeIndex -> ShowS
[HBRelativeIndex] -> ShowS
HBRelativeIndex -> String
(Int -> HBRelativeIndex -> ShowS)
-> (HBRelativeIndex -> String)
-> ([HBRelativeIndex] -> ShowS)
-> Show HBRelativeIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HBRelativeIndex] -> ShowS
$cshowList :: [HBRelativeIndex] -> ShowS
show :: HBRelativeIndex -> String
$cshow :: HBRelativeIndex -> String
showsPrec :: Int -> HBRelativeIndex -> ShowS
$cshowsPrec :: Int -> HBRelativeIndex -> ShowS
Show, Integer -> HBRelativeIndex
HBRelativeIndex -> HBRelativeIndex
HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex
(HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex)
-> (HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex)
-> (HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex)
-> (HBRelativeIndex -> HBRelativeIndex)
-> (HBRelativeIndex -> HBRelativeIndex)
-> (HBRelativeIndex -> HBRelativeIndex)
-> (Integer -> HBRelativeIndex)
-> Num HBRelativeIndex
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> HBRelativeIndex
$cfromInteger :: Integer -> HBRelativeIndex
signum :: HBRelativeIndex -> HBRelativeIndex
$csignum :: HBRelativeIndex -> HBRelativeIndex
abs :: HBRelativeIndex -> HBRelativeIndex
$cabs :: HBRelativeIndex -> HBRelativeIndex
negate :: HBRelativeIndex -> HBRelativeIndex
$cnegate :: HBRelativeIndex -> HBRelativeIndex
* :: HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex
$c* :: HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex
- :: HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex
$c- :: HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex
+ :: HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex
$c+ :: HBRelativeIndex -> HBRelativeIndex -> HBRelativeIndex
Num)
newtype PostBaseIndex    = PostBaseIndex    Int deriving (PostBaseIndex -> PostBaseIndex -> Bool
(PostBaseIndex -> PostBaseIndex -> Bool)
-> (PostBaseIndex -> PostBaseIndex -> Bool) -> Eq PostBaseIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostBaseIndex -> PostBaseIndex -> Bool
$c/= :: PostBaseIndex -> PostBaseIndex -> Bool
== :: PostBaseIndex -> PostBaseIndex -> Bool
$c== :: PostBaseIndex -> PostBaseIndex -> Bool
Eq, Eq PostBaseIndex
Eq PostBaseIndex
-> (PostBaseIndex -> PostBaseIndex -> Ordering)
-> (PostBaseIndex -> PostBaseIndex -> Bool)
-> (PostBaseIndex -> PostBaseIndex -> Bool)
-> (PostBaseIndex -> PostBaseIndex -> Bool)
-> (PostBaseIndex -> PostBaseIndex -> Bool)
-> (PostBaseIndex -> PostBaseIndex -> PostBaseIndex)
-> (PostBaseIndex -> PostBaseIndex -> PostBaseIndex)
-> Ord PostBaseIndex
PostBaseIndex -> PostBaseIndex -> Bool
PostBaseIndex -> PostBaseIndex -> Ordering
PostBaseIndex -> PostBaseIndex -> PostBaseIndex
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 :: PostBaseIndex -> PostBaseIndex -> PostBaseIndex
$cmin :: PostBaseIndex -> PostBaseIndex -> PostBaseIndex
max :: PostBaseIndex -> PostBaseIndex -> PostBaseIndex
$cmax :: PostBaseIndex -> PostBaseIndex -> PostBaseIndex
>= :: PostBaseIndex -> PostBaseIndex -> Bool
$c>= :: PostBaseIndex -> PostBaseIndex -> Bool
> :: PostBaseIndex -> PostBaseIndex -> Bool
$c> :: PostBaseIndex -> PostBaseIndex -> Bool
<= :: PostBaseIndex -> PostBaseIndex -> Bool
$c<= :: PostBaseIndex -> PostBaseIndex -> Bool
< :: PostBaseIndex -> PostBaseIndex -> Bool
$c< :: PostBaseIndex -> PostBaseIndex -> Bool
compare :: PostBaseIndex -> PostBaseIndex -> Ordering
$ccompare :: PostBaseIndex -> PostBaseIndex -> Ordering
$cp1Ord :: Eq PostBaseIndex
Ord, Int -> PostBaseIndex -> ShowS
[PostBaseIndex] -> ShowS
PostBaseIndex -> String
(Int -> PostBaseIndex -> ShowS)
-> (PostBaseIndex -> String)
-> ([PostBaseIndex] -> ShowS)
-> Show PostBaseIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostBaseIndex] -> ShowS
$cshowList :: [PostBaseIndex] -> ShowS
show :: PostBaseIndex -> String
$cshow :: PostBaseIndex -> String
showsPrec :: Int -> PostBaseIndex -> ShowS
$cshowsPrec :: Int -> PostBaseIndex -> ShowS
Show, Integer -> PostBaseIndex
PostBaseIndex -> PostBaseIndex
PostBaseIndex -> PostBaseIndex -> PostBaseIndex
(PostBaseIndex -> PostBaseIndex -> PostBaseIndex)
-> (PostBaseIndex -> PostBaseIndex -> PostBaseIndex)
-> (PostBaseIndex -> PostBaseIndex -> PostBaseIndex)
-> (PostBaseIndex -> PostBaseIndex)
-> (PostBaseIndex -> PostBaseIndex)
-> (PostBaseIndex -> PostBaseIndex)
-> (Integer -> PostBaseIndex)
-> Num PostBaseIndex
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> PostBaseIndex
$cfromInteger :: Integer -> PostBaseIndex
signum :: PostBaseIndex -> PostBaseIndex
$csignum :: PostBaseIndex -> PostBaseIndex
abs :: PostBaseIndex -> PostBaseIndex
$cabs :: PostBaseIndex -> PostBaseIndex
negate :: PostBaseIndex -> PostBaseIndex
$cnegate :: PostBaseIndex -> PostBaseIndex
* :: PostBaseIndex -> PostBaseIndex -> PostBaseIndex
$c* :: PostBaseIndex -> PostBaseIndex -> PostBaseIndex
- :: PostBaseIndex -> PostBaseIndex -> PostBaseIndex
$c- :: PostBaseIndex -> PostBaseIndex -> PostBaseIndex
+ :: PostBaseIndex -> PostBaseIndex -> PostBaseIndex
$c+ :: PostBaseIndex -> PostBaseIndex -> PostBaseIndex
Num)
newtype InsertionPoint   = InsertionPoint   Int deriving (InsertionPoint -> InsertionPoint -> Bool
(InsertionPoint -> InsertionPoint -> Bool)
-> (InsertionPoint -> InsertionPoint -> Bool) -> Eq InsertionPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InsertionPoint -> InsertionPoint -> Bool
$c/= :: InsertionPoint -> InsertionPoint -> Bool
== :: InsertionPoint -> InsertionPoint -> Bool
$c== :: InsertionPoint -> InsertionPoint -> Bool
Eq, Eq InsertionPoint
Eq InsertionPoint
-> (InsertionPoint -> InsertionPoint -> Ordering)
-> (InsertionPoint -> InsertionPoint -> Bool)
-> (InsertionPoint -> InsertionPoint -> Bool)
-> (InsertionPoint -> InsertionPoint -> Bool)
-> (InsertionPoint -> InsertionPoint -> Bool)
-> (InsertionPoint -> InsertionPoint -> InsertionPoint)
-> (InsertionPoint -> InsertionPoint -> InsertionPoint)
-> Ord InsertionPoint
InsertionPoint -> InsertionPoint -> Bool
InsertionPoint -> InsertionPoint -> Ordering
InsertionPoint -> InsertionPoint -> InsertionPoint
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 :: InsertionPoint -> InsertionPoint -> InsertionPoint
$cmin :: InsertionPoint -> InsertionPoint -> InsertionPoint
max :: InsertionPoint -> InsertionPoint -> InsertionPoint
$cmax :: InsertionPoint -> InsertionPoint -> InsertionPoint
>= :: InsertionPoint -> InsertionPoint -> Bool
$c>= :: InsertionPoint -> InsertionPoint -> Bool
> :: InsertionPoint -> InsertionPoint -> Bool
$c> :: InsertionPoint -> InsertionPoint -> Bool
<= :: InsertionPoint -> InsertionPoint -> Bool
$c<= :: InsertionPoint -> InsertionPoint -> Bool
< :: InsertionPoint -> InsertionPoint -> Bool
$c< :: InsertionPoint -> InsertionPoint -> Bool
compare :: InsertionPoint -> InsertionPoint -> Ordering
$ccompare :: InsertionPoint -> InsertionPoint -> Ordering
$cp1Ord :: Eq InsertionPoint
Ord, Int -> InsertionPoint -> ShowS
[InsertionPoint] -> ShowS
InsertionPoint -> String
(Int -> InsertionPoint -> ShowS)
-> (InsertionPoint -> String)
-> ([InsertionPoint] -> ShowS)
-> Show InsertionPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InsertionPoint] -> ShowS
$cshowList :: [InsertionPoint] -> ShowS
show :: InsertionPoint -> String
$cshow :: InsertionPoint -> String
showsPrec :: Int -> InsertionPoint -> ShowS
$cshowsPrec :: Int -> InsertionPoint -> ShowS
Show, Integer -> InsertionPoint
InsertionPoint -> InsertionPoint
InsertionPoint -> InsertionPoint -> InsertionPoint
(InsertionPoint -> InsertionPoint -> InsertionPoint)
-> (InsertionPoint -> InsertionPoint -> InsertionPoint)
-> (InsertionPoint -> InsertionPoint -> InsertionPoint)
-> (InsertionPoint -> InsertionPoint)
-> (InsertionPoint -> InsertionPoint)
-> (InsertionPoint -> InsertionPoint)
-> (Integer -> InsertionPoint)
-> Num InsertionPoint
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> InsertionPoint
$cfromInteger :: Integer -> InsertionPoint
signum :: InsertionPoint -> InsertionPoint
$csignum :: InsertionPoint -> InsertionPoint
abs :: InsertionPoint -> InsertionPoint
$cabs :: InsertionPoint -> InsertionPoint
negate :: InsertionPoint -> InsertionPoint
$cnegate :: InsertionPoint -> InsertionPoint
* :: InsertionPoint -> InsertionPoint -> InsertionPoint
$c* :: InsertionPoint -> InsertionPoint -> InsertionPoint
- :: InsertionPoint -> InsertionPoint -> InsertionPoint
$c- :: InsertionPoint -> InsertionPoint -> InsertionPoint
+ :: InsertionPoint -> InsertionPoint -> InsertionPoint
$c+ :: InsertionPoint -> InsertionPoint -> InsertionPoint
Num)
newtype BasePoint        = BasePoint        Int deriving (BasePoint -> BasePoint -> Bool
(BasePoint -> BasePoint -> Bool)
-> (BasePoint -> BasePoint -> Bool) -> Eq BasePoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BasePoint -> BasePoint -> Bool
$c/= :: BasePoint -> BasePoint -> Bool
== :: BasePoint -> BasePoint -> Bool
$c== :: BasePoint -> BasePoint -> Bool
Eq, Eq BasePoint
Eq BasePoint
-> (BasePoint -> BasePoint -> Ordering)
-> (BasePoint -> BasePoint -> Bool)
-> (BasePoint -> BasePoint -> Bool)
-> (BasePoint -> BasePoint -> Bool)
-> (BasePoint -> BasePoint -> Bool)
-> (BasePoint -> BasePoint -> BasePoint)
-> (BasePoint -> BasePoint -> BasePoint)
-> Ord BasePoint
BasePoint -> BasePoint -> Bool
BasePoint -> BasePoint -> Ordering
BasePoint -> BasePoint -> BasePoint
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 :: BasePoint -> BasePoint -> BasePoint
$cmin :: BasePoint -> BasePoint -> BasePoint
max :: BasePoint -> BasePoint -> BasePoint
$cmax :: BasePoint -> BasePoint -> BasePoint
>= :: BasePoint -> BasePoint -> Bool
$c>= :: BasePoint -> BasePoint -> Bool
> :: BasePoint -> BasePoint -> Bool
$c> :: BasePoint -> BasePoint -> Bool
<= :: BasePoint -> BasePoint -> Bool
$c<= :: BasePoint -> BasePoint -> Bool
< :: BasePoint -> BasePoint -> Bool
$c< :: BasePoint -> BasePoint -> Bool
compare :: BasePoint -> BasePoint -> Ordering
$ccompare :: BasePoint -> BasePoint -> Ordering
$cp1Ord :: Eq BasePoint
Ord, Int -> BasePoint -> ShowS
[BasePoint] -> ShowS
BasePoint -> String
(Int -> BasePoint -> ShowS)
-> (BasePoint -> String)
-> ([BasePoint] -> ShowS)
-> Show BasePoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BasePoint] -> ShowS
$cshowList :: [BasePoint] -> ShowS
show :: BasePoint -> String
$cshow :: BasePoint -> String
showsPrec :: Int -> BasePoint -> ShowS
$cshowsPrec :: Int -> BasePoint -> ShowS
Show, Integer -> BasePoint
BasePoint -> BasePoint
BasePoint -> BasePoint -> BasePoint
(BasePoint -> BasePoint -> BasePoint)
-> (BasePoint -> BasePoint -> BasePoint)
-> (BasePoint -> BasePoint -> BasePoint)
-> (BasePoint -> BasePoint)
-> (BasePoint -> BasePoint)
-> (BasePoint -> BasePoint)
-> (Integer -> BasePoint)
-> Num BasePoint
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> BasePoint
$cfromInteger :: Integer -> BasePoint
signum :: BasePoint -> BasePoint
$csignum :: BasePoint -> BasePoint
abs :: BasePoint -> BasePoint
$cabs :: BasePoint -> BasePoint
negate :: BasePoint -> BasePoint
$cnegate :: BasePoint -> BasePoint
* :: BasePoint -> BasePoint -> BasePoint
$c* :: BasePoint -> BasePoint -> BasePoint
- :: BasePoint -> BasePoint -> BasePoint
$c- :: BasePoint -> BasePoint -> BasePoint
+ :: BasePoint -> BasePoint -> BasePoint
$c+ :: BasePoint -> BasePoint -> BasePoint
Num)

data HIndex = SIndex AbsoluteIndex
            | DIndex AbsoluteIndex
            deriving (HIndex -> HIndex -> Bool
(HIndex -> HIndex -> Bool)
-> (HIndex -> HIndex -> Bool) -> Eq HIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HIndex -> HIndex -> Bool
$c/= :: HIndex -> HIndex -> Bool
== :: HIndex -> HIndex -> Bool
$c== :: HIndex -> HIndex -> Bool
Eq, Eq HIndex
Eq HIndex
-> (HIndex -> HIndex -> Ordering)
-> (HIndex -> HIndex -> Bool)
-> (HIndex -> HIndex -> Bool)
-> (HIndex -> HIndex -> Bool)
-> (HIndex -> HIndex -> Bool)
-> (HIndex -> HIndex -> HIndex)
-> (HIndex -> HIndex -> HIndex)
-> Ord HIndex
HIndex -> HIndex -> Bool
HIndex -> HIndex -> Ordering
HIndex -> HIndex -> HIndex
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 :: HIndex -> HIndex -> HIndex
$cmin :: HIndex -> HIndex -> HIndex
max :: HIndex -> HIndex -> HIndex
$cmax :: HIndex -> HIndex -> HIndex
>= :: HIndex -> HIndex -> Bool
$c>= :: HIndex -> HIndex -> Bool
> :: HIndex -> HIndex -> Bool
$c> :: HIndex -> HIndex -> Bool
<= :: HIndex -> HIndex -> Bool
$c<= :: HIndex -> HIndex -> Bool
< :: HIndex -> HIndex -> Bool
$c< :: HIndex -> HIndex -> Bool
compare :: HIndex -> HIndex -> Ordering
$ccompare :: HIndex -> HIndex -> Ordering
$cp1Ord :: Eq HIndex
Ord, Int -> HIndex -> ShowS
[HIndex] -> ShowS
HIndex -> String
(Int -> HIndex -> ShowS)
-> (HIndex -> String) -> ([HIndex] -> ShowS) -> Show HIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HIndex] -> ShowS
$cshowList :: [HIndex] -> ShowS
show :: HIndex -> String
$cshow :: HIndex -> String
showsPrec :: Int -> HIndex -> ShowS
$cshowsPrec :: Int -> HIndex -> ShowS
Show)

{-
    Dropping    Draining Index               Insertion Point
      |          |                                 |
      v          v                                 v
      +----------+---------------------------------+--------+
      | Draining |          Referenceable          | Unused |
      | Entries  |             Entries             | Space  |
      +----------+---------------------------------+--------+
|  d  |                            |n-4|n-3|n-2|n-1|          Absolute
|n-d-1|                            | 3 | 2 | 1 | 0 |          Relative ins
|n-d-3|                            | 1 | 0 |                  Relative HB
                                           | 0 | 1 |          Post-Base
                                           ^
                                           |
                                          Base = n - 2

                                                   ip = 100
|  d  |                            | 96| 97| 98| 99|          Absolute
|n-d-1|                            | 3 | 2 | 1 | 0 |          Relative ins
|n-d-3|                            | 1 | 0 |                  Relative HB
                                           | 0 | 1 |          Post-Base
                                           bp = 98
-}

-- |
--
-- >>> toInsRelativeIndex 99 100
-- InsRelativeIndex 0
-- >>> toInsRelativeIndex 98 100
-- InsRelativeIndex 1
-- >>> toInsRelativeIndex 97 100
-- InsRelativeIndex 2
-- >>> toInsRelativeIndex 96 100
-- InsRelativeIndex 3
toInsRelativeIndex :: AbsoluteIndex -> InsertionPoint -> InsRelativeIndex
toInsRelativeIndex :: AbsoluteIndex -> InsertionPoint -> InsRelativeIndex
toInsRelativeIndex (AbsoluteIndex Int
idx) (InsertionPoint Int
ip) =
    Int -> InsRelativeIndex
InsRelativeIndex (Int
ip Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- |
--
-- >>> fromInsRelativeIndex 0 100
-- AbsoluteIndex 99
-- >>> fromInsRelativeIndex 1 100
-- AbsoluteIndex 98
-- >>> fromInsRelativeIndex 2 100
-- AbsoluteIndex 97
-- >>> fromInsRelativeIndex 3 100
-- AbsoluteIndex 96
fromInsRelativeIndex :: InsRelativeIndex -> InsertionPoint -> AbsoluteIndex
fromInsRelativeIndex :: InsRelativeIndex -> InsertionPoint -> AbsoluteIndex
fromInsRelativeIndex (InsRelativeIndex Int
ri) (InsertionPoint Int
ip) =
    Int -> AbsoluteIndex
AbsoluteIndex (Int
ip Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ri Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- |
--
-- >>> toHBRelativeIndex 96 98
-- HBRelativeIndex 1
-- >>> toHBRelativeIndex 97 98
-- HBRelativeIndex 0
toHBRelativeIndex :: AbsoluteIndex -> BasePoint -> HBRelativeIndex
toHBRelativeIndex :: AbsoluteIndex -> BasePoint -> HBRelativeIndex
toHBRelativeIndex (AbsoluteIndex Int
idx) (BasePoint Int
bp) =
    Int -> HBRelativeIndex
HBRelativeIndex (Int
bp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- |
--
-- >>> fromHBRelativeIndex 1 98
-- AbsoluteIndex 96
-- >>> fromHBRelativeIndex 0 98
-- AbsoluteIndex 97
fromHBRelativeIndex :: HBRelativeIndex -> BasePoint -> AbsoluteIndex
fromHBRelativeIndex :: HBRelativeIndex -> BasePoint -> AbsoluteIndex
fromHBRelativeIndex (HBRelativeIndex Int
ri) (BasePoint Int
bp) =
    Int -> AbsoluteIndex
AbsoluteIndex (Int
bp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ri Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- |
--
-- >>> toPostBaseIndex 98 98
-- PostBaseIndex 0
-- >>> toPostBaseIndex 99 98
-- PostBaseIndex 1
toPostBaseIndex :: AbsoluteIndex -> BasePoint -> PostBaseIndex
toPostBaseIndex :: AbsoluteIndex -> BasePoint -> PostBaseIndex
toPostBaseIndex (AbsoluteIndex Int
idx) (BasePoint Int
bp) =
    Int -> PostBaseIndex
PostBaseIndex (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bp)

-- |
--
-- >>> fromPostBaseIndex 0 98
-- AbsoluteIndex 98
-- >>> fromPostBaseIndex 1 98
-- AbsoluteIndex 99
fromPostBaseIndex :: PostBaseIndex -> BasePoint -> AbsoluteIndex
fromPostBaseIndex :: PostBaseIndex -> BasePoint -> AbsoluteIndex
fromPostBaseIndex (PostBaseIndex Int
pix) (BasePoint Int
bp) =
    Int -> AbsoluteIndex
AbsoluteIndex (Int
pix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bp)


type Setter = Word8 -> Word8

set1, set01, set10, set11, set001, set0001, set0100, set0101, set0010, set00001:: Setter

set1 :: Setter
set1     = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
7)
set01 :: Setter
set01    = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
6)
set10 :: Setter
set10    = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
7)
set11 :: Setter
set11    = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
7) Setter -> Setter -> Setter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
6)
set001 :: Setter
set001   = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
5)
set0001 :: Setter
set0001  = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
4)
set0100 :: Setter
set0100  = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
6)
set0101 :: Setter
set0101  = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
6) Setter -> Setter -> Setter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
4)
set0010 :: Setter
set0010  = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
5)
set00001 :: Setter
set00001 = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
3)

set0, set00, set000, set0000 :: Setter

set0 :: Setter
set0    = Setter
forall a. a -> a
id
set00 :: Setter
set00   = Setter
forall a. a -> a
id
set000 :: Setter
set000  = Setter
forall a. a -> a
id
set0000 :: Setter
set0000 = Setter
forall a. a -> a
id