MultiMap.hs

{-# LANGUAGE BangPatterns #-}

module Network.Wai.Handler.Warp.MultiMap (
    MultiMap
  , isEmpty
  , empty
  , singleton
  , insert
  , Network.Wai.Handler.Warp.MultiMap.lookup
  , pruneWith
  , toList
  , merge
  ) where

import Data.Hashable (hash)
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as I
import Data.Semigroup
import Prelude -- Silence redundant import warnings

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

-- | 'MultiMap' is used for cache of file descriptors.
--   Since multiple threads would open file descriptors for
--   the same file simultaneously, multiple entries must
--   be contained for the file.
--   Since hash values of file pathes are used as outer keys,
--   collison would happen for multiple file pathes.
--   Becase only positive entries are contained,
--   a bad guy cannot be cause the hash collision intentinally.
--   So, lists are good enough.
newtype MultiMap v = MultiMap (IntMap [(FilePath,v)])

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

-- | O(1)
empty :: MultiMap v
empty = MultiMap $ I.empty

-- | O(1)
isEmpty :: MultiMap v -> Bool
isEmpty (MultiMap mm) = I.null mm

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

-- | O(1)
singleton :: FilePath -> v -> MultiMap v
singleton path v = MultiMap mm
  where
    !h = hash path
    !mm = I.singleton h [(path,v)]

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

-- | O(N)
lookup :: FilePath -> MultiMap v -> Maybe v
lookup path (MultiMap mm) = case I.lookup h mm of
    Nothing -> Nothing
    Just s  -> Prelude.lookup path s
  where
    !h = hash path

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

-- | O(log n)
insert :: FilePath -> v -> MultiMap v -> MultiMap v
insert path v (MultiMap mm) = MultiMap mm'
  where
    !h = hash path
    !mm' = I.insertWith (<>) h [(path,v)] mm

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

-- | O(n)
toList :: MultiMap v -> [(FilePath,v)]
toList (MultiMap mm) = concatMap snd $ I.toAscList mm

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

-- | O(n)
pruneWith :: MultiMap v
          -> ((FilePath,v) -> IO Bool)
          -> IO (MultiMap v)
pruneWith (MultiMap mm) action = MultiMap <$> mm'
  where
    !mm' = I.fromAscList <$> go (I.toDescList mm) []
    go []          !acc = return acc
    go ((h,s):kss) !acc = do
        rs <- prune action s
        case rs of
            [] -> go kss acc
            _  -> go kss ((h,rs) : acc)

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

-- O(n + m) where N is the size of the second argument
merge :: MultiMap v -> MultiMap v -> MultiMap v
merge (MultiMap m1) (MultiMap m2) = MultiMap mm
  where
    !mm = I.unionWith (<>) m1 m2

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

prune :: ((FilePath,v) -> IO Bool) -> [(FilePath,v)] -> IO [(FilePath,v)]
prune action xs0 = go xs0
  where
    go []     = return []
    go (x:xs) = do
        keep <- action x
        rs <- go xs
        return $ if keep then x:rs else rs