HsSVN 0.4.1 → 0.4.2
raw patch · 15 files changed
+108/−115 lines, 15 filesdep ~basesetup-changed
Dependency ranges changed: base
Files
- HsSVN.cabal +2/−2
- NEWS +5/−0
- Setup.hs +1/−1
- Subversion/Error.hsc +1/−1
- Subversion/FileSystem.hsc +6/−8
- Subversion/FileSystem/Revision.hsc +8/−10
- Subversion/FileSystem/Root.hsc +6/−8
- Subversion/FileSystem/Transaction.hsc +10/−12
- Subversion/Hash.hsc +11/−12
- Subversion/Pool.hsc +3/−3
- Subversion/Repository.hsc +36/−36
- Subversion/Stream.hsc +5/−5
- Subversion/Stream/Pipe.hs +3/−6
- Subversion/String.hsc +5/−5
- Subversion/Types.hsc +6/−6
HsSVN.cabal view
@@ -4,7 +4,7 @@ HsSVN is a (part of) Subversion binding for Haskell. Currently it can do most things related to the Subversion FS but others are left uncovered.-Version: 0.4.1+Version: 0.4.2 License: PublicDomain License-File: COPYING Author: PHO <pho at cielonegro dot org>@@ -30,7 +30,7 @@ Library Build-Depends:- base >= 4, bytestring, mtl, stm+ base >= 4 && < 5, bytestring, mtl, stm Exposed-Modules: Subversion Subversion.Config
NEWS view
@@ -1,3 +1,8 @@+Changes from 0.4.1 to 0.4.2+---------------------------+* Fixed breakage on GHC 6.12.1.++ Changes from 0.4 to 0.4.1 ------------------------- * Fixed incorrect dependency declaration in HsSVN.cabal. No semantical
Setup.hs view
@@ -1,4 +1,4 @@ #!/usr/bin/env runghc import Distribution.Simple-main = defaultMainWithHooks defaultUserHooks+main = defaultMainWithHooks autoconfUserHooks
Subversion/Error.hsc view
@@ -80,7 +80,7 @@ | errPtr == nullPtr = return Nothing | otherwise- = newForeignPtr _clear errPtr >>= return . Just . SvnError+ = fmap (Just . SvnError) (newForeignPtr _clear errPtr) svnErr :: IO (Ptr SVN_ERROR_T) -> IO ()
Subversion/FileSystem.hsc view
@@ -36,7 +36,6 @@ ) where -import Control.Monad import Foreign.C.String import Foreign.ForeignPtr import Foreign.Ptr@@ -100,17 +99,17 @@ -- |@'fsConfigFSType'@ is a config key to specify the filesystem -- back-end. fsConfigFSType :: String-fsConfigFSType = (#const_str SVN_FS_CONFIG_FS_TYPE)+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)+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)+fsTypeFSFS = #const_str SVN_FS_TYPE_FSFS -- |@'createFileSystem'@ creates a new, empty Subversion -- filesystem. Note that creating a raw filesystem is different from@@ -156,7 +155,7 @@ fs <- wrapFS (touchPool pool) =<< peek fsPtrPtr - -- config には fs が死ぬまでは生きてゐて慾しい。+ -- We want config to be alive until the fs dies. GF.addForeignPtrConcFinalizer (case fs of FileSystem x -> x) $ touchHash config @@ -182,7 +181,7 @@ fs <- wrapFS (touchPool pool) =<< peek fsPtrPtr - -- config には fs が死ぬまでは生きてゐて慾しい。+ -- We want config to be alive until the fs dies. GF.addForeignPtrConcFinalizer (case fs of FileSystem x -> x) $ touchHash config @@ -233,8 +232,7 @@ withCString path $ \ pathPtr -> withPoolPtr pool $ \ poolPtr -> do svnErr $ _type typePtrPtr pathPtr poolPtr- t <- peekCString =<< peek typePtrPtr- return t+ peekCString =<< peek typePtrPtr -- |@'getFileSystemPath' fs@ returns the path to @fs@'s -- repository. Note that this is what was passed to 'createFileSystem'
Subversion/FileSystem/Revision.hsc view
@@ -102,7 +102,7 @@ withFSPtr fs $ \ fsPtr -> withPoolPtr pool $ \ poolPtr -> do svnErr $ _revision_root rootPtrPtr fsPtr (fromIntegral revNum) poolPtr- -- root は pool にも fs にも依存する。+ -- FS Root depends on both pool and fs. wrapFSRoot (touchPool pool >> touchFS fs) =<< peek rootPtrPtr @@ -117,8 +117,7 @@ getRevisionNumber = do root <- getRoot unsafeIOToFS $ withFSRootPtr root $ \ rootPtr ->- _revision_root_revision rootPtr - >>= return . fromIntegral+ (fmap fromIntegral (_revision_root_revision rootPtr)) -- |@'getRevisionProp' propName@ returns the value of the property -- named @propName@ of the revision.@@ -140,8 +139,8 @@ withPoolPtr pool $ \ poolPtr -> do svnErr $ _revision_prop valPtrPtr fsPtr (fromIntegral revNum) namePtr poolPtr prop <- peekSvnString' =<< peek valPtrPtr- -- prop は pool の中から讀み取られるので、それが濟むま- -- で pool が死んでは困る。+ -- We read prop in the pool so we don't want pool to+ -- be freed that time. touchPool pool return $ fmap B8.unpack prop @@ -163,9 +162,8 @@ do svnErr $ _revision_proplist hashPtrPtr fsPtr (fromIntegral revNum) poolPtr hash <- wrapHash (touchPool pool) =<< peek hashPtrPtr mapHash' (\ (n, v)- -> peekSvnString v- >>=- return . ((,) n) . B8.unpack) hash+ -> fmap ((,) n . B8.unpack) (peekSvnString v))+ hash -- |Change, add or delete a property on a revision. Note that revision -- properties are non-historied: you can change them after the@@ -226,8 +224,8 @@ got <- peek histPtrPtr if got == nullPtr then- -- ヒストリの終端に達した。これ以後、Pool は解放され- -- ても構はない。+ -- We reached at the end of history. The pool may+ -- be freed from now. touchPool pool >> return [] else do x <- getHistLocation got pool
Subversion/FileSystem/Root.hsc view
@@ -147,7 +147,6 @@ getRootFS :: FileSystemRoot -> IO FileSystem getRootFS root = withFSRootPtr root $ \ rootPtr ->- -- 實際には root が生きてゐる限り fs は死なないのだが、念の爲。 wrapFS (touchFSRoot root) =<< _root_fs rootPtr -- |@'getFileLength' path@ returns the length of file @path@.@@ -178,7 +177,7 @@ do svnErr $ _file_md5_checksum bufPtr rootPtr pathPtr poolPtr return . map fromIntegral =<< peekArray md5Len bufPtr where- md5Len = (#const APR_MD5_DIGESTSIZE)+ md5Len = #const APR_MD5_DIGESTSIZE -- |@'getFileContents' path@ returns the content of file @path@.@@ -215,7 +214,7 @@ withFSRootPtr root $ \ rootPtr -> withCString path $ \ pathPtr -> withPoolPtr pool $ \ poolPtr ->- (svnErr $ _file_contents ioPtrPtr rootPtr pathPtr poolPtr)+ svnErr (_file_contents ioPtrPtr rootPtr pathPtr poolPtr) >> peek ioPtrPtr >>= wrapStream (touchPool pool) >>= (if isTxn then@@ -236,9 +235,8 @@ do svnErr $ _node_proplist hashPtrPtr rootPtr pathPtr poolPtr hash <- wrapHash (touchPool pool) =<< peek hashPtrPtr mapHash' (\ (n, v)- -> peekSvnString v- >>=- return . ((,) n) . B8.unpack) hash+ -> fmap ((,) n . B8.unpack) (peekSvnString v))+ hash -- |@'getNodeProp' path propName@ returns the value of the property -- named @propName@ of @path@ in a revision or transaction.@@ -253,8 +251,8 @@ withPoolPtr pool $ \ poolPtr -> do svnErr $ _node_prop valPtrPtr rootPtr pathPtr namePtr poolPtr prop <- peekSvnString' =<< peek valPtrPtr- -- prop は pool の中から讀み取られるので、それが濟- -- むまで pool が死んでは困る。+ -- We read prop in the pool so we don't want pool+ -- to be freed that time. touchPool pool return $ fmap B8.unpack prop
Subversion/FileSystem/Transaction.hsc view
@@ -41,7 +41,6 @@ where import Control.Monad.Reader-import Control.Monad import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as Lazy (ByteString) import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString)@@ -80,13 +79,13 @@ fail = Txn . fail instance MonadFS Txn where- getRoot = Txn (ask >>= return . ctxRoot)+ getRoot = Txn (fmap ctxRoot ask) unsafeIOToFS a = Txn (liftIO a) isTransaction = Txn (return True) getTxn :: Txn Transaction-getTxn = Txn (ask >>= return . ctxTxn)+getTxn = Txn (fmap ctxTxn ask) {- functions and types ------------------------------------------------------- -}@@ -171,11 +170,11 @@ alloca $ \ rootPtrPtr -> withTxnPtr txn $ \ txnPtr -> withPoolPtr pool $ \ poolPtr ->- (svnErr $ _txn_root rootPtrPtr txnPtr poolPtr)+ svnErr (_txn_root rootPtrPtr txnPtr poolPtr) >> peek rootPtrPtr- >>= (wrapFSRoot $- -- root は pool にも txn にも依存する。- touchPool pool >> touchTxn txn)+ >>= wrapFSRoot+ -- The root depends on both pool and txn.+ (touchPool pool >> touchTxn txn) -- |@'getTxnProp' propName@ returns the value of the property named -- @propName@ on the transaction.@@ -189,8 +188,8 @@ withPoolPtr pool $ \ poolPtr -> do svnErr $ _txn_prop valPtrPtr txnPtr namePtr poolPtr prop <- peekSvnString' =<< peek valPtrPtr- -- prop は pool の中から讀み取られるので、それが濟- -- むまでは pool が死んでは困る。+ -- We read prop in the pool so we don't want pool+ -- to be freed that time. touchPool pool return $ fmap B8.unpack prop @@ -206,9 +205,8 @@ do svnErr $ _txn_proplist hashPtrPtr txnPtr poolPtr hash <- wrapHash (touchPool pool) =<< peek hashPtrPtr mapHash' (\ (n, v)- -> peekSvnString v- >>=- return . ((,) n) . B8.unpack) hash+ -> fmap ((,) n . B8.unpack) (peekSvnString v))+ hash -- |@'setTxnProp' propName propValue@ changes, adds or deletes a -- property on the transaction.
Subversion/Hash.hsc view
@@ -62,7 +62,7 @@ instance HashValue String where marshal str- = mallocStringForeignPtr str >>= return . castForeignPtr+ = fmap castForeignPtr $ mallocStringForeignPtr str unmarshal finalizer strPtr = do str <- peekCString (castPtr strPtr)@@ -128,10 +128,9 @@ withPoolPtr pool $ \ poolPtr -> _make poolPtr >>= wrapHash (touchPool pool) --- 一旦 Hash に入れた値は、Hash 自体が解放されるまでは解放されなくなる--- 事に注意。それがまずいのであれば、Hash 自体に Map (Ptr ())--- (ForeignPtr ()) を持たせて、その Map を同時に管理しなければならない。--- 面倒だ。+-- Any values which have been put in the Hash will not be freed until+-- Hash gets freed. If this is a problem, we have to let Hash have Map+-- (Ptr ()) (ForeignPtr ()) and maintain it together. Annoying. update :: HashValue a => Hash a -> String -> a -> IO () update (Hash hash) key value = withForeignPtr hash $ \ hashPtr ->@@ -141,7 +140,7 @@ (castPtr $ unsafeForeignPtrToPtr keyFPtr) (#const APR_HASH_KEY_STRING) (unsafeForeignPtrToPtr valueFPtr)- -- hash よりも key 及び value が先に解放されては困る。+ -- key and value must not be freed before hash. GF.addForeignPtrConcFinalizer hash $ do touchForeignPtr keyFPtr touchForeignPtr valueFPtr@@ -162,10 +161,10 @@ if valuePtr == nullPtr then return Nothing else- -- valuePtr は hash の解放と同時に解放され得るのだが、- -- unmarshal する前にそれが起きては困る。- unmarshal (touchHash hash) valuePtr- >>= return . Just+ -- valuePtr may be freed at the same time when hash gets+ -- freed, but that must not happen before doing+ -- unmarshal.+ fmap Just $ unmarshal (touchHash hash) valuePtr getFirst :: Hash a -> IO (Maybe (HashIndex a))@@ -231,7 +230,7 @@ where loop Nothing = return [] loop (Just idx) = do x <- f =<< getThis idx- xs <- unsafeInterleaveIO $+ xs <- unsafeInterleaveIO (getNext idx >>= loop) return (x:xs) @@ -241,6 +240,6 @@ where loop Nothing = return [] loop (Just idx) = do x <- f =<< getThis' idx- xs <- unsafeInterleaveIO $+ xs <- unsafeInterleaveIO (getNext idx >>= loop) return (x:xs)
Subversion/Pool.hsc view
@@ -22,9 +22,9 @@ newPool :: IO Pool-newPool = _create nullPtr- >>= newForeignPtr _destroy- >>= return . Pool+newPool = fmap Pool ( _create nullPtr+ >>= newForeignPtr _destroy+ ) withPoolPtr :: Pool -> (Ptr APR_POOL_T -> IO a) -> IO a
Subversion/Repository.hsc view
@@ -140,10 +140,10 @@ repos <- wrapRepos (touchPool pool) =<< peek reposPtrPtr - -- config と fsConfig には、repos が死ぬまでは生き- -- てゐて慾しい。- GF.addForeignPtrConcFinalizer (case repos of Repository x -> x)- $ (touchHash config >> touchHash fsConfig)+ -- We want config and fsConfig to be alive until the repos dies.+ GF.addForeignPtrConcFinalizer+ (case repos of Repository x -> x)+ (touchHash config >> touchHash fsConfig) return repos @@ -161,7 +161,7 @@ getRepositoryFS :: Repository -> IO FileSystem getRepositoryFS repos = withReposPtr repos $ \ reposPtr ->- -- svn_fs_t* より先に svn_repos_t* が解放されては困る+ -- svn_fs_t* depends on svn_repos_t*. _fs reposPtr >>= wrapFS (touchRepos repos) @@ -173,18 +173,17 @@ withCString author $ \ authorPtr -> withCString' logMsg $ \ logMsgPtr -> withPoolPtr pool $ \ poolPtr ->- (svnErr $- _fs_begin_txn_for_commit- txnPtrPtr- reposPtr- (fromIntegral revNum)- authorPtr- logMsgPtr- poolPtr)+ svnErr (_fs_begin_txn_for_commit+ txnPtrPtr+ reposPtr+ (fromIntegral revNum)+ authorPtr+ logMsgPtr+ poolPtr) >> peek txnPtrPtr- >>= (wrapTxn $- -- txn は pool にも repos にも依存する。- touchPool pool >> touchRepos repos)+ >>= wrapTxn + -- txn depends on both pool and repos.+ (touchPool pool >> touchRepos repos) where withCString' :: Maybe String -> (CString -> IO a) -> IO a withCString' Nothing f = f nullPtr@@ -199,12 +198,12 @@ alloca $ \ newRevPtr -> withTxnPtr txn $ \ txnPtr -> withPoolPtr pool $ \ poolPtr ->- do err <- wrapSvnError =<< (_fs_commit_txn- conflictPathPtrPtr- reposPtr- newRevPtr- txnPtr- poolPtr)+ do err <- wrapSvnError =<< _fs_commit_txn+ conflictPathPtrPtr+ reposPtr+ newRevPtr+ txnPtr+ poolPtr case err of Nothing -> liftM (Right . fromIntegral) (peek newRevPtr)@@ -289,20 +288,21 @@ dumpRepository repos startRev endRev incremental useDeltas = do pool <- newPool pipe <- newPipe- forkIO $ do withReposPtr repos $ \ reposPtr ->- withStreamPtr pipe $ \ pipePtr ->- withPoolPtr pool $ \ poolPtr ->- svnErr $ _dump_fs2 reposPtr- pipePtr- nullPtr- (fromMaybe invalidRevNum $ fmap fromIntegral startRev)- (fromMaybe invalidRevNum $ fmap fromIntegral endRev)- (marshalBool incremental)- (marshalBool useDeltas)- nullFunPtr- nullPtr- poolPtr- sClose pipe+ _ <- forkIO $+ do withReposPtr repos $ \ reposPtr ->+ withStreamPtr pipe $ \ pipePtr ->+ withPoolPtr pool $ \ poolPtr ->+ svnErr $ _dump_fs2 reposPtr+ pipePtr+ nullPtr+ (fromMaybe invalidRevNum $ fmap fromIntegral startRev)+ (fromMaybe invalidRevNum $ fmap fromIntegral endRev)+ (marshalBool incremental)+ (marshalBool useDeltas)+ nullFunPtr+ nullPtr+ poolPtr+ sClose pipe sReadLBS pipe where invalidRevNum :: SVN_REVNUM_T
Subversion/Stream.hsc view
@@ -144,7 +144,7 @@ mkReadFnPtr ra = mkReadCallback $ \ _ bufPtr lenPtr -> do requestedLen <- liftM fromIntegral (peek lenPtr)- resultStr <- ra requestedLen -- FIXME: 例外を catch すべき+ resultStr <- ra requestedLen -- FIXME: should catch exceptions B8.useAsCStringLen resultStr $ \ (resultPtr, resultLen) -> do when (resultLen > requestedLen) $ fail "resultLen > requestedLen" -- FIXME@@ -157,14 +157,14 @@ = mkWriteCallback $ \ _ bufPtr lenPtr -> do requestedLen <- liftM fromIntegral (peek lenPtr) inputStr <- B8.packCStringLen (bufPtr, requestedLen)- writtenLen <- wa inputStr -- FIXME: 例外を catch すべき+ writtenLen <- wa inputStr -- FIXME: should catch exceptions poke lenPtr (fromIntegral writtenLen) return nullPtr mkCloseFnPtr :: CloseAction -> IO (FunPtr CloseCallback) mkCloseFnPtr ca = mkCloseCallback $ \ _ ->- do ca -- FIXME: 例外を catch すべき+ do ca -- FIXME: should catch exceptions return nullPtr @@ -205,7 +205,7 @@ sReadLBS :: Stream -> IO Lazy.ByteString-sReadLBS io = lazyRead >>= return . L8.fromChunks+sReadLBS io = fmap L8.fromChunks lazyRead where chunkSize = 32 * 1024 @@ -221,7 +221,7 @@ sStrictReadLBS :: Stream -> IO Lazy.ByteString-sStrictReadLBS io = strictRead >>= return . L8.fromChunks+sStrictReadLBS io = fmap L8.fromChunks strictRead where chunkSize = 32 * 1024
Subversion/Stream/Pipe.hs view
@@ -8,7 +8,6 @@ import Control.Monad import qualified Data.ByteString as Strict import qualified Data.ByteString.Lazy as Lazy-import Data.Int import Subversion.Stream @@ -46,8 +45,7 @@ mkReadAction pipe reqLen = loop where loop :: IO Strict.ByteString- loop = do nextAction <- tryToRead- nextAction+ loop = join tryToRead tryToRead :: IO (IO Strict.ByteString) tryToRead@@ -80,8 +78,7 @@ mkWriteAction pipe input = loop input >> return (Strict.length input) where loop :: Strict.ByteString -> IO ()- loop str = do nextAction <- tryToWrite str- nextAction+ loop str = join (tryToWrite str) tryToWrite :: Strict.ByteString -> IO (IO ()) tryToWrite str@@ -101,7 +98,7 @@ retry else do writtenStr <- readTVar (pWrittenStr pipe)- writeTVar (pWrittenStr pipe) (writtenStr `Lazy.append` (Lazy.fromChunks [strToWrite]))+ writeTVar (pWrittenStr pipe) (writtenStr `Lazy.append` Lazy.fromChunks [strToWrite]) writeTVar (pRequestLen pipe) (reqLen - Strict.length strToWrite) return (loop remaining)
Subversion/String.hsc view
@@ -22,16 +22,16 @@ pokeData :: Ptr SVN_STRING_T -> Ptr CChar -> IO ()-pokeData = (#poke svn_string_t, data)+pokeData = #poke svn_string_t, data peekData :: Ptr SVN_STRING_T -> IO (Ptr CChar)-peekData = (#peek svn_string_t, data)+peekData = #peek svn_string_t, data pokeLen :: Ptr SVN_STRING_T -> APR_SIZE_T -> IO ()-pokeLen = (#poke svn_string_t, len)+pokeLen = #poke svn_string_t, len peekLen :: Ptr SVN_STRING_T -> IO APR_SIZE_T-peekLen = (#peek svn_string_t, len)+peekLen = #peek svn_string_t, len withSvnString :: Strict.ByteString -> (Ptr SVN_STRING_T -> IO a) -> IO a@@ -63,4 +63,4 @@ | obj == nullPtr = return Nothing | otherwise- = peekSvnString obj >>= return . Just+ = fmap Just (peekSvnString obj)
Subversion/Types.hsc view
@@ -51,8 +51,8 @@ marshalBool :: Bool -> SVN_BOOLEAN_T-marshalBool True = (#const TRUE )-marshalBool False = (#const FALSE)+marshalBool True = #const TRUE+marshalBool False = #const FALSE unmarshalBool :: SVN_BOOLEAN_T -> Bool unmarshalBool (#const TRUE ) = True@@ -96,13 +96,13 @@ peekVerMajor :: Ptr SVN_VERSION_T -> IO Int-peekVerMajor = (#peek svn_version_t, major)+peekVerMajor = #peek svn_version_t, major peekVerMinor :: Ptr SVN_VERSION_T -> IO Int-peekVerMinor = (#peek svn_version_t, minor)+peekVerMinor = #peek svn_version_t, minor peekVerPatch :: Ptr SVN_VERSION_T -> IO Int-peekVerPatch = (#peek svn_version_t, patch)+peekVerPatch = #peek svn_version_t, patch peekVerTag :: Ptr SVN_VERSION_T -> IO CString-peekVerTag = (#peek svn_version_t, tag)+peekVerTag = #peek svn_version_t, tag