TSkipList.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Concurrent.TFile.TSkipList
-- Copyright   :  Peter Robinson 2010
-- License     :  LGPL
-- 
-- Maintainer  :  Peter Robinson <robinson@ecs.tuwien.ac.at>
-- Stability   :  experimental
-- Portability :  non-portable (requires STM)
--
-- Instantiates the STM skiplist implementation of
-- Control.Concurrent.TBox.TSkipList with the 'TFile' backend.
--
-- This module should be imported qualified.
--
-- Example:
--
-- > t <- newIO 0.5 5  :: IO (TSkipList Int String) 
-- > atomically $ sequence_ [ insert i (show i) t | i <- [1..10] ]
-- >
-- > putStr =<< atomically (toString 100 t)
-- > 9
-- > 9
-- > 3 7 9
-- > 1 3 7 9
-- > 1 2 3 4 5 6 7 8 9 10
-- >
-- > atomically $ delete  7 t
-- > putStr =<< atomically (toString 100 t)
-- > 9
-- > 9
-- > 3 9
-- > 1 3 9
-- > 1 2 3 4 5 6 8 9 10
-- > 
-- > atomically $ sequence [ lookup i t | i <- [5..10] ]
-- > [Just "5",Just "6",Nothing,Just "8",Just "9",Just "10"]
-- >
-- > atomically $ update 8 "X" t
-- > atomically $ sequence [ lookup i t | i <- [5..10] ]
-- > [Just "5",Just "6",Nothing,Just "X",Just "9",Just "10"]
-----------------------------------------------------------------------------

module Control.Concurrent.TFile.TSkipList(-- * Data type 
                                         TSkipList,newEmptyIO,newIO,
                                         -- * Operations
                                         insert,lookup,update,leq,geq,min,filter,delete,
                                         -- * Utilities 
                                         chooseLevel, toString
                                        ) 
where
import Prelude hiding(lookup,filter,catch,min)
import qualified Prelude as P
import Control.Concurrent.TBox.TSkipList hiding (TSkipList,newIO) -- (insert,lookup,update,leq,geq,filter,delete,newEmptyIO,chooseLevel)
import qualified Control.Concurrent.TBox.TSkipList as TBox.TSkipList
import Control.Concurrent.TBox(TBox)
import qualified Control.Concurrent.TBox as TBox
import Control.Concurrent.AdvSTM
import Control.Exception
import System.Directory
import System.IO.Error hiding (catch)
import Data.Binary
import Control.Monad
import Control.Applicative
--import Data.List(lem)

import Control.Concurrent.TFile(TFile)
import qualified Control.Concurrent.TFile as TFile


type TSkipList k a = TBox.TSkipList.TSkipList TFile k a


-- | Returns a new (reconstructed!) 'TSkipList'. Automatically inserts all 'TFile' entries found
-- in \"basedir</>\". 
-- Note that the 'TFile's are initially empty, i.e., the file content will only be
-- read into memory on demand.
newEmptyIO :: (Binary a,Show k,Ord k,Read k,TBox TFile k a) => Float -> Int -> IO (TSkipList k a)
newEmptyIO p maxLvl = do
  fs <- getFilesInDirectory TFile.basedir `catch` \(e::IOException) ->
           if isDoesNotExistError e then return []
                                    else throw e
  tskip <- TBox.TSkipList.newIO p maxLvl 
  forM_ fs (\(f::String) -> do 
    (t,k) <- TFile.newEmptyFromFileIO f 
    atomically $ do node <- newNode k t maxLvl
                    TBox.TSkipList.insertNode k node tskip)
  return tskip
  

-- | Returns a new (reconstructed!) 'TSkipList'. Automatically inserts all 'TFile' entries found
-- in \"basedir</>\". 
-- In contrast to 'newEmptyIO', the 'TFile's initially contain the file content.
-- Use this if you want to have all data in memory from the start.
newIO :: (Binary a,Show k,Ord k,Read k,TBox TFile k a) => Float -> Int -> IO (TSkipList k a)
newIO p maxLvl = do
  fs <- getFilesInDirectory TFile.basedir `catch` \(e::IOException) ->
           if isDoesNotExistError e then return []
                                    else throw e
  tskip <- TBox.TSkipList.newIO p maxLvl 
  forM_ fs (\(f::String) -> do 
    (t,k) <- TFile.newEmptyFromFileIO f  -- TODO: why *empty*?
    atomically $ do 
      _ <- TBox.read t  
      node <- newNode k t maxLvl
      TBox.TSkipList.insertNode k node tskip)
  return tskip


getFilesInDirectory :: FilePath -> IO [FilePath]
getFilesInDirectory fp = 
  P.filter (flip notElem [".",".."]) <$> getDirectoryContents fp