content: --------------------------------------------------------------------------------
  
  -- Copyright © 2010-2012 Bas van Dijk & Roel van Dijk
  -- Copyright © 2018 DFINITY Stiftung
  --
  -- All rights reserved.
  --
  -- Redistribution and use in source and binary forms, with or without
  -- modification, are permitted provided that the following conditions are
  -- met:
  --
  --     * Redistributions of source code must retain the above copyright
  --       notice, this list of conditions and the following disclaimer.
  --
  --     * Redistributions in binary form must reproduce the above
  --       copyright notice, this list of conditions and the following
  --       disclaimer in the documentation and/or other materials provided
  --       with the distribution.
  --
  --     * The names of Bas van Dijk, Roel van Dijk and the names of
  --       contributors may NOT be used to endorse or promote products
  --       derived from this software without specific prior written
  --       permission.
  --
  -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  -- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  -- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  -- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  -- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  
  --------------------------------------------------------------------------------
  
  {-# LANGUAGE DeriveDataTypeable #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  {-# LANGUAGE UndecidableInstances #-}
  
  --------------------------------------------------------------------------------
  
  -- |
  -- Module     : Control.Concurrent.Classy.Lock
  -- Copyright  : © 2010-2011 Bas van Dijk & Roel van Dijk
  --            , © 2018 DFINITY Stiftung
  -- Maintainer : DFINITY USA Research <team@dfinity.org>
  --
  -- This module provides the 'Lock' synchronisation mechanism. It was inspired by
  -- the Python and Java @Lock@ objects and should behave in a similar way. See:
  --
  -- <http://docs.python.org/3.1/library/threading.html#lock-objects>
  --
  -- and:
  --
  -- <http://java.sun.com/javase/7/docs/api/java/util/concurrent/locks/Lock.html>
  --
  -- All functions are /exception safe/. Throwing asynchronous exceptions will not
  -- compromise the internal state of a 'Lock'.
  
  --------------------------------------------------------------------------------
  
  module Control.Concurrent.Classy.Lock
    ( -- * @Lock@
      Lock
  
      -- * Creating locks
    , newLock
    , newAcquired
  
      -- * Locking and unlocking
    , acquire
    , tryAcquire
    , release
  
      -- * Convenience functions
    , with
    , tryWith
    , wait
  
      -- * Querying locks
    , locked
    ) where
  
  --------------------------------------------------------------------------------
  
  import           Control.Applicative            (pure, (<*>))
  import           Control.Monad                  (when)
  import           Data.Bool                      (Bool, not)
  import           Data.Eq                        (Eq((==)))
  import           Data.Function                  (($), (.))
  import           Data.Functor                   (fmap, (<$>))
  import           Data.Maybe                     (Maybe(Just, Nothing), isJust)
  import           Data.Typeable                  (Typeable)
  import           Prelude                        (error)
  
  import qualified Control.Concurrent.Classy.MVar as MVar
  import           Control.Monad.Catch            (bracket_, mask, onException)
  import           Control.Monad.Conc.Class       (MonadConc(MVar))
  
  --------------------------------------------------------------------------------
  
  -- | A lock is in one of two states: \"locked\" or \"unlocked\".
  --
  -- @since 1.6.2.0
  newtype Lock m
    = Lock
      { _fromLock :: MVar m ()
      }
    deriving (Typeable)
  
  instance (Eq (MVar m ())) => Eq (Lock m) where
    (==) (Lock a) (Lock b) = a == b
  
  --------------------------------------------------------------------------------
  
  -- | Create a lock in the \"unlocked\" state.
  --
  -- @since 1.6.2.0
  newLock :: (MonadConc m) => m (Lock m)
  newLock = Lock <$> MVar.newMVar ()
  
  -- | Create a lock in the \"locked\" state.
  --
  -- @since 1.6.2.0
  newAcquired :: (MonadConc m) => m (Lock m)
  newAcquired = Lock <$> MVar.newEmptyMVar
  
  --------------------------------------------------------------------------------
  
  -- |
  -- Acquires the 'Lock'. Blocks if another thread has acquired the 'Lock'.
  --
  -- @acquire@ behaves as follows:
  --
  -- * When the state is \"unlocked\" @acquire@ changes the state to \"locked\".
  --
  -- * When the state is \"locked\" @acquire@ /blocks/ until a call to 'release'
  --   in another thread wakes the calling thread. Upon awakening it will change
  --   the state to \"locked\".
  --
  -- There are two further important properties of @acquire@:
  --
  -- * @acquire@ is single-wakeup. That is, if there are multiple threads blocked
  --   on @acquire@ and the lock is released, only one thread will be woken up.
  --   The runtime guarantees that the woken thread completes its @acquire@
  --   operation.
  --
  -- * When multiple threads are blocked on @acquire@, they are woken up in FIFO
  --   order. This is useful for providing fairness properties of abstractions
  --   built using locks. Note that this differs from the Python implementation
  --   where the wake-up order is undefined.
  --
  -- @since 1.6.2.0
  acquire :: (MonadConc m) => Lock m -> m ()
  acquire = MVar.takeMVar . _fromLock
  
  -- |
  -- A non-blocking 'acquire'.
  --
  -- * When the state is \"unlocked\" @tryAcquire@ changes the state to \"locked\"
  --   and returns 'True'.
  --
  -- * When the state is \"locked\" @tryAcquire@ leaves the state unchanged and
  --   returns 'False'.
  --
  -- @since 1.6.2.0
  tryAcquire :: (MonadConc m) => Lock m -> m Bool
  tryAcquire = fmap isJust . MVar.tryTakeMVar . _fromLock
  
  -- |
  -- @release@ changes the state to \"unlocked\" and returns immediately.
  --
  -- Note that it is an error to release a lock in the \"unlocked\" state!
  --
  -- If there are any threads blocked on 'acquire' the thread that first called
  -- @acquire@ will be woken up.
  --
  -- @since 1.6.2.0
  release :: (MonadConc m) => Lock m -> m ()
  release (Lock mv) = do
    b <- MVar.tryPutMVar mv ()
    when (not b) $
      error "Control.Concurrent.Classy.Lock.release: cannot release an unlocked Lock!"
  
  --------------------------------------------------------------------------------
  
  -- |
  -- A convenience function which first acquires the lock and then performs the
  -- computation. When the computation terminates, whether normally or by raising an
  -- exception, the lock is released.
  --
  -- Note that: @with = 'bracket_' '<$>' 'acquire' '<*>' 'release'@.
  --
  -- @since 1.6.2.0
  with :: (MonadConc m) => Lock m -> m a -> m a
  with = bracket_ <$> acquire <*> release
  
  -- |
  -- A non-blocking 'with'. @tryWith@ is a convenience function which first tries
  -- to acquire the lock. If that fails, 'Nothing' is returned. If it succeeds,
  -- the computation is performed. When the computation terminates, whether
  -- normally or by raising an exception, the lock is released and 'Just' the
  -- result of the computation is returned.
  --
  -- @since 1.6.2.0
  tryWith :: (MonadConc m) => Lock m -> m a -> m (Maybe a)
  tryWith l a = mask $ \restore -> do
    acquired <- tryAcquire l
    if acquired
      then do r <- restore a `onException` release l
              release l
              pure (Just r)
      else pure Nothing
  
  -- |
  -- * When the state is \"locked\", @wait@ /blocks/ until a call to 'release'
  --   in another thread changes it to \"unlocked\".
  --
  -- * @wait@ is multiple-wakeup, so when multiple waiters are blocked on
  --   a @Lock@, all of them are woken up at the same time.
  --
  -- * When the state is \"unlocked\" @wait@ returns immediately.
  --
  -- @wait@ does not alter the state of the lock.
  --
  -- @since 1.6.2.0
  wait :: (MonadConc m) => Lock m -> m ()
  wait (Lock mv) = MVar.readMVar mv
  
  --------------------------------------------------------------------------------
  
  -- |
  -- Determines if the lock is in the \"locked\" state.
  --
  -- Note that this is only a snapshot of the state. By the time a program reacts
  -- on its result it may already be out of date.
  --
  -- @since 1.6.2.0
  locked :: (MonadConc m) => Lock m -> m Bool
  locked = MVar.isEmptyMVar . _fromLock
  
  --------------------------------------------------------------------------------
  