{-| An implementation of the queue from
  <http://zookeeper.apache.org/doc/trunk/recipes.html#sc_recipes_Queues>.

  The queue node will be automatically created and removed as necessary, and must
  not be used for any other purposes.  The parent node of the queue node must
  already exist.

  Queues may contain both non-ephemeral and ephemeral values.
-}

module Zookeeper.Queue ( push, pushEphemeral, pop, popNonBlocking ) where

import Control.Concurrent.MVar ( newMVar, putMVar, takeMVar )
import Control.Exception as E  ( catch, try )
import Control.Monad           ( liftM )
import Data.List               ( sort )
import System.FilePath.Posix   ( (</>) )
import qualified Zookeeper.Core as C

push_ :: Bool -> C.Handle -> String -> String -> IO ()
push_ isEphemeral handle path value = do
  -- Create the parent node to store the child nodes in.  If the parent node already exists then
  -- this will cause a NodeExists exception;  we catch (and ignore) this exception.
  (C.create handle path "" [] C.openAclUnsafe >> return ()) `E.catch` (\C.NodeExists -> return ())
  -- Now create our child node in the directory.
  let child = path </> "lock-"
  let flags = (if isEphemeral then [C.Ephemeral] else []) ++ [C.Sequence]
  _ <- C.create handle child value flags C.openAclUnsafe
  return ()

-- | Push a (non-ephemeral) value onto the tail of the specified queue.
-- If the client fails then the value will remain in the queue.
push :: C.Handle  -- ^ The ZooKeeper handle.
     -> String    -- ^ The name of the queue node.
     -> String    -- ^ The value to push onto the queue.
     -> IO ()
push = push_ False

-- | Push an ephemeral value onto the tail of the specified queue.
-- If the client fails then the value will be removed from the queue.
pushEphemeral :: C.Handle  -- ^ The ZooKeeper handle.
              -> String    -- ^ The name of the queue node.
              -> String    -- ^ The ephemeral value to push onto the queue.
              -> IO ()
pushEphemeral = push_ True

-- TODO Actually remove the queue when it is empty.

-- | Remove and return the value from the head of the queue.  If the queue
-- is currently empty, then this action will block until there is an available
-- value.
pop :: C.Handle   -- ^ The ZooKeeper handle.
    -> String     -- ^ The name of the queue node.
    -> IO String  -- ^ The value from the head of the queue.
pop h path = do
  notified <- newMVar ()
  -- TODO Tighten the watcher up.
  let watcher _ C.Child _ _ = putMVar notified ()
      watcher _ _       _ _ = error "Unexpected response"
      f [] = do
        takeMVar notified
        f =<< sort `liftM` C.getChildren h path (Just watcher)
      f (c:cs) = do
        x <- E.try $ do
          (v, _) <- C.get h (path </> c) Nothing
          C.delete h (path </> c) Nothing
          return v
        case x of
          Left C.NoNode -> f cs
          Left _        -> error "Unexpected response"
          Right v       -> return v
  f []

-- | Remove and return the value from the head of the queue.  If the queue
-- is currently empty, then 'Nothing' will be returned.
popNonBlocking :: C.Handle           -- ^ The ZooKeeper handle.
               -> String             -- ^ The name of the queue node.
               -> IO (Maybe String)  -- ^ The value from the head of the queue, if present.
popNonBlocking h path = do
  let f [] = do
        cs <- sort `liftM` C.getChildren h path Nothing
        case cs of
          [] -> return Nothing  -- Queue is empty.
          _  -> f cs
      f (c:cs) = do
        x <- E.try $ do
          (v, _) <- C.get h (path </> c) Nothing
          C.delete h (path </> c) Nothing
          return $ Just v
        case x of
          Left C.NoNode -> f cs
          Left _        -> error "Unexpected response"
          Right v       -> return v
  f []
