    -- from https://jaspervdj.be/posts/2015-02-24-lru-cache.html
    module Network.Wai.Middleware.Push.Referer.LRU (
        Cache(..)
      , Priority
      , empty
      , insert
      , lookup
      ) where

    import Data.OrdPSQ (OrdPSQ)
    import qualified Data.OrdPSQ as PSQ
    import Data.Int (Int64)
    import Prelude hiding (lookup)

    import Network.Wai.Middleware.Push.Referer.Multi (Multi)
    import qualified Network.Wai.Middleware.Push.Referer.Multi as M

    type Priority = Int64

    data Cache k v = Cache {
        forall k v. Cache k v -> Int
    cCapacity :: Int       -- ^ The maximum number of elements in the queue
      , forall k v. Cache k v -> Int
    cSize     :: Int       -- ^ The current number of elements in the queue
      , forall k v. Cache k v -> Int
    cValLimit :: Int
      , forall k v. Cache k v -> Priority
    cTick     :: Priority  -- ^ The next logical time
      , forall k v. Cache k v -> OrdPSQ k Priority (Multi v)
    cQueue    :: OrdPSQ k Priority (Multi v)
      } deriving (Cache k v -> Cache k v -> Bool
    (Cache k v -> Cache k v -> Bool)
    -> (Cache k v -> Cache k v -> Bool) -> Eq (Cache k v)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    forall k v. (Ord k, Eq v) => Cache k v -> Cache k v -> Bool
    $c== :: forall k v. (Ord k, Eq v) => Cache k v -> Cache k v -> Bool
    == :: Cache k v -> Cache k v -> Bool
    $c/= :: forall k v. (Ord k, Eq v) => Cache k v -> Cache k v -> Bool
    /= :: Cache k v -> Cache k v -> Bool
    Eq, Int -> Cache k v -> ShowS
    [Cache k v] -> ShowS
    Cache k v -> String
    (Int -> Cache k v -> ShowS)
    -> (Cache k v -> String)
    -> ([Cache k v] -> ShowS)
    -> Show (Cache k v)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    forall k v. (Show v, Show k) => Int -> Cache k v -> ShowS
    forall k v. (Show v, Show k) => [Cache k v] -> ShowS
    forall k v. (Show v, Show k) => Cache k v -> String
    $cshowsPrec :: forall k v. (Show v, Show k) => Int -> Cache k v -> ShowS
    showsPrec :: Int -> Cache k v -> ShowS
    $cshow :: forall k v. (Show v, Show k) => Cache k v -> String
    show :: Cache k v -> String
    $cshowList :: forall k v. (Show v, Show k) => [Cache k v] -> ShowS
    showList :: [Cache k v] -> ShowS
    Show)

    empty :: Int -> Int -> Cache k v
    empty :: forall k v. Int -> Int -> Cache k v
    empty Int
    capacity Int
    valLimit
      | Int
    capacity Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    1 = String -> Cache k v
    forall a. HasCallStack => String -> a
    error String
    "Cache.empty: capacity < 1"
      | Bool
    otherwise    = Cache {
            cCapacity :: Int
    cCapacity = Int
    capacity
          , cSize :: Int
    cSize     = Int
    0
          , cValLimit :: Int
    cValLimit = Int
    valLimit
          , cTick :: Priority
    cTick     = Priority
    0
          , cQueue :: OrdPSQ k Priority (Multi v)
    cQueue    = OrdPSQ k Priority (Multi v)
    forall k p v. OrdPSQ k p v
    PSQ.empty
          }

    trim :: Ord k => Cache k v -> Cache k v
    trim :: forall k v. Ord k => Cache k v -> Cache k v
    trim Cache k v
    c
      | Cache k v -> Priority
    forall k v. Cache k v -> Priority
    cTick Cache k v
    c Priority -> Priority -> Bool
    forall a. Eq a => a -> a -> Bool
    == Priority
    forall a. Bounded a => a
    maxBound  = Int -> Int -> Cache k v
    forall k v. Int -> Int -> Cache k v
    empty (Cache k v -> Int
    forall k v. Cache k v -> Int
    cCapacity Cache k v
    c) (Cache k v -> Int
    forall k v. Cache k v -> Int
    cValLimit Cache k v
    c)
      | Cache k v -> Int
    forall k v. Cache k v -> Int
    cSize Cache k v
    c Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Cache k v -> Int
    forall k v. Cache k v -> Int
    cCapacity Cache k v
    c = Cache k v
    c {
            cSize  = cSize c - 1
          , cQueue = PSQ.deleteMin (cQueue c)
          }
      | Bool
    otherwise             = Cache k v
    c

    insert :: (Ord k, Ord v) => k -> v -> Cache k v -> Cache k v
    insert :: forall k v. (Ord k, Ord v) => k -> v -> Cache k v -> Cache k v
    insert k
    k v
    v Cache k v
    c = case (Maybe (Priority, Multi v) -> (Bool, Maybe (Priority, Multi v)))
    -> k
    -> OrdPSQ k Priority (Multi v)
    -> (Bool, OrdPSQ k Priority (Multi v))
    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 (Priority, Multi v) -> (Bool, Maybe (Priority, Multi v))
    forall {a}. Maybe (a, Multi v) -> (Bool, Maybe (Priority, Multi v))
    lookupAndBump k
    k (Cache k v -> OrdPSQ k Priority (Multi v)
    forall k v. Cache k v -> OrdPSQ k Priority (Multi v)
    cQueue Cache k v
    c) of
        (Bool
    True,  OrdPSQ k Priority (Multi v)
    q) -> Cache k v -> Cache k v
    forall k v. Ord k => Cache k v -> Cache k v
    trim (Cache k v -> Cache k v) -> Cache k v -> Cache k v
    forall a b. (a -> b) -> a -> b
    $ Cache k v
    c { cTick = cTick c + 1, cQueue = q, cSize = cSize c + 1}
        (Bool
    False, OrdPSQ k Priority (Multi v)
    q) -> Cache k v -> Cache k v
    forall k v. Ord k => Cache k v -> Cache k v
    trim (Cache k v -> Cache k v) -> Cache k v -> Cache k v
    forall a b. (a -> b) -> a -> b
    $ Cache k v
    c { cTick = cTick c + 1, cQueue = q }
      where
        lookupAndBump :: Maybe (a, Multi v) -> (Bool, Maybe (Priority, Multi v))
    lookupAndBump Maybe (a, Multi v)
    Nothing       = (Bool
    True,  (Priority, Multi v) -> Maybe (Priority, Multi v)
    forall a. a -> Maybe a
    Just (Cache k v -> Priority
    forall k v. Cache k v -> Priority
    cTick Cache k v
    c, Int -> v -> Multi v
    forall a. Int -> a -> Multi a
    M.singleton (Cache k v -> Int
    forall k v. Cache k v -> Int
    cValLimit Cache k v
    c) v
    v))
        lookupAndBump (Just (a
    _, Multi v
    x)) = (Bool
    False, (Priority, Multi v) -> Maybe (Priority, Multi v)
    forall a. a -> Maybe a
    Just (Cache k v -> Priority
    forall k v. Cache k v -> Priority
    cTick Cache k v
    c, v -> Multi v -> Multi v
    forall a. Ord a => a -> Multi a -> Multi a
    M.insert v
    v Multi v
    x))

    lookup :: Ord k => k -> Cache k v -> (Cache k v, [v])
    lookup :: forall k v. Ord k => k -> Cache k v -> (Cache k v, [v])
    lookup k
    k Cache k v
    c = case (Maybe (Priority, Multi v)
     -> (Maybe (Multi v), Maybe (Priority, Multi v)))
    -> k
    -> OrdPSQ k Priority (Multi v)
    -> (Maybe (Multi v), OrdPSQ k Priority (Multi v))
    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 (Priority, Multi v)
    -> (Maybe (Multi v), Maybe (Priority, Multi v))
    forall {a} {b}. Maybe (a, b) -> (Maybe b, Maybe (Priority, b))
    lookupAndBump k
    k (Cache k v -> OrdPSQ k Priority (Multi v)
    forall k v. Cache k v -> OrdPSQ k Priority (Multi v)
    cQueue Cache k v
    c) of
        (Maybe (Multi v)
    Nothing, OrdPSQ k Priority (Multi v)
    _) -> (Cache k v
    c, [])
        (Just Multi v
    x, OrdPSQ k Priority (Multi v)
    q)  -> let c' :: Cache k v
    c' = Cache k v -> Cache k v
    forall k v. Ord k => Cache k v -> Cache k v
    trim (Cache k v -> Cache k v) -> Cache k v -> Cache k v
    forall a b. (a -> b) -> a -> b
    $ Cache k v
    c { cTick = cTick c + 1, cQueue = q }
                            xs :: [v]
    xs = Multi v -> [v]
    forall a. Multi a -> [a]
    M.list Multi v
    x
                        in (Cache k v
    c', [v]
    xs)
      where
        lookupAndBump :: Maybe (a, b) -> (Maybe b, Maybe (Priority, b))
    lookupAndBump Maybe (a, b)
    Nothing       = (Maybe b
    forall a. Maybe a
    Nothing, Maybe (Priority, b)
    forall a. Maybe a
    Nothing)
        lookupAndBump (Just (a
    _, b
    x)) = (b -> Maybe b
    forall a. a -> Maybe a
    Just b
    x,  (Priority, b) -> Maybe (Priority, b)
    forall a. a -> Maybe a
    Just (Cache k v -> Priority
    forall k v. Cache k v -> Priority
    cTick Cache k v
    c, b
    x))