module Sample
where
import Control.Monad( when )
import Control.Exception
import Data.TStorage
import Data.TMap
import Data.TMap.Backend.Binary
import qualified Data.CacheStructure.LRU as C
import Control.Concurrent.AdvSTM 
import qualified Control.Exception as Exc
import qualified Data.Edison.Assoc.StandardMap as M
import Data.Data
import Data.Typeable
import Data.Binary
import Prelude hiding( lookup )
import System.Directory

data Sometype = Sometype { theid :: Int, name :: String }
                deriving (Show,Eq,Ord,Data,Typeable)

instance Binary Sometype where
  put (Sometype a b) = put a >> put b
  get = get >>= \a -> get >>= \b -> return (Sometype a b)


instance HasKey Sometype Int where
  key = theid


sample :: IO ()
sample = Exc.handle (\(e::Exc.SomeException) -> print e) $ do

  -- Let's create a TMap that uses the binary-serialization backend:
  backend <- mkBinaryBackend "test" 
--  removeDirectory "/home/thaldyron/var/test"
  tmap <- newTMapIO backend (Just 4) 
            :: IO (TMap (M.FM Int) Int Sometype BinaryBackend C.LRU)

  -- First let's use the low level TMap interface:
  res  <- atomically $ (do
    insert 1 (Sometype 1 "somename")  tmap
    insert 2 (Sometype 2 "somename2") tmap
    insert 3 (Sometype 3 "somename3") tmap
    insert 4 (Sometype 4 "somename4") tmap
    insert 5 (Sometype 5 "somename5") tmap
    insert 6 (Sometype 6 "somename6") tmap
    lookup 2 tmap
    delete 2 tmap
    lookup 2 tmap) 
    -- Catch duplicate-inserts exceptions:
    `catchSTM` (\(e::TMapException) -> 
      if e==DuplicateEntry then return Nothing
                           else throw (AssertionFailed (show e)))
  purgeTMapIO tmap
  print ("Result1: ",res)  

  -- Let's try the high-level TStorage interface:
  res2 <- atomically $ do
    add (Sometype 7 "somename7") tmap
    v1 <- apply (\s -> s{name="_"}) (Sometype {theid = 1}) tmap
    v2 <- complete (Sometype {theid = 1}) tmap
--    return v2
    return (v1,v2)
  print ("Result2: ",res2)

test :: IO ()
test = do
   backend <- mkBinaryBackend "test2" 
   tmap <- newTMapIO backend (Just 4) 
            :: IO (TMap (M.FM Int) Int String BinaryBackend C.LRU)
   atomically $ do
       isMemb <- member 1 tmap
       when (not isMemb) $ do
         insert 1 "john doe" tmap
   atomically $ do
     v <- lookup 1 tmap
     -- ... doing something here with 'v'
     case v of
       Nothing -> return ()
       Just v' -> do 
         adjust (\_ -> "jd") 1 tmap
         onCommit $ print v'