{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances,
  MultiParamTypeClasses, ExistentialQuantification,
  OverloadedStrings, FlexibleInstances, UndecidableInstances #-}

{- |
A persistent, transactional collection with Queue interface as well as
 indexed access by key.

 Uses default persistence. See "Data.TCache.DefaultPersistence"

-}
{-
NOTES
TODO:
data.persistent collection
 convertirlo en un tree
     añadiendo elementos node  Node (refQueue a)
 implementar un query language
    by key
    by attribute (addAttibute)
    by class
    xpath
 implementar un btree sobre el
-}
module Data.Persistent.Collection (
RefQueue, getQRef,
pop,popSTM,pick, flush, flushSTM,
pickAll, pickAllSTM, push,pushSTM,
pickElem, pickElemSTM,  readAll, readAllSTM,
deleteElem, deleteElemSTM,updateElem,updateElemSTM,
unreadSTM,isEmpty,isEmptySTM
) where
import Data.Typeable
import Control.Concurrent.STM(STM,atomically, retry)
import Control.Monad
import Data.TCache.DefaultPersistence

import Data.TCache
import Data.RefSerialize

--import Debug.Trace
--(!>) :: a -> String -> a
--a !> b= trace b a




instance Indexable (Queue a) where
   key :: Queue a -> String
key (Queue String
k  [a]
_ [a]
_)= String
queuePrefix forall a. [a] -> [a] -> [a]
++ String
k




data Queue a= Queue String [a] [a]  deriving (Typeable)



instance Serialize a => Serialize (Queue a) where
  showp :: Queue a -> STW ()
showp (Queue String
n [a]
i [a]
o)= forall c. Serialize c => c -> STW ()
showp String
n forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall c. Serialize c => c -> STW ()
showp [a]
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall c. Serialize c => c -> STW ()
showp [a]
o
  readp :: STR (Queue a)
readp = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. String -> [a] -> [a] -> Queue a
Queue forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` forall c. Serialize c => STR c
readp forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` forall c. Serialize c => STR c
readp forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` forall c. Serialize c => STR c
readp
--    do
--       n <-   readp
--       i <-   readp
--       o <-   readp
--       return $ Queue n i o



queuePrefix :: String
queuePrefix :: String
queuePrefix= String
"Queue#"

lenQPrefix :: Int
lenQPrefix :: Int
lenQPrefix= forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length String
queuePrefix

instance   Serialize a => Serializable (Queue a ) where
  serialize :: Queue a -> ByteString
serialize = STW () -> ByteString
runW forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Serialize c => c -> STW ()
showp
  deserialize :: ByteString -> Queue a
deserialize = forall a. STR a -> ByteString -> a
runR  forall c. Serialize c => STR c
readp

-- | A queue reference
type RefQueue a= DBRef (Queue a)

-- | push an element at the top of the queue
unreadSTM :: (Typeable a, Serialize a) => RefQueue a -> a -> STM ()
unreadSTM :: forall a. (Typeable a, Serialize a) => RefQueue a -> a -> STM ()
unreadSTM RefQueue a
queue a
x= do
    Queue a
r <- forall a. (Typeable a, Serialize a) => RefQueue a -> STM (Queue a)
readQRef RefQueue a
queue
    forall a. (IResource a, Typeable a) => DBRef a -> a -> STM ()
writeDBRef RefQueue a
queue forall a b. (a -> b) -> a -> b
$ Queue a -> Queue a
doit Queue a
r
    where
    doit :: Queue a -> Queue a
doit (Queue  String
n  [a]
imp [a]
out) =   forall a. String -> [a] -> [a] -> Queue a
Queue String
n  [a]
imp ( a
x forall a. a -> [a] -> [a]
: [a]
out)


-- | Check if the queue is empty
isEmpty ::  (Typeable a, Serialize a) => RefQueue a -> IO Bool
isEmpty :: forall a. (Typeable a, Serialize a) => RefQueue a -> IO Bool
isEmpty = forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Typeable a, Serialize a) => RefQueue a -> STM Bool
isEmptySTM

isEmptySTM :: (Typeable a, Serialize a) => RefQueue a -> STM Bool
isEmptySTM :: forall a. (Typeable a, Serialize a) => RefQueue a -> STM Bool
isEmptySTM RefQueue a
queue= do
   Maybe (Queue a)
r <- forall a. (IResource a, Typeable a) => DBRef a -> STM (Maybe a)
readDBRef RefQueue a
queue
   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe (Queue a)
r of
        Maybe (Queue a)
Nothing  ->  Bool
True
        Just (Queue String
_ [] []) -> Bool
True
        Maybe (Queue a)
_    ->  Bool
False



-- | Get the reference to new or existing queue trough its name
getQRef ::  (Typeable a, Serialize a)  => String -> RefQueue a
getQRef :: forall a. (Typeable a, Serialize a) => String -> RefQueue a
getQRef String
n = forall a. (Typeable a, IResource a) => String -> DBRef a
getDBRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Indexable a => a -> String
key forall a b. (a -> b) -> a -> b
$ forall a. String -> [a] -> [a] -> Queue a
Queue String
n forall a. HasCallStack => a
undefined forall a. HasCallStack => a
undefined


-- | Empty the queue (factually, it is deleted)
flush ::   (Typeable a, Serialize a)  => RefQueue a -> IO ()
flush :: forall a. (Typeable a, Serialize a) => RefQueue a -> IO ()
flush = forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Typeable a, Serialize a) => RefQueue a -> STM ()
flushSTM

-- | Version in the STM monad
flushSTM ::  (Typeable a, Serialize a)  => RefQueue a -> STM ()
flushSTM :: forall a. (Typeable a, Serialize a) => RefQueue a -> STM ()
flushSTM = forall a. (IResource a, Typeable a) => DBRef a -> STM ()
delDBRef

-- | Read  the first element in the queue and delete it (pop)
pop
      ::  (Typeable a, Serialize a)  => RefQueue a       -- ^ Queue name
      -> IO a              -- ^ the returned elems
pop :: forall a. (Typeable a, Serialize a) => RefQueue a -> IO a
pop RefQueue a
tv = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. (Typeable a, Serialize a) => RefQueue a -> STM a
popSTM RefQueue a
tv


readQRef :: (Typeable a, Serialize a)  => RefQueue a -> STM(Queue a)
readQRef :: forall a. (Typeable a, Serialize a) => RefQueue a -> STM (Queue a)
readQRef RefQueue a
tv= do
    Maybe (Queue a)
mdx <- forall a. (IResource a, Typeable a) => DBRef a -> STM (Maybe a)
readDBRef RefQueue a
tv
    case Maybe (Queue a)
mdx of
     Maybe (Queue a)
Nothing -> do
            let q :: Queue a
q= forall a. String -> [a] -> [a] -> Queue a
Queue ( forall a. Int -> [a] -> [a]
Prelude.drop Int
lenQPrefix forall a b. (a -> b) -> a -> b
$ forall a. DBRef a -> String
keyObjDBRef RefQueue a
tv) [] []
            forall a. (IResource a, Typeable a) => DBRef a -> a -> STM ()
writeDBRef RefQueue a
tv forall {a}. Queue a
q
            forall (m :: * -> *) a. Monad m => a -> m a
return forall {a}. Queue a
q
     Just Queue a
dx ->
            forall (m :: * -> *) a. Monad m => a -> m a
return Queue a
dx

-- | Version in the STM monad
popSTM :: (Typeable a, Serialize a) =>  RefQueue a
              -> STM  a
popSTM :: forall a. (Typeable a, Serialize a) => RefQueue a -> STM a
popSTM RefQueue a
tv=do
    Queue a
dx <- forall a. (Typeable a, Serialize a) => RefQueue a -> STM (Queue a)
readQRef RefQueue a
tv
    Queue a -> STM a
doit  Queue a
dx

    where

    doit :: Queue a -> STM a
doit (Queue String
n [a
x] [])= do
                 forall a. (IResource a, Typeable a) => DBRef a -> a -> STM ()
writeDBRef RefQueue a
tv (forall a. String -> [a] -> [a] -> Queue a
Queue String
n  [] [])
                 forall (m :: * -> *) a. Monad m => a -> m a
return   a
x
    doit (Queue String
_ [] []) =  forall a. STM a
retry
    doit (Queue  String
n [a]
imp [])  =  Queue a -> STM a
doit  (forall a. String -> [a] -> [a] -> Queue a
Queue  String
n [] forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
Prelude.reverse [a]
imp)
    doit (Queue String
n [a]
imp  [a]
list ) = do
                 forall a. (IResource a, Typeable a) => DBRef a -> a -> STM ()
writeDBRef RefQueue a
tv  (forall a. String -> [a] -> [a] -> Queue a
Queue  String
n [a]
imp (forall a. [a] -> [a]
Prelude.tail [a]
list ))
                 forall (m :: * -> *) a. Monad m => a -> m a
return  forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
Prelude.head [a]
list

--  | Read the first element in the queue but it does not delete it
pick
      ::  (Typeable a, Serialize a)  => RefQueue a       -- ^ Queue name
      -> IO a              -- ^ the returned elems
pick :: forall a. (Typeable a, Serialize a) => RefQueue a -> IO a
pick RefQueue a
tv = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
    Queue a
dx <- forall a. (Typeable a, Serialize a) => RefQueue a -> STM (Queue a)
readQRef RefQueue a
tv
    forall {a}. Queue a -> STM a
doit Queue a
dx
    where
    doit :: Queue a -> STM a
doit (Queue String
_ [a
x] [])= forall (m :: * -> *) a. Monad m => a -> m a
return   a
x
    doit (Queue String
_ [] []) =  forall a. STM a
retry
    doit (Queue  String
n [a]
imp [])  =  Queue a -> STM a
doit  (forall a. String -> [a] -> [a] -> Queue a
Queue  String
n [] forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
Prelude.reverse [a]
imp)
    doit (Queue String
_ [a]
_  [a]
list ) = forall (m :: * -> *) a. Monad m => a -> m a
return  forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
Prelude.head [a]
list

-- | Push an element in the queue
push  ::   (Typeable a, Serialize a)  => RefQueue a -> a -> IO ()
push :: forall a. (Typeable a, Serialize a) => RefQueue a -> a -> IO ()
push RefQueue a
tv a
v = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. (Typeable a, Serialize a) => RefQueue a -> a -> STM ()
pushSTM RefQueue a
tv a
v

-- | Version in the STM monad
pushSTM ::  (Typeable a, Serialize a)  => RefQueue a -> a -> STM ()
pushSTM :: forall a. (Typeable a, Serialize a) => RefQueue a -> a -> STM ()
pushSTM  RefQueue a
tv   a
v=
      forall a. (Typeable a, Serialize a) => RefQueue a -> STM (Queue a)
readQRef RefQueue a
tv  forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (Queue String
n  [a]
imp [a]
out)  -> forall a. (IResource a, Typeable a) => DBRef a -> a -> STM ()
writeDBRef RefQueue a
tv  forall a b. (a -> b) -> a -> b
$ forall a. String -> [a] -> [a] -> Queue a
Queue String
n  (a
v forall a. a -> [a] -> [a]
: [a]
imp) [a]
out

-- | Return the list of all elements in the queue. The queue remains unchanged
pickAll ::  (Typeable a, Serialize a)  => RefQueue a -> IO [a]
pickAll :: forall a. (Typeable a, Serialize a) => RefQueue a -> IO [a]
pickAll= forall a. STM a -> IO a
atomically  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Typeable a, Serialize a) => RefQueue a -> STM [a]
pickAllSTM

-- | Version in the STM monad
pickAllSTM :: (Typeable a, Serialize a)  => RefQueue a -> STM [a]
pickAllSTM :: forall a. (Typeable a, Serialize a) => RefQueue a -> STM [a]
pickAllSTM RefQueue a
tv= do
     (Queue String
_ [a]
imp [a]
out) <- forall a. (Typeable a, Serialize a) => RefQueue a -> STM (Queue a)
readQRef RefQueue a
tv
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [a]
out forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
Prelude.reverse [a]
imp

-- | Return the first element in the queue that has the given key
pickElem ::(Indexable a,Typeable a, Serialize a) => RefQueue a -> String -> IO(Maybe a)
pickElem :: forall a.
(Indexable a, Typeable a, Serialize a) =>
RefQueue a -> String -> IO (Maybe a)
pickElem RefQueue a
tv String
k= forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a.
(Indexable a, Typeable a, Serialize a) =>
RefQueue a -> String -> STM (Maybe a)
pickElemSTM RefQueue a
tv String
k

-- | Version in the STM monad
pickElemSTM :: (Indexable a,Typeable a, Serialize a)
                     => RefQueue a -> String -> STM(Maybe a)
pickElemSTM :: forall a.
(Indexable a, Typeable a, Serialize a) =>
RefQueue a -> String -> STM (Maybe a)
pickElemSTM RefQueue a
tv String
key1 = do
  Queue String
name [a]
imp [a]
out <- forall a. (Typeable a, Serialize a) => RefQueue a -> STM (Queue a)
readQRef RefQueue a
tv
  let xs :: [a]
xs = [a]
out forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
Prelude.reverse [a]
imp
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [a]
imp) forall a b. (a -> b) -> a -> b
$ forall a. (IResource a, Typeable a) => DBRef a -> a -> STM ()
writeDBRef RefQueue a
tv forall a b. (a -> b) -> a -> b
$ forall a. String -> [a] -> [a] -> Queue a
Queue String
name [] [a]
xs
  case forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (\a
x -> forall a. Indexable a => a -> String
key a
x forall a. Eq a => a -> a -> Bool
== String
key1) [a]
xs of
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    (a
x:[a]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
x

-- | Update the first element of the queue with a new element with the same key
updateElem :: (Indexable a,Typeable a, Serialize a)
                    => RefQueue a  -> a -> IO()
updateElem :: forall a.
(Indexable a, Typeable a, Serialize a) =>
RefQueue a -> a -> IO ()
updateElem RefQueue a
tv a
x = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a.
(Indexable a, Typeable a, Serialize a) =>
RefQueue a -> a -> STM ()
updateElemSTM RefQueue a
tv  a
x

-- | Version in the STM monad
updateElemSTM :: (Indexable a,Typeable a, Serialize a)
                       => RefQueue a  -> a -> STM()
updateElemSTM :: forall a.
(Indexable a, Typeable a, Serialize a) =>
RefQueue a -> a -> STM ()
updateElemSTM RefQueue a
tv a
v= do
     Queue String
name [a]
imp [a]
out <- forall a. (Typeable a, Serialize a) => RefQueue a -> STM (Queue a)
readQRef RefQueue a
tv
     let xs :: [a]
xs= [a]
out forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
Prelude.reverse [a]
imp
     let xs' :: [a]
xs'= forall a b. (a -> b) -> [a] -> [b]
Prelude.map (\a
x -> if forall a. Indexable a => a -> String
key a
x forall a. Eq a => a -> a -> Bool
== String
n then a
v else a
x) [a]
xs
     forall a. (IResource a, Typeable a) => DBRef a -> a -> STM ()
writeDBRef RefQueue a
tv  forall a b. (a -> b) -> a -> b
$ forall a. String -> [a] -> [a] -> Queue a
Queue String
name [] [a]
xs'
     where
     n :: String
n= forall a. Indexable a => a -> String
key a
v

-- | Return the list of all elements in the queue and empty it
readAll ::  (Typeable a, Serialize a) => RefQueue a -> IO [a]
readAll :: forall a. (Typeable a, Serialize a) => RefQueue a -> IO [a]
readAll= forall a. STM a -> IO a
atomically  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Typeable a, Serialize a) => RefQueue a -> STM [a]
readAllSTM

-- | A version in the STM monad
readAllSTM ::  (Typeable a, Serialize a)  => RefQueue a -> STM [a]
readAllSTM :: forall a. (Typeable a, Serialize a) => RefQueue a -> STM [a]
readAllSTM RefQueue a
tv= do
     Queue String
name [a]
imp [a]
out <- forall a. (Typeable a, Serialize a) => RefQueue a -> STM (Queue a)
readQRef RefQueue a
tv
     forall a. (IResource a, Typeable a) => DBRef a -> a -> STM ()
writeDBRef RefQueue a
tv  forall a b. (a -> b) -> a -> b
$ forall a. String -> [a] -> [a] -> Queue a
Queue String
name [] []
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [a]
out forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
Prelude.reverse [a]
imp

-- | Delete all the elements of the queue that has the key of the parameter passed
deleteElem :: (Indexable a,Typeable a, Serialize a) => RefQueue a-> a -> IO ()
deleteElem :: forall a.
(Indexable a, Typeable a, Serialize a) =>
RefQueue a -> a -> IO ()
deleteElem RefQueue a
tv a
x= forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a.
(Typeable a, Serialize a, Indexable a) =>
RefQueue a -> a -> STM ()
deleteElemSTM RefQueue a
tv a
x

-- | Version in the STM monad
deleteElemSTM :: (Typeable a, Serialize a,Indexable a) => RefQueue a-> a -> STM ()
deleteElemSTM :: forall a.
(Typeable a, Serialize a, Indexable a) =>
RefQueue a -> a -> STM ()
deleteElemSTM RefQueue a
tv a
x= do
     Queue String
name [a]
imp [a]
out <- forall a. (Typeable a, Serialize a) => RefQueue a -> STM (Queue a)
readQRef RefQueue a
tv
     let xs :: [a]
xs= [a]
out forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
Prelude.reverse [a]
imp
     forall a. (IResource a, Typeable a) => DBRef a -> a -> STM ()
writeDBRef RefQueue a
tv forall a b. (a -> b) -> a -> b
$ forall a. String -> [a] -> [a] -> Queue a
Queue String
name [] forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (\a
x2-> forall a. Indexable a => a -> String
key a
x2 forall a. Eq a => a -> a -> Bool
/= String
k) [a]
xs
     where
     k :: String
k=forall a. Indexable a => a -> String
key a
x