{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Network.QPACK.Table.RevIndex (
    RevResult (..),
    RevIndex,
    newRevIndex,
    renewRevIndex,
    lookupRevIndex,
    lookupRevIndex',
    insertRevIndex,
    deleteRevIndex,
    tokenToStaticIndex,
    isKeyRegistered,
    lookupRevIndexS,
) where

import Data.Array (Array)
import qualified Data.Array as A
import Data.Array.Base (unsafeAt)
import Data.Function (on)
import Data.IORef
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.OrdPSQ (OrdPSQ)
import qualified Data.OrdPSQ as PSQ
import Network.HPACK.Internal (Entry (..))
import Network.HTTP.Semantics

import Imports
import Network.QPACK.Table.Static
import Network.QPACK.Token
import Network.QPACK.Types

----------------------------------------------------------------

data RevResult
    = N
    | K HIndex
    | KV HIndex
    deriving (RevResult -> RevResult -> Bool
(RevResult -> RevResult -> Bool)
-> (RevResult -> RevResult -> Bool) -> Eq RevResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RevResult -> RevResult -> Bool
== :: RevResult -> RevResult -> Bool
$c/= :: RevResult -> RevResult -> Bool
/= :: RevResult -> RevResult -> Bool
Eq, Int -> RevResult -> ShowS
[RevResult] -> ShowS
RevResult -> String
(Int -> RevResult -> ShowS)
-> (RevResult -> String)
-> ([RevResult] -> ShowS)
-> Show RevResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RevResult -> ShowS
showsPrec :: Int -> RevResult -> ShowS
$cshow :: RevResult -> String
show :: RevResult -> String
$cshowList :: [RevResult] -> ShowS
showList :: [RevResult] -> ShowS
Show)

----------------------------------------------------------------

data RevIndex = RevIndex DynamicRevIndex OtherRevIndex

----------------------------------------------------------------

type DynamicRevIndex = Array Int (IORef DynamicValueMap)

type DynamicValueMap = Map FieldValue AbsoluteIndex

----------------------------------------------------------------

type OtherRevIndex = IORef (Map FieldName OtherValueMap) -- dynamic table only

type OtherValueMap = OrdPSQ FieldValue Int AbsoluteIndex

----------------------------------------------------------------

type StaticRevIndex = Array Int StaticEntry

data StaticEntry = StaticEntry AbsoluteIndex (Maybe StaticValueMap)
    deriving (Int -> StaticEntry -> ShowS
[StaticEntry] -> ShowS
StaticEntry -> String
(Int -> StaticEntry -> ShowS)
-> (StaticEntry -> String)
-> ([StaticEntry] -> ShowS)
-> Show StaticEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StaticEntry -> ShowS
showsPrec :: Int -> StaticEntry -> ShowS
$cshow :: StaticEntry -> String
show :: StaticEntry -> String
$cshowList :: [StaticEntry] -> ShowS
showList :: [StaticEntry] -> ShowS
Show)

type StaticValueMap = Map FieldValue AbsoluteIndex

----------------------------------------------------------------

staticRevIndex :: StaticRevIndex
staticRevIndex :: StaticRevIndex
staticRevIndex = (Int, Int) -> [(Int, StaticEntry)] -> StaticRevIndex
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
A.array (Int
minTokenIx, Int
51) ([(Int, StaticEntry)] -> StaticRevIndex)
-> [(Int, StaticEntry)] -> StaticRevIndex
forall a b. (a -> b) -> a -> b
$ ((CI FieldName, NonEmpty (FieldName, AbsoluteIndex))
 -> (Int, StaticEntry))
-> [(CI FieldName, NonEmpty (FieldName, AbsoluteIndex))]
-> [(Int, StaticEntry)]
forall a b. (a -> b) -> [a] -> [b]
map (CI FieldName, NonEmpty (FieldName, AbsoluteIndex))
-> (Int, StaticEntry)
toEnt [(CI FieldName, NonEmpty (FieldName, AbsoluteIndex))]
zs
  where
    toEnt :: (CI FieldName, NonEmpty (FieldName, AbsoluteIndex))
-> (Int, StaticEntry)
toEnt (CI FieldName
k, NonEmpty (FieldName, AbsoluteIndex)
xs) = (Int -> Int
quicIx (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Token -> Int
tokenIx (Token -> Int) -> Token -> Int
forall a b. (a -> b) -> a -> b
$ FieldName -> Token
toToken (FieldName -> Token) -> FieldName -> Token
forall a b. (a -> b) -> a -> b
$ CI FieldName -> FieldName
forall s. CI s -> s
foldedCase CI FieldName
k, StaticEntry
m)
      where
        m :: StaticEntry
m = case NonEmpty (FieldName, AbsoluteIndex)
xs of
            (FieldName
"", AbsoluteIndex
i) :| [] -> AbsoluteIndex -> Maybe StaticValueMap -> StaticEntry
StaticEntry AbsoluteIndex
i Maybe StaticValueMap
forall a. Maybe a
Nothing
            (FieldName
_, AbsoluteIndex
i) :| [(FieldName, AbsoluteIndex)]
_ -> AbsoluteIndex -> Maybe StaticValueMap -> StaticEntry
StaticEntry AbsoluteIndex
i (Maybe StaticValueMap -> StaticEntry)
-> Maybe StaticValueMap -> StaticEntry
forall a b. (a -> b) -> a -> b
$ StaticValueMap -> Maybe StaticValueMap
forall a. a -> Maybe a
Just (StaticValueMap -> Maybe StaticValueMap)
-> StaticValueMap -> Maybe StaticValueMap
forall a b. (a -> b) -> a -> b
$ [(FieldName, AbsoluteIndex)] -> StaticValueMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(FieldName, AbsoluteIndex)] -> StaticValueMap)
-> [(FieldName, AbsoluteIndex)] -> StaticValueMap
forall a b. (a -> b) -> a -> b
$ NonEmpty (FieldName, AbsoluteIndex) -> [(FieldName, AbsoluteIndex)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (FieldName, AbsoluteIndex)
xs
    zs :: [(CI FieldName, NonEmpty (FieldName, AbsoluteIndex))]
zs = (NonEmpty (CI FieldName, (FieldName, AbsoluteIndex))
 -> (CI FieldName, NonEmpty (FieldName, AbsoluteIndex)))
-> [NonEmpty (CI FieldName, (FieldName, AbsoluteIndex))]
-> [(CI FieldName, NonEmpty (FieldName, AbsoluteIndex))]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty (CI FieldName, (FieldName, AbsoluteIndex))
-> (CI FieldName, NonEmpty (FieldName, AbsoluteIndex))
forall {a} {b}. NonEmpty (a, b) -> (a, NonEmpty b)
extract ([NonEmpty (CI FieldName, (FieldName, AbsoluteIndex))]
 -> [(CI FieldName, NonEmpty (FieldName, AbsoluteIndex))])
-> [NonEmpty (CI FieldName, (FieldName, AbsoluteIndex))]
-> [(CI FieldName, NonEmpty (FieldName, AbsoluteIndex))]
forall a b. (a -> b) -> a -> b
$ ((CI FieldName, (FieldName, AbsoluteIndex))
 -> (CI FieldName, (FieldName, AbsoluteIndex)) -> Bool)
-> [(CI FieldName, (FieldName, AbsoluteIndex))]
-> [NonEmpty (CI FieldName, (FieldName, AbsoluteIndex))]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy (CI FieldName -> CI FieldName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (CI FieldName -> CI FieldName -> Bool)
-> ((CI FieldName, (FieldName, AbsoluteIndex)) -> CI FieldName)
-> (CI FieldName, (FieldName, AbsoluteIndex))
-> (CI FieldName, (FieldName, AbsoluteIndex))
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (CI FieldName, (FieldName, AbsoluteIndex)) -> CI FieldName
forall a b. (a, b) -> a
fst) ([(CI FieldName, (FieldName, AbsoluteIndex))]
 -> [NonEmpty (CI FieldName, (FieldName, AbsoluteIndex))])
-> [(CI FieldName, (FieldName, AbsoluteIndex))]
-> [NonEmpty (CI FieldName, (FieldName, AbsoluteIndex))]
forall a b. (a -> b) -> a -> b
$ [(CI FieldName, (FieldName, AbsoluteIndex))]
-> [(CI FieldName, (FieldName, AbsoluteIndex))]
forall a. Ord a => [a] -> [a]
sort [(CI FieldName, (FieldName, AbsoluteIndex))]
lst
      where
        lst :: [(CI FieldName, (FieldName, AbsoluteIndex))]
lst =
            ((CI FieldName, FieldName)
 -> AbsoluteIndex -> (CI FieldName, (FieldName, AbsoluteIndex)))
-> [(CI FieldName, FieldName)]
-> [AbsoluteIndex]
-> [(CI FieldName, (FieldName, AbsoluteIndex))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(CI FieldName
k, FieldName
v) AbsoluteIndex
i -> (CI FieldName
k, (FieldName
v, AbsoluteIndex
i))) [(CI FieldName, FieldName)]
staticTableList ([AbsoluteIndex] -> [(CI FieldName, (FieldName, AbsoluteIndex))])
-> [AbsoluteIndex] -> [(CI FieldName, (FieldName, AbsoluteIndex))]
forall a b. (a -> b) -> a -> b
$
                (Int -> AbsoluteIndex) -> [Int] -> [AbsoluteIndex]
forall a b. (a -> b) -> [a] -> [b]
map Int -> AbsoluteIndex
AbsoluteIndex [Int
0 ..]
        extract :: NonEmpty (a, b) -> (a, NonEmpty b)
extract NonEmpty (a, b)
xs = ((a, b) -> a
forall a b. (a, b) -> a
fst (NonEmpty (a, b) -> (a, b)
forall a. NonEmpty a -> a
NE.head NonEmpty (a, b)
xs), ((a, b) -> b) -> NonEmpty (a, b) -> NonEmpty b
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (a, b) -> b
forall a b. (a, b) -> b
snd NonEmpty (a, b)
xs)

{-# INLINE lookupStaticRevIndex #-}
lookupStaticRevIndex :: Int -> FieldValue -> RevResult
lookupStaticRevIndex :: Int -> FieldName -> RevResult
lookupStaticRevIndex Int
ix FieldName
v = case StaticRevIndex
staticRevIndex StaticRevIndex -> Int -> StaticEntry
forall i. Ix i => Array i StaticEntry -> Int -> StaticEntry
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
ix of
    StaticEntry AbsoluteIndex
i Maybe StaticValueMap
Nothing -> HIndex -> RevResult
K (HIndex -> RevResult) -> HIndex -> RevResult
forall a b. (a -> b) -> a -> b
$ AbsoluteIndex -> HIndex
SIndex AbsoluteIndex
i
    StaticEntry AbsoluteIndex
i (Just StaticValueMap
m) -> case FieldName -> StaticValueMap -> Maybe AbsoluteIndex
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FieldName
v StaticValueMap
m of
        Maybe AbsoluteIndex
Nothing -> HIndex -> RevResult
K (HIndex -> RevResult) -> HIndex -> RevResult
forall a b. (a -> b) -> a -> b
$ AbsoluteIndex -> HIndex
SIndex AbsoluteIndex
i
        Just AbsoluteIndex
j -> HIndex -> RevResult
KV (HIndex -> RevResult) -> HIndex -> RevResult
forall a b. (a -> b) -> a -> b
$ AbsoluteIndex -> HIndex
SIndex AbsoluteIndex
j

lookupRevIndexS
    :: Token
    -> FieldValue
    -> RevResult
lookupRevIndexS :: Token -> FieldName -> RevResult
lookupRevIndexS Token{Bool
Int
CI FieldName
tokenIx :: Token -> Int
tokenIx :: Int
shouldBeIndexed :: Bool
isPseudo :: Bool
tokenKey :: CI FieldName
tokenKey :: Token -> CI FieldName
isPseudo :: Token -> Bool
shouldBeIndexed :: Token -> Bool
..} FieldName
v
    | Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = RevResult
N
    | Bool
otherwise = Int -> FieldName -> RevResult
lookupStaticRevIndex Int
ix FieldName
v
  where
    ix :: Int
ix = Int -> Int
quicIx Int
tokenIx

----------------------------------------------------------------

newDynamicRevIndex :: IO DynamicRevIndex
newDynamicRevIndex :: IO DynamicRevIndex
newDynamicRevIndex = (Int, Int) -> [IORef StaticValueMap] -> DynamicRevIndex
forall i e. Ix i => (i, i) -> [e] -> Array i e
A.listArray (Int
minTokenIx, Int
maxStaticTokenIx) ([IORef StaticValueMap] -> DynamicRevIndex)
-> IO [IORef StaticValueMap] -> IO DynamicRevIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> IO (IORef StaticValueMap))
-> [Int] -> IO [IORef StaticValueMap]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Int -> IO (IORef StaticValueMap)
forall {p} {k} {a}. p -> IO (IORef (Map k a))
mk' [Int]
lst
  where
    mk' :: p -> IO (IORef (Map k a))
mk' p
_ = Map k a -> IO (IORef (Map k a))
forall a. a -> IO (IORef a)
newIORef Map k a
forall k a. Map k a
M.empty
    lst :: [Int]
lst = [Int
minTokenIx .. Int
maxStaticTokenIx]

renewDynamicRevIndex :: DynamicRevIndex -> IO ()
renewDynamicRevIndex :: DynamicRevIndex -> IO ()
renewDynamicRevIndex DynamicRevIndex
drev = (Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Int -> IO ()
clear [Int
minTokenIx .. Int
maxStaticTokenIx]
  where
    clear :: Int -> IO ()
clear Int
t = IORef StaticValueMap -> StaticValueMap -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (DynamicRevIndex
drev DynamicRevIndex -> Int -> IORef StaticValueMap
forall i.
Ix i =>
Array i (IORef StaticValueMap) -> Int -> IORef StaticValueMap
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
t) StaticValueMap
forall k a. Map k a
M.empty

{-# INLINE lookupDynamicStaticRevIndex #-}
lookupDynamicStaticRevIndex
    :: Int -> FieldValue -> DynamicRevIndex -> IO RevResult
lookupDynamicStaticRevIndex :: Int -> FieldName -> DynamicRevIndex -> IO RevResult
lookupDynamicStaticRevIndex Int
ix FieldName
v DynamicRevIndex
drev = do
    let ref :: IORef StaticValueMap
ref = DynamicRevIndex
drev DynamicRevIndex -> Int -> IORef StaticValueMap
forall i.
Ix i =>
Array i (IORef StaticValueMap) -> Int -> IORef StaticValueMap
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
ix
    StaticValueMap
m <- IORef StaticValueMap -> IO StaticValueMap
forall a. IORef a -> IO a
readIORef IORef StaticValueMap
ref
    case FieldName -> StaticValueMap -> Maybe AbsoluteIndex
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FieldName
v StaticValueMap
m of
        Just AbsoluteIndex
i -> RevResult -> IO RevResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RevResult -> IO RevResult) -> RevResult -> IO RevResult
forall a b. (a -> b) -> a -> b
$ HIndex -> RevResult
KV (HIndex -> RevResult) -> HIndex -> RevResult
forall a b. (a -> b) -> a -> b
$ AbsoluteIndex -> HIndex
DIndex AbsoluteIndex
i
        Maybe AbsoluteIndex
Nothing -> RevResult -> IO RevResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RevResult -> IO RevResult) -> RevResult -> IO RevResult
forall a b. (a -> b) -> a -> b
$ Int -> FieldName -> RevResult
lookupStaticRevIndex Int
ix FieldName
v

{-# INLINE insertDynamicRevIndex #-}
insertDynamicRevIndex
    :: Token -> FieldValue -> AbsoluteIndex -> DynamicRevIndex -> IO ()
insertDynamicRevIndex :: Token -> FieldName -> AbsoluteIndex -> DynamicRevIndex -> IO ()
insertDynamicRevIndex Token
t FieldName
v AbsoluteIndex
i DynamicRevIndex
drev = IORef StaticValueMap -> (StaticValueMap -> StaticValueMap) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef StaticValueMap
ref ((StaticValueMap -> StaticValueMap) -> IO ())
-> (StaticValueMap -> StaticValueMap) -> IO ()
forall a b. (a -> b) -> a -> b
$ FieldName -> AbsoluteIndex -> StaticValueMap -> StaticValueMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FieldName
v AbsoluteIndex
i
  where
    ref :: IORef StaticValueMap
ref = DynamicRevIndex
drev DynamicRevIndex -> Int -> IORef StaticValueMap
forall i.
Ix i =>
Array i (IORef StaticValueMap) -> Int -> IORef StaticValueMap
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int -> Int
quicIx (Token -> Int
tokenIx Token
t)

{-# INLINE deleteDynamicRevIndex #-}
deleteDynamicRevIndex
    :: Token -> FieldValue -> AbsoluteIndex -> DynamicRevIndex -> IO ()
deleteDynamicRevIndex :: Token -> FieldName -> AbsoluteIndex -> DynamicRevIndex -> IO ()
deleteDynamicRevIndex Token
t FieldName
v AbsoluteIndex
ai DynamicRevIndex
drev = IORef StaticValueMap -> (StaticValueMap -> StaticValueMap) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef StaticValueMap
ref ((StaticValueMap -> StaticValueMap) -> IO ())
-> (StaticValueMap -> StaticValueMap) -> IO ()
forall a b. (a -> b) -> a -> b
$ (Maybe AbsoluteIndex -> Maybe AbsoluteIndex)
-> FieldName -> StaticValueMap -> StaticValueMap
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe AbsoluteIndex -> Maybe AbsoluteIndex
adjust FieldName
v
  where
    ref :: IORef StaticValueMap
ref = DynamicRevIndex
drev DynamicRevIndex -> Int -> IORef StaticValueMap
forall i.
Ix i =>
Array i (IORef StaticValueMap) -> Int -> IORef StaticValueMap
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int -> Int
quicIx (Token -> Int
tokenIx Token
t)
    adjust :: Maybe AbsoluteIndex -> Maybe AbsoluteIndex
adjust Maybe AbsoluteIndex
Nothing = Maybe AbsoluteIndex
forall a. Maybe a
Nothing
    adjust x :: Maybe AbsoluteIndex
x@(Just AbsoluteIndex
ai')
        | AbsoluteIndex
ai AbsoluteIndex -> AbsoluteIndex -> Bool
forall a. Eq a => a -> a -> Bool
== AbsoluteIndex
ai' = Maybe AbsoluteIndex
forall a. Maybe a
Nothing
        -- This previous entry is already deleted by "duplicate"
        | Bool
otherwise = Maybe AbsoluteIndex
x

----------------------------------------------------------------

newOtherRevIndex :: IO OtherRevIndex
newOtherRevIndex :: IO OtherRevIndex
newOtherRevIndex = Map FieldName OtherValueMap -> IO OtherRevIndex
forall a. a -> IO (IORef a)
newIORef Map FieldName OtherValueMap
forall k a. Map k a
M.empty

renewOtherRevIndex :: OtherRevIndex -> IO ()
renewOtherRevIndex :: OtherRevIndex -> IO ()
renewOtherRevIndex OtherRevIndex
ref = OtherRevIndex -> Map FieldName OtherValueMap -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef OtherRevIndex
ref Map FieldName OtherValueMap
forall k a. Map k a
M.empty

{-# INLINE lookupOtherRevIndex #-}
lookupOtherRevIndex :: (FieldName, FieldValue) -> OtherRevIndex -> IO RevResult
lookupOtherRevIndex :: (FieldName, FieldName) -> OtherRevIndex -> IO RevResult
lookupOtherRevIndex (FieldName
k, FieldName
v) OtherRevIndex
ref = do
    Map FieldName OtherValueMap
oth <- OtherRevIndex -> IO (Map FieldName OtherValueMap)
forall a. IORef a -> IO a
readIORef OtherRevIndex
ref
    case FieldName -> Map FieldName OtherValueMap -> Maybe OtherValueMap
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FieldName
k Map FieldName OtherValueMap
oth of
        Maybe OtherValueMap
Nothing -> RevResult -> IO RevResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RevResult
N
        Just OtherValueMap
psq -> case FieldName -> OtherValueMap -> Maybe (Int, AbsoluteIndex)
forall k p v. Ord k => k -> OrdPSQ k p v -> Maybe (p, v)
PSQ.lookup FieldName
v OtherValueMap
psq of
            Maybe (Int, AbsoluteIndex)
Nothing -> case OtherValueMap -> Maybe (FieldName, Int, AbsoluteIndex)
forall k p v. OrdPSQ k p v -> Maybe (k, p, v)
PSQ.findMin OtherValueMap
psq of
                Maybe (FieldName, Int, AbsoluteIndex)
Nothing -> RevResult -> IO RevResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RevResult
N
                Just (FieldName
_, Int
_, AbsoluteIndex
ai) -> RevResult -> IO RevResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RevResult -> IO RevResult) -> RevResult -> IO RevResult
forall a b. (a -> b) -> a -> b
$ HIndex -> RevResult
K (HIndex -> RevResult) -> HIndex -> RevResult
forall a b. (a -> b) -> a -> b
$ AbsoluteIndex -> HIndex
DIndex AbsoluteIndex
ai
            Just (Int
_, AbsoluteIndex
i) -> RevResult -> IO RevResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RevResult -> IO RevResult) -> RevResult -> IO RevResult
forall a b. (a -> b) -> a -> b
$ HIndex -> RevResult
KV (HIndex -> RevResult) -> HIndex -> RevResult
forall a b. (a -> b) -> a -> b
$ AbsoluteIndex -> HIndex
DIndex AbsoluteIndex
i

isKeyRegistered :: FieldName -> RevIndex -> IO (Maybe AbsoluteIndex)
isKeyRegistered :: FieldName -> RevIndex -> IO (Maybe AbsoluteIndex)
isKeyRegistered FieldName
k (RevIndex DynamicRevIndex
_ OtherRevIndex
ref) = do
    Map FieldName OtherValueMap
oth <- OtherRevIndex -> IO (Map FieldName OtherValueMap)
forall a. IORef a -> IO a
readIORef OtherRevIndex
ref
    Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex))
-> Maybe AbsoluteIndex -> IO (Maybe AbsoluteIndex)
forall a b. (a -> b) -> a -> b
$ case FieldName -> Map FieldName OtherValueMap -> Maybe OtherValueMap
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FieldName
k Map FieldName OtherValueMap
oth of
        Maybe OtherValueMap
Nothing -> Maybe AbsoluteIndex
forall a. Maybe a
Nothing
        Just OtherValueMap
psq -> case OtherValueMap -> Maybe (FieldName, Int, AbsoluteIndex)
forall k p v. OrdPSQ k p v -> Maybe (k, p, v)
PSQ.findMin OtherValueMap
psq of
            Maybe (FieldName, Int, AbsoluteIndex)
Nothing -> Maybe AbsoluteIndex
forall a. Maybe a
Nothing
            Just (FieldName
_, Int
_, AbsoluteIndex
ai) -> AbsoluteIndex -> Maybe AbsoluteIndex
forall a. a -> Maybe a
Just AbsoluteIndex
ai

{-# INLINE insertOtherRevIndex #-}
insertOtherRevIndex
    :: Token -> FieldValue -> AbsoluteIndex -> OtherRevIndex -> IO ()
insertOtherRevIndex :: Token -> FieldName -> AbsoluteIndex -> OtherRevIndex -> IO ()
insertOtherRevIndex Token
t FieldName
v ai :: AbsoluteIndex
ai@(AbsoluteIndex Int
i) OtherRevIndex
ref = OtherRevIndex
-> (Map FieldName OtherValueMap -> Map FieldName OtherValueMap)
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' OtherRevIndex
ref ((Map FieldName OtherValueMap -> Map FieldName OtherValueMap)
 -> IO ())
-> (Map FieldName OtherValueMap -> Map FieldName OtherValueMap)
-> IO ()
forall a b. (a -> b) -> a -> b
$ (Maybe OtherValueMap -> Maybe OtherValueMap)
-> FieldName
-> Map FieldName OtherValueMap
-> Map FieldName OtherValueMap
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe OtherValueMap -> Maybe OtherValueMap
adjust FieldName
k
  where
    adjust :: Maybe OtherValueMap -> Maybe OtherValueMap
adjust Maybe OtherValueMap
Nothing = OtherValueMap -> Maybe OtherValueMap
forall a. a -> Maybe a
Just (OtherValueMap -> Maybe OtherValueMap)
-> OtherValueMap -> Maybe OtherValueMap
forall a b. (a -> b) -> a -> b
$ FieldName -> Int -> AbsoluteIndex -> OtherValueMap
forall k p v. k -> p -> v -> OrdPSQ k p v
PSQ.singleton FieldName
v Int
i AbsoluteIndex
ai
    adjust (Just OtherValueMap
psq) = OtherValueMap -> Maybe OtherValueMap
forall a. a -> Maybe a
Just (OtherValueMap -> Maybe OtherValueMap)
-> OtherValueMap -> Maybe OtherValueMap
forall a b. (a -> b) -> a -> b
$ FieldName -> Int -> AbsoluteIndex -> OtherValueMap -> OtherValueMap
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.insert FieldName
v Int
i AbsoluteIndex
ai OtherValueMap
psq
    k :: FieldName
k = Token -> FieldName
tokenFoldedKey Token
t

{-# INLINE deleteOtherRevIndex #-}
deleteOtherRevIndex
    :: Token -> FieldValue -> AbsoluteIndex -> OtherRevIndex -> IO ()
deleteOtherRevIndex :: Token -> FieldName -> AbsoluteIndex -> OtherRevIndex -> IO ()
deleteOtherRevIndex Token
t FieldName
v AbsoluteIndex
ai OtherRevIndex
ref = OtherRevIndex
-> (Map FieldName OtherValueMap -> Map FieldName OtherValueMap)
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' OtherRevIndex
ref ((Map FieldName OtherValueMap -> Map FieldName OtherValueMap)
 -> IO ())
-> (Map FieldName OtherValueMap -> Map FieldName OtherValueMap)
-> IO ()
forall a b. (a -> b) -> a -> b
$ (Maybe OtherValueMap -> Maybe OtherValueMap)
-> FieldName
-> Map FieldName OtherValueMap
-> Map FieldName OtherValueMap
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe OtherValueMap -> Maybe OtherValueMap
forall {p}.
Ord p =>
Maybe (OrdPSQ FieldName p AbsoluteIndex)
-> Maybe (OrdPSQ FieldName p AbsoluteIndex)
adjust FieldName
k
  where
    k :: FieldName
k = Token -> FieldName
tokenFoldedKey Token
t
    -- This previous entry is already deleted by "adjustDrainingPoint"
    adjust :: Maybe (OrdPSQ FieldName p AbsoluteIndex)
-> Maybe (OrdPSQ FieldName p AbsoluteIndex)
adjust Maybe (OrdPSQ FieldName p AbsoluteIndex)
Nothing = Maybe (OrdPSQ FieldName p AbsoluteIndex)
forall a. Maybe a
Nothing
    adjust (Just OrdPSQ FieldName p AbsoluteIndex
psq)
        | OrdPSQ FieldName p AbsoluteIndex -> Bool
forall k p v. OrdPSQ k p v -> Bool
PSQ.null OrdPSQ FieldName p AbsoluteIndex
psq' = Maybe (OrdPSQ FieldName p AbsoluteIndex)
forall a. Maybe a
Nothing
        | Bool
otherwise = OrdPSQ FieldName p AbsoluteIndex
-> Maybe (OrdPSQ FieldName p AbsoluteIndex)
forall a. a -> Maybe a
Just OrdPSQ FieldName p AbsoluteIndex
psq'
      where
        psq' :: OrdPSQ FieldName p AbsoluteIndex
psq' = ((), OrdPSQ FieldName p AbsoluteIndex)
-> OrdPSQ FieldName p AbsoluteIndex
forall a b. (a, b) -> b
snd (((), OrdPSQ FieldName p AbsoluteIndex)
 -> OrdPSQ FieldName p AbsoluteIndex)
-> ((), OrdPSQ FieldName p AbsoluteIndex)
-> OrdPSQ FieldName p AbsoluteIndex
forall a b. (a -> b) -> a -> b
$ (Maybe (p, AbsoluteIndex) -> ((), Maybe (p, AbsoluteIndex)))
-> FieldName
-> OrdPSQ FieldName p AbsoluteIndex
-> ((), OrdPSQ FieldName p AbsoluteIndex)
forall k p v b.
(Ord k, Ord p) =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> k -> OrdPSQ k p v -> (b, OrdPSQ k p v)
PSQ.alter Maybe (p, AbsoluteIndex) -> ((), Maybe (p, AbsoluteIndex))
forall {a}.
Maybe (a, AbsoluteIndex) -> ((), Maybe (a, AbsoluteIndex))
adj FieldName
v OrdPSQ FieldName p AbsoluteIndex
psq
        adj :: Maybe (a, AbsoluteIndex) -> ((), Maybe (a, AbsoluteIndex))
adj x :: Maybe (a, AbsoluteIndex)
x@(Just (a
_, AbsoluteIndex
ai'))
            | AbsoluteIndex
ai AbsoluteIndex -> AbsoluteIndex -> Bool
forall a. Eq a => a -> a -> Bool
== AbsoluteIndex
ai' = ((), Maybe (a, AbsoluteIndex)
forall a. Maybe a
Nothing)
            -- This previous entry is already deleted by "duplicate"
            | Bool
otherwise = ((), Maybe (a, AbsoluteIndex)
x)
        -- This previous entry is already deleted by "adjustDrainingPoint"
        adj Maybe (a, AbsoluteIndex)
Nothing = ((), Maybe (a, AbsoluteIndex)
forall a. Maybe a
Nothing)

----------------------------------------------------------------

newRevIndex :: IO RevIndex
newRevIndex :: IO RevIndex
newRevIndex = DynamicRevIndex -> OtherRevIndex -> RevIndex
RevIndex (DynamicRevIndex -> OtherRevIndex -> RevIndex)
-> IO DynamicRevIndex -> IO (OtherRevIndex -> RevIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO DynamicRevIndex
newDynamicRevIndex IO (OtherRevIndex -> RevIndex) -> IO OtherRevIndex -> IO RevIndex
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO OtherRevIndex
newOtherRevIndex

renewRevIndex :: RevIndex -> IO ()
renewRevIndex :: RevIndex -> IO ()
renewRevIndex (RevIndex DynamicRevIndex
dyn OtherRevIndex
oth) = do
    DynamicRevIndex -> IO ()
renewDynamicRevIndex DynamicRevIndex
dyn
    OtherRevIndex -> IO ()
renewOtherRevIndex OtherRevIndex
oth

{-# INLINE lookupRevIndex #-}
lookupRevIndex
    :: Token
    -> FieldValue
    -> RevIndex
    -> IO RevResult
lookupRevIndex :: Token -> FieldName -> RevIndex -> IO RevResult
lookupRevIndex t :: Token
t@Token{Bool
Int
CI FieldName
tokenIx :: Token -> Int
tokenKey :: Token -> CI FieldName
isPseudo :: Token -> Bool
shouldBeIndexed :: Token -> Bool
tokenIx :: Int
shouldBeIndexed :: Bool
isPseudo :: Bool
tokenKey :: CI FieldName
..} FieldName
v (RevIndex DynamicRevIndex
dyn OtherRevIndex
oth)
    | Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (FieldName, FieldName) -> OtherRevIndex -> IO RevResult
lookupOtherRevIndex (FieldName
k, FieldName
v) OtherRevIndex
oth
    | Bool
shouldBeIndexed = Int -> FieldName -> DynamicRevIndex -> IO RevResult
lookupDynamicStaticRevIndex Int
ix FieldName
v DynamicRevIndex
dyn
    -- path: is not indexed but ":path /" should be used, sigh.
    | Bool
otherwise = RevResult -> IO RevResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RevResult -> IO RevResult) -> RevResult -> IO RevResult
forall a b. (a -> b) -> a -> b
$ Int -> FieldName -> RevResult
lookupStaticRevIndex Int
ix FieldName
v
  where
    ix :: Int
ix = Int -> Int
quicIx Int
tokenIx
    k :: FieldName
k = Token -> FieldName
tokenFoldedKey Token
t

{-# INLINE lookupRevIndex' #-}
lookupRevIndex'
    :: Token
    -> FieldValue
    -> RevResult
lookupRevIndex' :: Token -> FieldName -> RevResult
lookupRevIndex' Token{Bool
Int
CI FieldName
tokenIx :: Token -> Int
tokenKey :: Token -> CI FieldName
isPseudo :: Token -> Bool
shouldBeIndexed :: Token -> Bool
tokenIx :: Int
shouldBeIndexed :: Bool
isPseudo :: Bool
tokenKey :: CI FieldName
..} FieldName
v
    | Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> FieldName -> RevResult
lookupStaticRevIndex Int
ix FieldName
v
    | Bool
otherwise = RevResult
N
  where
    ix :: Int
ix = Int -> Int
quicIx Int
tokenIx

tokenToStaticIndex :: Token -> Maybe AbsoluteIndex
tokenToStaticIndex :: Token -> Maybe AbsoluteIndex
tokenToStaticIndex Token{Bool
Int
CI FieldName
tokenIx :: Token -> Int
tokenKey :: Token -> CI FieldName
isPseudo :: Token -> Bool
shouldBeIndexed :: Token -> Bool
tokenIx :: Int
shouldBeIndexed :: Bool
isPseudo :: Bool
tokenKey :: CI FieldName
..}
    | Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = case StaticRevIndex
staticRevIndex StaticRevIndex -> Int -> StaticEntry
forall i. Ix i => Array i StaticEntry -> Int -> StaticEntry
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
ix of
        StaticEntry AbsoluteIndex
i Maybe StaticValueMap
_ -> AbsoluteIndex -> Maybe AbsoluteIndex
forall a. a -> Maybe a
Just AbsoluteIndex
i
    | Bool
otherwise = Maybe AbsoluteIndex
forall a. Maybe a
Nothing
  where
    ix :: Int
ix = Int -> Int
quicIx Int
tokenIx

----------------------------------------------------------------

{-# INLINE insertRevIndex #-}
insertRevIndex :: Entry -> AbsoluteIndex -> RevIndex -> IO ()
insertRevIndex :: Entry -> AbsoluteIndex -> RevIndex -> IO ()
insertRevIndex (Entry Int
_ Token
t FieldName
v) AbsoluteIndex
i (RevIndex DynamicRevIndex
dyn OtherRevIndex
oth)
    | Int -> Int
quicIx (Token -> Int
tokenIx Token
t) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Token -> FieldName -> AbsoluteIndex -> DynamicRevIndex -> IO ()
insertDynamicRevIndex Token
t FieldName
v AbsoluteIndex
i DynamicRevIndex
dyn
    | Bool
otherwise = Token -> FieldName -> AbsoluteIndex -> OtherRevIndex -> IO ()
insertOtherRevIndex Token
t FieldName
v AbsoluteIndex
i OtherRevIndex
oth

{-# INLINE deleteRevIndex #-}
deleteRevIndex :: RevIndex -> Entry -> AbsoluteIndex -> IO ()
deleteRevIndex :: RevIndex -> Entry -> AbsoluteIndex -> IO ()
deleteRevIndex (RevIndex DynamicRevIndex
dyn OtherRevIndex
oth) (Entry Int
_ Token
t FieldName
v) AbsoluteIndex
ai
    | Int -> Int
quicIx (Token -> Int
tokenIx Token
t) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Token -> FieldName -> AbsoluteIndex -> DynamicRevIndex -> IO ()
deleteDynamicRevIndex Token
t FieldName
v AbsoluteIndex
ai DynamicRevIndex
dyn
    | Bool
otherwise = Token -> FieldName -> AbsoluteIndex -> OtherRevIndex -> IO ()
deleteOtherRevIndex Token
t FieldName
v AbsoluteIndex
ai OtherRevIndex
oth