    {-# OPTIONS_HADDOCK not-home #-}
    {-# LANGUAGE DeriveDataTypeable #-}

    -- | This module contains a mutable wrapping of an LRU in the IO
    -- monad, providing atomic access in a concurrent environment.  All
    -- calls preserve the same semantics as those in "Data.Cache.LRU", but
    -- perform updates in place.
    --
    -- This module contains the internal implementation details.  It's
    -- possible to put an 'AtomicLRU' into a bad state with this module.
    -- It is highly recommended that the external interface,
    -- "Data.Cache.LRU.IO", be used instead.
    module Data.Cache.LRU.IO.Internal where

    import Prelude hiding ( lookup, mod, take )

    import Control.Applicative ( (<$>) )
    import Control.Concurrent.MVar ( MVar )
    import qualified Control.Concurrent.MVar as MV

    import Control.Exception ( bracketOnError )

    import Data.Cache.LRU ( LRU )
    import qualified Data.Cache.LRU as LRU

    import Data.Typeable (Typeable)

    -- | The opaque wrapper type
    newtype AtomicLRU key val = C (MVar (LRU key val)) deriving Typeable

    -- | Make a new AtomicLRU that will not grow beyond the optional
    -- maximum size, if specified.
    newAtomicLRU :: Ord key => Maybe Integer -- ^ the optional maximum size
                 -> IO (AtomicLRU key val)
    newAtomicLRU :: forall key val. Ord key => Maybe Integer -> IO (AtomicLRU key val)
    newAtomicLRU = (MVar (LRU key val) -> AtomicLRU key val)
    -> IO (MVar (LRU key val)) -> IO (AtomicLRU key val)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap MVar (LRU key val) -> AtomicLRU key val
    forall key val. MVar (LRU key val) -> AtomicLRU key val
    C (IO (MVar (LRU key val)) -> IO (AtomicLRU key val))
    -> (Maybe Integer -> IO (MVar (LRU key val)))
    -> Maybe Integer
    -> IO (AtomicLRU key val)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LRU key val -> IO (MVar (LRU key val))
    forall a. a -> IO (MVar a)
    MV.newMVar (LRU key val -> IO (MVar (LRU key val)))
    -> (Maybe Integer -> LRU key val)
    -> Maybe Integer
    -> IO (MVar (LRU key val))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Integer -> LRU key val
    forall key val. Ord key => Maybe Integer -> LRU key val
    LRU.newLRU

    -- | Build a new LRU from the optional maximum size and list of
    -- contents. See 'LRU.fromList' for the semantics.
    fromList :: Ord key => Maybe Integer -- ^ the optional maximum size
                -> [(key, val)] -> IO (AtomicLRU key val)
    fromList :: forall key val.
    Ord key =>
    Maybe Integer -> [(key, val)] -> IO (AtomicLRU key val)
    fromList Maybe Integer
    s [(key, val)]
    l = (MVar (LRU key val) -> AtomicLRU key val)
    -> IO (MVar (LRU key val)) -> IO (AtomicLRU key val)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap MVar (LRU key val) -> AtomicLRU key val
    forall key val. MVar (LRU key val) -> AtomicLRU key val
    C (IO (MVar (LRU key val)) -> IO (AtomicLRU key val))
    -> (LRU key val -> IO (MVar (LRU key val)))
    -> LRU key val
    -> IO (AtomicLRU key val)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LRU key val -> IO (MVar (LRU key val))
    forall a. a -> IO (MVar a)
    MV.newMVar (LRU key val -> IO (AtomicLRU key val))
    -> LRU key val -> IO (AtomicLRU key val)
    forall a b. (a -> b) -> a -> b
    $ Maybe Integer -> [(key, val)] -> LRU key val
    forall key val.
    Ord key =>
    Maybe Integer -> [(key, val)] -> LRU key val
    LRU.fromList Maybe Integer
    s [(key, val)]
    l

    -- | Retrieve a list view of an AtomicLRU.  See 'LRU.toList' for the
    -- semantics.
    toList :: Ord key => AtomicLRU key val -> IO [(key, val)]
    toList :: forall key val. Ord key => AtomicLRU key val -> IO [(key, val)]
    toList (C MVar (LRU key val)
    mvar) = LRU key val -> [(key, val)]
    forall key val. Ord key => LRU key val -> [(key, val)]
    LRU.toList (LRU key val -> [(key, val)])
    -> IO (LRU key val) -> IO [(key, val)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MVar (LRU key val) -> IO (LRU key val)
    forall a. MVar a -> IO a
    MV.readMVar MVar (LRU key val)
    mvar

    maxSize :: AtomicLRU key val -> IO (Maybe Integer)
    maxSize :: forall key val. AtomicLRU key val -> IO (Maybe Integer)
    maxSize (C MVar (LRU key val)
    mvar) = LRU key val -> Maybe Integer
    forall key val. LRU key val -> Maybe Integer
    LRU.maxSize (LRU key val -> Maybe Integer)
    -> IO (LRU key val) -> IO (Maybe Integer)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MVar (LRU key val) -> IO (LRU key val)
    forall a. MVar a -> IO a
    MV.readMVar MVar (LRU key val)
    mvar

    -- | Insert a key/value pair into an AtomicLRU.  See 'LRU.insert' for
    -- the semantics.
    insert :: Ord key => key -> val -> AtomicLRU key val -> IO ()
    insert :: forall key val. Ord key => key -> val -> AtomicLRU key val -> IO ()
    insert key
    key val
    val (C MVar (LRU key val)
    mvar) = MVar (LRU key val) -> (LRU key val -> IO (LRU key val)) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_' MVar (LRU key val)
    mvar ((LRU key val -> IO (LRU key val)) -> IO ())
    -> (LRU key val -> IO (LRU key val)) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ LRU key val -> IO (LRU key val)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LRU key val -> IO (LRU key val))
    -> (LRU key val -> LRU key val) -> LRU key val -> IO (LRU key val)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . key -> val -> LRU key val -> LRU key val
    forall key val. Ord key => key -> val -> LRU key val -> LRU key val
    LRU.insert key
    key val
    val

    -- | Look up a key in an AtomicLRU. See 'LRU.lookup' for the
    -- semantics.
    lookup :: Ord key => key -> AtomicLRU key val -> IO (Maybe val)
    lookup :: forall key val.
    Ord key =>
    key -> AtomicLRU key val -> IO (Maybe val)
    lookup key
    key (C MVar (LRU key val)
    mvar) = MVar (LRU key val)
    -> (LRU key val -> IO (LRU key val, Maybe val)) -> IO (Maybe val)
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar' MVar (LRU key val)
    mvar ((LRU key val -> IO (LRU key val, Maybe val)) -> IO (Maybe val))
    -> (LRU key val -> IO (LRU key val, Maybe val)) -> IO (Maybe val)
    forall a b. (a -> b) -> a -> b
    $ (LRU key val, Maybe val) -> IO (LRU key val, Maybe val)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((LRU key val, Maybe val) -> IO (LRU key val, Maybe val))
    -> (LRU key val -> (LRU key val, Maybe val))
    -> LRU key val
    -> IO (LRU key val, Maybe val)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . key -> LRU key val -> (LRU key val, Maybe val)
    forall key val.
    Ord key =>
    key -> LRU key val -> (LRU key val, Maybe val)
    LRU.lookup key
    key

    -- | Remove an item from an AtomicLRU.  Returns the value for the
    -- removed key, if it was present
    delete :: Ord key => key -> AtomicLRU key val -> IO (Maybe val)
    delete :: forall key val.
    Ord key =>
    key -> AtomicLRU key val -> IO (Maybe val)
    delete key
    key (C MVar (LRU key val)
    mvar) = MVar (LRU key val)
    -> (LRU key val -> IO (LRU key val, Maybe val)) -> IO (Maybe val)
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar' MVar (LRU key val)
    mvar ((LRU key val -> IO (LRU key val, Maybe val)) -> IO (Maybe val))
    -> (LRU key val -> IO (LRU key val, Maybe val)) -> IO (Maybe val)
    forall a b. (a -> b) -> a -> b
    $ (LRU key val, Maybe val) -> IO (LRU key val, Maybe val)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((LRU key val, Maybe val) -> IO (LRU key val, Maybe val))
    -> (LRU key val -> (LRU key val, Maybe val))
    -> LRU key val
    -> IO (LRU key val, Maybe val)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . key -> LRU key val -> (LRU key val, Maybe val)
    forall key val.
    Ord key =>
    key -> LRU key val -> (LRU key val, Maybe val)
    LRU.delete key
    key

    -- | Remove the least-recently accessed item from an AtomicLRU.
    -- Returns the (key, val) pair removed, if one was present.
    pop :: Ord key => AtomicLRU key val -> IO (Maybe (key, val))
    pop :: forall key val.
    Ord key =>
    AtomicLRU key val -> IO (Maybe (key, val))
    pop (C MVar (LRU key val)
    mvar) = MVar (LRU key val)
    -> (LRU key val -> IO (LRU key val, Maybe (key, val)))
    -> IO (Maybe (key, val))
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar' MVar (LRU key val)
    mvar ((LRU key val -> IO (LRU key val, Maybe (key, val)))
     -> IO (Maybe (key, val)))
    -> (LRU key val -> IO (LRU key val, Maybe (key, val)))
    -> IO (Maybe (key, val))
    forall a b. (a -> b) -> a -> b
    $ (LRU key val, Maybe (key, val))
    -> IO (LRU key val, Maybe (key, val))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((LRU key val, Maybe (key, val))
     -> IO (LRU key val, Maybe (key, val)))
    -> (LRU key val -> (LRU key val, Maybe (key, val)))
    -> LRU key val
    -> IO (LRU key val, Maybe (key, val))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LRU key val -> (LRU key val, Maybe (key, val))
    forall key val.
    Ord key =>
    LRU key val -> (LRU key val, Maybe (key, val))
    LRU.pop

    -- | Returns the number of elements the AtomicLRU currently contains.
    size :: AtomicLRU key val -> IO Int
    size :: forall key val. AtomicLRU key val -> IO Int
    size (C MVar (LRU key val)
    mvar) = LRU key val -> Int
    forall key val. LRU key val -> Int
    LRU.size (LRU key val -> Int) -> IO (LRU key val) -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MVar (LRU key val) -> IO (LRU key val)
    forall a. MVar a -> IO a
    MV.readMVar MVar (LRU key val)
    mvar

    -- | Given a function that takes an 'LRU.LRU' and returns one of the
    -- same type, use it to modify the contents of this AtomicLRU.
    modifyAtomicLRU :: (LRU.LRU key val -> LRU.LRU key val)
                    -> AtomicLRU key val
                    -> IO ()
    modifyAtomicLRU :: forall key val.
    (LRU key val -> LRU key val) -> AtomicLRU key val -> IO ()
    modifyAtomicLRU LRU key val -> LRU key val
    f = (LRU key val -> IO (LRU key val)) -> AtomicLRU key val -> IO ()
    forall key val.
    (LRU key val -> IO (LRU key val)) -> AtomicLRU key val -> IO ()
    modifyAtomicLRU' ((LRU key val -> IO (LRU key val)) -> AtomicLRU key val -> IO ())
    -> (LRU key val -> IO (LRU key val)) -> AtomicLRU key val -> IO ()
    forall a b. (a -> b) -> a -> b
    $ LRU key val -> IO (LRU key val)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LRU key val -> IO (LRU key val))
    -> (LRU key val -> LRU key val) -> LRU key val -> IO (LRU key val)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LRU key val -> LRU key val
    f

    -- | Given a function that takes an 'LRU.LRU' and returns an IO action
    -- producting one of the same type, use it to modify the contents of
    -- this AtomicLRU.
    modifyAtomicLRU' :: (LRU.LRU key val -> IO (LRU.LRU key val))
                     -> AtomicLRU key val
                     -> IO ()
    modifyAtomicLRU' :: forall key val.
    (LRU key val -> IO (LRU key val)) -> AtomicLRU key val -> IO ()
    modifyAtomicLRU' LRU key val -> IO (LRU key val)
    f (C MVar (LRU key val)
    mvar) = MVar (LRU key val) -> (LRU key val -> IO (LRU key val)) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_' MVar (LRU key val)
    mvar LRU key val -> IO (LRU key val)
    f

    -- | A version of 'MV.modifyMVar_' that forces the result of the
    -- function application to WHNF.
    modifyMVar_' :: MVar a -> (a -> IO a) -> IO ()
    modifyMVar_' :: forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_' MVar a
    mvar a -> IO a
    f = do
      let take :: IO a
    take = MVar a -> IO a
    forall a. MVar a -> IO a
    MV.takeMVar MVar a
    mvar
          replace :: a -> IO ()
    replace = MVar a -> a -> IO ()
    forall a. MVar a -> a -> IO ()
    MV.putMVar MVar a
    mvar
          mod :: a -> IO ()
    mod a
    x = do
            x' <- a -> IO a
    f a
    x
            MV.putMVar mvar $! x'

      IO a -> (a -> IO ()) -> (a -> IO ()) -> IO ()
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracketOnError IO a
    take a -> IO ()
    replace a -> IO ()
    mod

    -- | A version of 'MV.modifyMVar' that forces the result of the
    -- function application to WHNF.
    modifyMVar' :: MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar' :: forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar' MVar a
    mvar a -> IO (a, b)
    f = do
      let take :: IO a
    take = MVar a -> IO a
    forall a. MVar a -> IO a
    MV.takeMVar MVar a
    mvar
          replace :: a -> IO ()
    replace = MVar a -> a -> IO ()
    forall a. MVar a -> a -> IO ()
    MV.putMVar MVar a
    mvar
          mod :: a -> IO b
    mod a
    x = do
            (x', result) <- a -> IO (a, b)
    f a
    x
            MV.putMVar mvar $! x'
            return result

      IO a -> (a -> IO ()) -> (a -> IO b) -> IO b
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracketOnError IO a
    take a -> IO ()
    replace a -> IO b
    mod