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

module Network.QPACK.Table.RevIndex (
    RevResult (..),
    RevIndex,
    newRevIndex,
    renewRevIndex,
    lookupRevIndex,
    lookupRevIndex',
    insertRevIndex,
    deleteRevIndexList,
) 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.Map.Strict (Map)
import qualified Data.Map.Strict as M
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 OtherRevIdex

type DynamicRevIndex = Array Int (IORef ValueMap)

data KeyValue = KeyValue FieldName FieldValue deriving (KeyValue -> KeyValue -> Bool
(KeyValue -> KeyValue -> Bool)
-> (KeyValue -> KeyValue -> Bool) -> Eq KeyValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyValue -> KeyValue -> Bool
== :: KeyValue -> KeyValue -> Bool
$c/= :: KeyValue -> KeyValue -> Bool
/= :: KeyValue -> KeyValue -> Bool
Eq, Eq KeyValue
Eq KeyValue =>
(KeyValue -> KeyValue -> Ordering)
-> (KeyValue -> KeyValue -> Bool)
-> (KeyValue -> KeyValue -> Bool)
-> (KeyValue -> KeyValue -> Bool)
-> (KeyValue -> KeyValue -> Bool)
-> (KeyValue -> KeyValue -> KeyValue)
-> (KeyValue -> KeyValue -> KeyValue)
-> Ord KeyValue
KeyValue -> KeyValue -> Bool
KeyValue -> KeyValue -> Ordering
KeyValue -> KeyValue -> KeyValue
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
$ccompare :: KeyValue -> KeyValue -> Ordering
compare :: KeyValue -> KeyValue -> Ordering
$c< :: KeyValue -> KeyValue -> Bool
< :: KeyValue -> KeyValue -> Bool
$c<= :: KeyValue -> KeyValue -> Bool
<= :: KeyValue -> KeyValue -> Bool
$c> :: KeyValue -> KeyValue -> Bool
> :: KeyValue -> KeyValue -> Bool
$c>= :: KeyValue -> KeyValue -> Bool
>= :: KeyValue -> KeyValue -> Bool
$cmax :: KeyValue -> KeyValue -> KeyValue
max :: KeyValue -> KeyValue -> KeyValue
$cmin :: KeyValue -> KeyValue -> KeyValue
min :: KeyValue -> KeyValue -> KeyValue
Ord)

-- We always create an index for a pair of an unknown header and its value
-- in Linear{H}.
type OtherRevIdex = IORef (Map KeyValue HIndex)

{-# SPECIALIZE INLINE M.lookup ::
    KeyValue -> M.Map KeyValue HIndex -> Maybe HIndex
    #-}
{-# SPECIALIZE INLINE M.delete ::
    KeyValue -> M.Map KeyValue HIndex -> M.Map KeyValue HIndex
    #-}
{-# SPECIALIZE INLINE M.insert ::
    KeyValue -> HIndex -> M.Map KeyValue HIndex -> M.Map KeyValue HIndex
    #-}

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

type StaticRevIndex = Array Int StaticEntry

data StaticEntry = StaticEntry HIndex (Maybe ValueMap) 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 ValueMap = Map FieldValue HIndex

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

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 FieldValue, [(FieldValue, HIndex)]) -> (Int, StaticEntry))
-> [(CI FieldValue, [(FieldValue, HIndex)])]
-> [(Int, StaticEntry)]
forall a b. (a -> b) -> [a] -> [b]
map (CI FieldValue, [(FieldValue, HIndex)]) -> (Int, StaticEntry)
toEnt [(CI FieldValue, [(FieldValue, HIndex)])]
zs
  where
    toEnt :: (CI FieldValue, [(FieldValue, HIndex)]) -> (Int, StaticEntry)
toEnt (CI FieldValue
k, [(FieldValue, HIndex)]
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
$ FieldValue -> Token
toToken (FieldValue -> Token) -> FieldValue -> Token
forall a b. (a -> b) -> a -> b
$ CI FieldValue -> FieldValue
forall s. CI s -> s
foldedCase CI FieldValue
k, StaticEntry
m)
      where
        m :: StaticEntry
m = case [(FieldValue, HIndex)]
xs of
            [] -> String -> StaticEntry
forall a. HasCallStack => String -> a
error String
"staticRevIndex"
            [(FieldValue
"", HIndex
i)] -> HIndex -> Maybe ValueMap -> StaticEntry
StaticEntry HIndex
i Maybe ValueMap
forall a. Maybe a
Nothing
            (FieldValue
_, HIndex
i) : [(FieldValue, HIndex)]
_ -> HIndex -> Maybe ValueMap -> StaticEntry
StaticEntry HIndex
i (Maybe ValueMap -> StaticEntry) -> Maybe ValueMap -> StaticEntry
forall a b. (a -> b) -> a -> b
$ ValueMap -> Maybe ValueMap
forall a. a -> Maybe a
Just (ValueMap -> Maybe ValueMap) -> ValueMap -> Maybe ValueMap
forall a b. (a -> b) -> a -> b
$ [(FieldValue, HIndex)] -> ValueMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(FieldValue, HIndex)]
xs
    zs :: [(CI FieldValue, [(FieldValue, HIndex)])]
zs = ([(CI FieldValue, (FieldValue, HIndex))]
 -> (CI FieldValue, [(FieldValue, HIndex)]))
-> [[(CI FieldValue, (FieldValue, HIndex))]]
-> [(CI FieldValue, [(FieldValue, HIndex)])]
forall a b. (a -> b) -> [a] -> [b]
map [(CI FieldValue, (FieldValue, HIndex))]
-> (CI FieldValue, [(FieldValue, HIndex)])
forall {a} {b}. [(a, b)] -> (a, [b])
extract ([[(CI FieldValue, (FieldValue, HIndex))]]
 -> [(CI FieldValue, [(FieldValue, HIndex)])])
-> [[(CI FieldValue, (FieldValue, HIndex))]]
-> [(CI FieldValue, [(FieldValue, HIndex)])]
forall a b. (a -> b) -> a -> b
$ ((CI FieldValue, (FieldValue, HIndex))
 -> (CI FieldValue, (FieldValue, HIndex)) -> Bool)
-> [(CI FieldValue, (FieldValue, HIndex))]
-> [[(CI FieldValue, (FieldValue, HIndex))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (CI FieldValue -> CI FieldValue -> Bool
forall a. Eq a => a -> a -> Bool
(==) (CI FieldValue -> CI FieldValue -> Bool)
-> ((CI FieldValue, (FieldValue, HIndex)) -> CI FieldValue)
-> (CI FieldValue, (FieldValue, HIndex))
-> (CI FieldValue, (FieldValue, HIndex))
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (CI FieldValue, (FieldValue, HIndex)) -> CI FieldValue
forall a b. (a, b) -> a
fst) ([(CI FieldValue, (FieldValue, HIndex))]
 -> [[(CI FieldValue, (FieldValue, HIndex))]])
-> [(CI FieldValue, (FieldValue, HIndex))]
-> [[(CI FieldValue, (FieldValue, HIndex))]]
forall a b. (a -> b) -> a -> b
$ [(CI FieldValue, (FieldValue, HIndex))]
-> [(CI FieldValue, (FieldValue, HIndex))]
forall a. Ord a => [a] -> [a]
sort [(CI FieldValue, (FieldValue, HIndex))]
lst
      where
        lst :: [(CI FieldValue, (FieldValue, HIndex))]
lst =
            ((CI FieldValue, FieldValue)
 -> HIndex -> (CI FieldValue, (FieldValue, HIndex)))
-> [(CI FieldValue, FieldValue)]
-> [HIndex]
-> [(CI FieldValue, (FieldValue, HIndex))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(CI FieldValue
k, FieldValue
v) HIndex
i -> (CI FieldValue
k, (FieldValue
v, HIndex
i))) [(CI FieldValue, FieldValue)]
staticTableList ([HIndex] -> [(CI FieldValue, (FieldValue, HIndex))])
-> [HIndex] -> [(CI FieldValue, (FieldValue, HIndex))]
forall a b. (a -> b) -> a -> b
$
                (Int -> HIndex) -> [Int] -> [HIndex]
forall a b. (a -> b) -> [a] -> [b]
map (AbsoluteIndex -> HIndex
SIndex (AbsoluteIndex -> HIndex)
-> (Int -> AbsoluteIndex) -> Int -> HIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AbsoluteIndex
AbsoluteIndex) [Int
0 ..]
        extract :: [(a, b)] -> (a, [b])
extract [(a, b)]
xs = ((a, b) -> a
forall a b. (a, b) -> a
fst ([(a, b)] -> (a, b)
forall a. HasCallStack => [a] -> a
head [(a, b)]
xs), ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
xs)

{-# INLINE lookupStaticRevIndex #-}
lookupStaticRevIndex :: Int -> FieldValue -> RevResult
lookupStaticRevIndex :: Int -> FieldValue -> RevResult
lookupStaticRevIndex Int
ix FieldValue
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 HIndex
i Maybe ValueMap
Nothing -> HIndex -> RevResult
K HIndex
i
    StaticEntry HIndex
i (Just ValueMap
m) -> case FieldValue -> ValueMap -> Maybe HIndex
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FieldValue
v ValueMap
m of
        Maybe HIndex
Nothing -> HIndex -> RevResult
K HIndex
i
        Just HIndex
j -> HIndex -> RevResult
KV HIndex
j

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

newDynamicRevIndex :: IO DynamicRevIndex
newDynamicRevIndex :: IO DynamicRevIndex
newDynamicRevIndex = (Int, Int) -> [IORef ValueMap] -> DynamicRevIndex
forall i e. Ix i => (i, i) -> [e] -> Array i e
A.listArray (Int
minTokenIx, Int
maxStaticTokenIx) ([IORef ValueMap] -> DynamicRevIndex)
-> IO [IORef ValueMap] -> IO DynamicRevIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> IO (IORef ValueMap)) -> [Int] -> IO [IORef ValueMap]
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 ValueMap)
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 ValueMap -> ValueMap -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (DynamicRevIndex
drev DynamicRevIndex -> Int -> IORef ValueMap
forall i. Ix i => Array i (IORef ValueMap) -> Int -> IORef ValueMap
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
t) ValueMap
forall k a. Map k a
M.empty

{-# INLINE lookupDynamicStaticRevIndex #-}
lookupDynamicStaticRevIndex
    :: Int -> FieldValue -> DynamicRevIndex -> IO RevResult
lookupDynamicStaticRevIndex :: Int -> FieldValue -> DynamicRevIndex -> IO RevResult
lookupDynamicStaticRevIndex Int
ix FieldValue
v DynamicRevIndex
drev = do
    let ref :: IORef ValueMap
ref = DynamicRevIndex
drev DynamicRevIndex -> Int -> IORef ValueMap
forall i. Ix i => Array i (IORef ValueMap) -> Int -> IORef ValueMap
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
ix
    ValueMap
m <- IORef ValueMap -> IO ValueMap
forall a. IORef a -> IO a
readIORef IORef ValueMap
ref
    case FieldValue -> ValueMap -> Maybe HIndex
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FieldValue
v ValueMap
m of
        Just HIndex
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
i
        Maybe HIndex
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 -> FieldValue -> RevResult
lookupStaticRevIndex Int
ix FieldValue
v

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

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

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

newOtherRevIndex :: IO OtherRevIdex
newOtherRevIndex :: IO OtherRevIdex
newOtherRevIndex = Map KeyValue HIndex -> IO OtherRevIdex
forall a. a -> IO (IORef a)
newIORef Map KeyValue HIndex
forall k a. Map k a
M.empty

renewOtherRevIndex :: OtherRevIdex -> IO ()
renewOtherRevIndex :: OtherRevIdex -> IO ()
renewOtherRevIndex OtherRevIdex
ref = OtherRevIdex -> Map KeyValue HIndex -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef OtherRevIdex
ref Map KeyValue HIndex
forall k a. Map k a
M.empty

{-# INLINE lookupOtherRevIndex #-}
lookupOtherRevIndex :: (FieldName, FieldValue) -> OtherRevIdex -> IO RevResult
lookupOtherRevIndex :: (FieldValue, FieldValue) -> OtherRevIdex -> IO RevResult
lookupOtherRevIndex (FieldValue
k, FieldValue
v) OtherRevIdex
ref = do
    Map KeyValue HIndex
oth <- OtherRevIdex -> IO (Map KeyValue HIndex)
forall a. IORef a -> IO a
readIORef OtherRevIdex
ref
    case KeyValue -> Map KeyValue HIndex -> Maybe HIndex
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (FieldValue -> FieldValue -> KeyValue
KeyValue FieldValue
k FieldValue
v) Map KeyValue HIndex
oth of
        Maybe HIndex
Nothing -> RevResult -> IO RevResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RevResult
N
        Just HIndex
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
i

{-# INLINE insertOtherRevIndex #-}
insertOtherRevIndex :: Token -> FieldValue -> HIndex -> OtherRevIdex -> IO ()
insertOtherRevIndex :: Token -> FieldValue -> HIndex -> OtherRevIdex -> IO ()
insertOtherRevIndex Token
t FieldValue
v HIndex
i OtherRevIdex
ref = OtherRevIdex
-> (Map KeyValue HIndex -> Map KeyValue HIndex) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' OtherRevIdex
ref ((Map KeyValue HIndex -> Map KeyValue HIndex) -> IO ())
-> (Map KeyValue HIndex -> Map KeyValue HIndex) -> IO ()
forall a b. (a -> b) -> a -> b
$ KeyValue -> HIndex -> Map KeyValue HIndex -> Map KeyValue HIndex
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (FieldValue -> FieldValue -> KeyValue
KeyValue FieldValue
k FieldValue
v) HIndex
i
  where
    k :: FieldValue
k = Token -> FieldValue
tokenFoldedKey Token
t

{-# INLINE deleteOtherRevIndex #-}
deleteOtherRevIndex :: Token -> FieldValue -> OtherRevIdex -> IO ()
deleteOtherRevIndex :: Token -> FieldValue -> OtherRevIdex -> IO ()
deleteOtherRevIndex Token
t FieldValue
v OtherRevIdex
ref = OtherRevIdex
-> (Map KeyValue HIndex -> Map KeyValue HIndex) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' OtherRevIdex
ref ((Map KeyValue HIndex -> Map KeyValue HIndex) -> IO ())
-> (Map KeyValue HIndex -> Map KeyValue HIndex) -> IO ()
forall a b. (a -> b) -> a -> b
$ KeyValue -> Map KeyValue HIndex -> Map KeyValue HIndex
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (FieldValue -> FieldValue -> KeyValue
KeyValue FieldValue
k FieldValue
v)
  where
    k :: FieldValue
k = Token -> FieldValue
tokenFoldedKey Token
t

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

newRevIndex :: IO RevIndex
newRevIndex :: IO RevIndex
newRevIndex = DynamicRevIndex -> OtherRevIdex -> RevIndex
RevIndex (DynamicRevIndex -> OtherRevIdex -> RevIndex)
-> IO DynamicRevIndex -> IO (OtherRevIdex -> RevIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO DynamicRevIndex
newDynamicRevIndex IO (OtherRevIdex -> RevIndex) -> IO OtherRevIdex -> 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 OtherRevIdex
newOtherRevIndex

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

{-# INLINE lookupRevIndex #-}
lookupRevIndex
    :: Token
    -> FieldValue
    -> RevIndex
    -> IO RevResult
lookupRevIndex :: Token -> FieldValue -> RevIndex -> IO RevResult
lookupRevIndex t :: Token
t@Token{Bool
Int
CI FieldValue
tokenIx :: Token -> Int
tokenIx :: Int
shouldBeIndexed :: Bool
isPseudo :: Bool
tokenKey :: CI FieldValue
shouldBeIndexed :: Token -> Bool
isPseudo :: Token -> Bool
tokenKey :: Token -> CI FieldValue
..} FieldValue
v (RevIndex DynamicRevIndex
dyn OtherRevIdex
oth)
    | Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (FieldValue, FieldValue) -> OtherRevIdex -> IO RevResult
lookupOtherRevIndex (FieldValue
k, FieldValue
v) OtherRevIdex
oth
    | Bool
shouldBeIndexed = Int -> FieldValue -> DynamicRevIndex -> IO RevResult
lookupDynamicStaticRevIndex Int
ix FieldValue
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 -> FieldValue -> RevResult
lookupStaticRevIndex Int
ix FieldValue
v
  where
    ix :: Int
ix = Int -> Int
quicIx Int
tokenIx
    k :: FieldValue
k = Token -> FieldValue
tokenFoldedKey Token
t

--    ent = toEntryToken t v -- fixme

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

--    k = tokenFoldedKey t -- fixme

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

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

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

{-# INLINE deleteRevIndexList #-}
deleteRevIndexList :: [Entry] -> RevIndex -> IO ()
deleteRevIndexList :: [Entry] -> RevIndex -> IO ()
deleteRevIndexList [Entry]
es RevIndex
rev = (Entry -> IO ()) -> [Entry] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (RevIndex -> Entry -> IO ()
deleteRevIndex RevIndex
rev) [Entry]
es

-- isStaticToken