{-# LANGUAGE BangPatterns #-}

module Network.Wai.Handler.Warp.HashMap where

import Data.Hashable (hash)
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as I
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Prelude hiding (lookup)

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

-- | 'HashMap' is used for cache of file information.
--   Hash values of file pathes are used as outer keys.
--   Because negative entries are also contained,
--   a bad guy can intentionally cause the hash collison.
--   So, 'Map' is used internally to prevent
--   the hash collision attack.
newtype HashMap v = HashMap (IntMap (Map FilePath v))

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

empty :: HashMap v
empty :: HashMap v
empty = IntMap (Map FilePath v) -> HashMap v
forall v. IntMap (Map FilePath v) -> HashMap v
HashMap IntMap (Map FilePath v)
forall a. IntMap a
I.empty

isEmpty :: HashMap v -> Bool
isEmpty :: HashMap v -> Bool
isEmpty (HashMap IntMap (Map FilePath v)
hm) = IntMap (Map FilePath v) -> Bool
forall a. IntMap a -> Bool
I.null IntMap (Map FilePath v)
hm

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

insert :: FilePath -> v -> HashMap v -> HashMap v
insert :: FilePath -> v -> HashMap v -> HashMap v
insert FilePath
path v
v (HashMap IntMap (Map FilePath v)
hm) = IntMap (Map FilePath v) -> HashMap v
forall v. IntMap (Map FilePath v) -> HashMap v
HashMap (IntMap (Map FilePath v) -> HashMap v)
-> IntMap (Map FilePath v) -> HashMap v
forall a b. (a -> b) -> a -> b
$ (Map FilePath v -> Map FilePath v -> Map FilePath v)
-> Key
-> Map FilePath v
-> IntMap (Map FilePath v)
-> IntMap (Map FilePath v)
forall a. (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
I.insertWith Map FilePath v -> Map FilePath v -> Map FilePath v
forall a. Map FilePath a -> Map FilePath a -> Map FilePath a
f Key
h Map FilePath v
m IntMap (Map FilePath v)
hm
  where
    !h :: Key
h = FilePath -> Key
forall a. Hashable a => a -> Key
hash FilePath
path
    !m :: Map FilePath v
m = FilePath -> v -> Map FilePath v
forall k a. k -> a -> Map k a
M.singleton FilePath
path v
v
    f :: Map FilePath a -> Map FilePath a -> Map FilePath a
f = Map FilePath a -> Map FilePath a -> Map FilePath a
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union -- fimxe

lookup :: FilePath -> HashMap v -> Maybe v
lookup :: FilePath -> HashMap v -> Maybe v
lookup FilePath
path (HashMap IntMap (Map FilePath v)
hm) = Key -> IntMap (Map FilePath v) -> Maybe (Map FilePath v)
forall a. Key -> IntMap a -> Maybe a
I.lookup Key
h IntMap (Map FilePath v)
hm Maybe (Map FilePath v) -> (Map FilePath v -> Maybe v) -> Maybe v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Map FilePath v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
path
  where
    !h :: Key
h = FilePath -> Key
forall a. Hashable a => a -> Key
hash FilePath
path