HsSVN-0.4.3.2: Subversion/FileSystem.hsc

{-# LANGUAGE
    DeriveDataTypeable
  , EmptyDataDecls
  , ForeignFunctionInterface
  #-}
{-# OPTIONS_HADDOCK prune #-}

-- |An interface to the Subversion filesystem.

#include "HsSVN.h"

module Subversion.FileSystem
    ( -- * Type
      FileSystem
    , SVN_FS_T -- private

    , wrapFS -- private
    , withFSPtr -- private
    , touchFS -- private

      -- * Information of the libsvn_fs itself
    , fsVersion

      -- * Filesystem creation, opening and destruction
    , createFileSystem
    , fsConfigFSType
    , fsTypeBDB
    , fsTypeFSFS

    , openFileSystem
    , deleteFileSystem
    , hotCopyFileSystem

      -- * Accessors
    , getFileSystemType
    , getFileSystemPath

    , getYoungestRev
    )
    where

import           Foreign.C.String
import           Foreign.ForeignPtr
import           Foreign.Ptr
import           Foreign.Marshal.Alloc
import           Foreign.Storable
import           GHC.ForeignPtr   as GF
import           Subversion.Error
import           Subversion.Hash
import           Subversion.Pool
import           Subversion.Types

-- |@'FileSystem'@ is an opaque object representing a Subversion
-- filesystem.
newtype FileSystem = FileSystem (ForeignPtr SVN_FS_T)
data SVN_FS_T

foreign import ccall "svn_fs_version"
        _version :: IO (Ptr SVN_VERSION_T)

foreign import ccall "svn_fs_create"
        _create :: Ptr (Ptr SVN_FS_T) -> CString -> Ptr APR_HASH_T -> Ptr APR_POOL_T -> IO (Ptr SVN_ERROR_T)

foreign import ccall "svn_fs_open"
        _open :: Ptr (Ptr SVN_FS_T) -> CString -> Ptr APR_HASH_T -> Ptr APR_POOL_T -> IO (Ptr SVN_ERROR_T)

foreign import ccall "svn_fs_delete_fs"
        _delete_fs :: CString -> Ptr APR_POOL_T -> IO (Ptr SVN_ERROR_T)

foreign import ccall "svn_fs_hotcopy"
        _hotcopy :: CString -> CString -> SVN_BOOLEAN_T -> Ptr APR_POOL_T -> IO (Ptr SVN_ERROR_T)

foreign import ccall "svn_fs_type"
        _type :: Ptr CString -> CString -> Ptr APR_POOL_T -> IO (Ptr SVN_ERROR_T)

foreign import ccall "svn_fs_path"
        _path :: Ptr SVN_FS_T -> Ptr APR_POOL_T -> IO CString

foreign import ccall "svn_fs_youngest_rev"
        _youngest_rev :: Ptr SVN_REVNUM_T -> Ptr SVN_FS_T -> Ptr APR_POOL_T -> IO (Ptr SVN_ERROR_T)


wrapFS :: IO () -> Ptr SVN_FS_T -> IO FileSystem
wrapFS finalizer fsPtr
    = do fs <- newForeignPtr_ fsPtr
         GF.addForeignPtrConcFinalizer fs finalizer
         return $ FileSystem fs


withFSPtr :: FileSystem -> (Ptr SVN_FS_T -> IO a) -> IO a
withFSPtr (FileSystem fs) = withForeignPtr fs


touchFS :: FileSystem -> IO ()
touchFS (FileSystem fs) = touchForeignPtr fs

-- |@fsVersion@ returns the version number of the libsvn_fs.
fsVersion :: IO Version
fsVersion = _version >>= peekVersion


-- |@'fsConfigFSType'@ is a config key to choose a filesystem
-- back-end.
fsConfigFSType :: String
fsConfigFSType = #const_str SVN_FS_CONFIG_FS_TYPE

-- |@'fsTypeBDB'@ is a config value representing the Berkeley-DB
-- back-end.
fsTypeBDB :: String
fsTypeBDB = #const_str SVN_FS_TYPE_BDB

-- |@'fsTypeFSFS'@ is a config value representing the
-- Native-filesystem back-end.
fsTypeFSFS :: String
fsTypeFSFS = #const_str SVN_FS_TYPE_FSFS

-- |@'createFileSystem'@ creates a new, empty Subversion
-- filesystem. Note that creating a raw filesystem and creating a
-- repository is not the same thing. If you want a new repository, use
-- 'Subversion.Repository.createRepository' instead.
createFileSystem
    :: FilePath           -- ^ Where to create the filesystem. The
                          --   path most not currently exist, but its
                          --   parent must exist.
    -> [(String, String)] -- ^ A list of @(key, value)@ tuples which
                          --   modifies the behavior of the
                          --   filesystem. The interpretation of it is
                          --   up to the filesystem back-end.
                          -- 
                          --   If the list contains a value for
                          --   'fsConfigFSType', that value determines
                          --   the filesystem type for the new
                          --   filesystem. These values are currently
                          --   defined:
                          --
                          --   ['fsTypeBDB'] Berkeley-DB implementation
                          --
                          --   ['fsTypeFSFS'] Native-filesystem
                          --   implementation
                          --
                          --   If the list does not contain
                          --   'fsConfigFSType' then the default
                          --   filesystem type will be used. This will
                          --   typically be BDB for version 1.1 and
                          --   FSFS for later versions, though you
                          --   should not rely upon any particular
                          --   default value if you want a filesystem
                          --   of specific type.
    -> IO FileSystem      -- ^ The new filesystem.
createFileSystem path configPairs
    = do pool <- newPool
         alloca $ \ fsPtrPtr ->
             withCString path $ \ pathPtr ->
             withPoolPtr pool $ \ poolPtr ->
                 do config <- pairsToHash configPairs
                    svnErr $ _create fsPtrPtr pathPtr (unsafeHashToPtr config) poolPtr

                    fs <- wrapFS (touchPool pool) =<< peek fsPtrPtr

                    -- We want config to be alive until the fs dies.
                    GF.addForeignPtrConcFinalizer (case fs of FileSystem x -> x)
                          $ touchHash config

                    return fs

-- |@'openFileSystem'@ opens a Subversion filesystem. Note that you
-- probably don't want to use this directly. Take a look at
-- 'Subversion.Repository.openRepository' instead.
openFileSystem
    :: FilePath           -- ^ Where the filesystem located on.
    -> [(String, String)] -- ^ A list of @(key, value)@ tuples which
                          --   modifies the behavior of the
                          --   filesystem. The interpretation of it is
                          --   up to the filesystem back-end.
    -> IO FileSystem
openFileSystem path configPairs
    = do pool <- newPool
         alloca $ \ fsPtrPtr ->
             withCString path $ \ pathPtr ->
             withPoolPtr pool $ \ poolPtr ->
             do config <- pairsToHash configPairs
                svnErr $ _open fsPtrPtr pathPtr (unsafeHashToPtr config) poolPtr

                fs <- wrapFS (touchPool pool) =<< peek fsPtrPtr

                -- We want config to be alive until the fs dies.
                GF.addForeignPtrConcFinalizer (case fs of FileSystem x -> x)
                      $ touchHash config

                return fs

-- |@'deleteFileSystem'@ deletes a Subversion filesystem. Note that
-- you probably don't want to use this directly. Take a look at
-- 'Subversion.Repository.deleteRepository' instead.
deleteFileSystem :: FilePath -> IO ()
deleteFileSystem path
    = do pool <- newPool
         withCString path $ \ pathPtr ->
             withPoolPtr pool $ \ poolPtr ->
             svnErr $ _delete_fs pathPtr poolPtr

-- |@'hotCopyFileSystem'@ copies a possibly live Subversion filesystem
-- from one location to another.
hotCopyFileSystem :: FilePath -- ^ Source
                  -> FilePath -- ^ Destination
                  -> Bool     -- ^ If 'True', @'hotCopyFileSystem'@
                              --   performs cleanup on the source
                              --   filesystem as part of the copy
                              --   opeation; currently, this means
                              --   deleting copied, unused logfiles
                              --   for a Berkeley DB source
                              --   filesystem.
                  -> IO ()
hotCopyFileSystem src dest clean
    = do pool <- newPool
         withCString src $ \ srcPath ->
             withCString dest $ \ destPath ->
             withPoolPtr pool $ \ poolPtr  ->
             svnErr $ _hotcopy srcPath destPath (marshalBool clean) poolPtr

-- |@'getFileSystemPath' fsPath@ returns a string identifying the
-- back-end type of the Subversion filesystem located on @fsPath@. The
-- string should be equal to one of the @fsType*@ defined constants,
-- unless the filesystem is a new back-end type added in a later
-- version of Subversion.
--
-- In general, the type should make no difference in the filesystem's
-- semantics, but there are a few situations (such as backups) where
-- it might matter.
getFileSystemType :: FilePath -> IO String
getFileSystemType path
    = do pool <- newPool
         alloca $ \ typePtrPtr ->
             withCString path $ \ pathPtr ->
             withPoolPtr pool $ \ poolPtr ->
             do svnErr $ _type typePtrPtr pathPtr poolPtr
                peekCString =<< peek typePtrPtr

-- |@'getFileSystemPath' fs@ returns the path to @fs@'s
-- repository. Note that this is what was passed to 'createFileSystem'
-- or 'openFileSystem'; might be absolute, might be not.
getFileSystemPath :: FileSystem -> IO FilePath
getFileSystemPath fs
    = do pool <- newPool
         withFSPtr fs $ \ fsPtr ->
             withPoolPtr pool $ \ poolPtr ->
             do path <- peekCString =<< _path fsPtr poolPtr
                touchPool pool
                return path

-- |@'getYoungestRev' fs@ returns the youngest revision number in
-- filesystem @fs@. The revision number starts from zero.
getYoungestRev :: FileSystem -> IO RevNum
getYoungestRev fs
    = do pool <- newPool
         alloca $ \ revNumPtr ->
             withFSPtr   fs   $ \ fsPtr   ->
             withPoolPtr pool $ \ poolPtr ->
             do svnErr $ _youngest_rev revNumPtr fsPtr poolPtr
                return . fromIntegral =<< peek revNumPtr