HsSVN 0.3.1 → 0.3.2

raw patch · 4 files changed

+56/−21 lines, 4 files

Files

• HsSVN.cabal +1/−1
• NEWS +6/−0
• Subversion/Stream/Pipe.hs +48/−19
• examples/Makefile +1/−1

@@ -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.3.1+Version:       0.3.2 License:       PublicDomain License-File:  COPYING Author:        PHO <pho at cielonegro dot org>

@@ -1,3 +1,9 @@+Changes from 0.3.1 to 0.3.2+---------------------------+* Subversion.Repository:+  - Fixed dumpRepository bug again... Hopefully it works now.++ Changes from 0.3 to 0.3.1 ------------------------- * Subversion.Repository:

@@ -1,28 +1,37 @@ module Subversion.Stream.Pipe-    ( newPipe +    ( newPipe     )     where +import           Control.Concurrent import           Control.Concurrent.STM+import           Control.Monad import qualified Data.ByteString      as Strict import qualified Data.ByteString.Lazy as Lazy+import           Data.Int import           Subversion.Stream   data Pipe     = Pipe {-        pWrittenStr  :: TVar Lazy.ByteString -- 書き込まれたが、未だ讀込まれてゐない文字列-      , pIsClosed    :: TVar Bool            -- パイプが閉ぢられた+        pRequestLen :: TVar Int             -- 要求された殘りバイト數+      , pWrittenStr :: TVar Lazy.ByteString -- 書き込まれたが、未だ讀込まれてゐない文字列+      , pIsClosed   :: TVar Bool            -- パイプが閉ぢられた       }   newPipe :: IO Stream-newPipe = do str <- newTVarIO Lazy.empty+newPipe = do unless rtsSupportsBoundThreads+                 $ fail "Subversion.Stream.Pipe.newPipe requires threaded RTS!"++             req <- newTVarIO 0+             str <- newTVarIO Lazy.empty              isC <- newTVarIO False                            let pipe    = Pipe {-                             pWrittenStr  = str-                           , pIsClosed    = isC+                             pRequestLen = req+                           , pWrittenStr = str+                           , pIsClosed   = isC                            }                  actions = StreamActions {                              saRead  = mkReadAction  pipe@@ -54,7 +63,12 @@                           do writeTVar (pWrittenStr pipe) Lazy.empty                              return (return (Strict.concat (Lazy.toChunks str)))                         else-                          retry+                          do oldReqLen <- readTVar (pRequestLen pipe)+                             if oldReqLen < reqLen then+                                 do writeTVar (pRequestLen pipe) reqLen+                                    return loop+                               else+                                 retry                  else                    -- reqLen バイトを上限としてバッファの頭を切り取る。                    do let (readStr, remaining) = Lazy.splitAt (fromIntegral reqLen) str@@ -63,18 +77,33 @@   mkWriteAction :: Pipe -> WriteAction-mkWriteAction pipe str-    = atomically $-      do let inputLen = Strict.length str-         isClosed <- readTVar (pIsClosed pipe)-         if isClosed then-             -- パイプが閉ぢられてゐたら書込まれた文字列を捨てる-             -- FIXME: 本當にそれで良いのか？-             return ()-           else-             do writtenStr <- readTVar (pWrittenStr pipe)-                writeTVar (pWrittenStr pipe) (writtenStr `Lazy.append` (Lazy.fromChunks [str]))-         return inputLen+mkWriteAction pipe input = loop input >> return (Strict.length input)+    where+      loop :: Strict.ByteString -> IO ()+      loop str = do nextAction <- tryToWrite str+                    nextAction++      tryToWrite :: Strict.ByteString -> IO (IO ())+      tryToWrite str+          = atomically $+            do isClosed <- readTVar (pIsClosed pipe)+               if isClosed then+                   -- パイプが閉ぢられてゐたら書込まれた文字列を捨てる+                   -- FIXME: 本當にそれで良いのか？+                   return (return ())+                 else+                   do reqLen <- readTVar (pRequestLen pipe)+                      let (strToWrite, remaining) = Strict.splitAt reqLen str+                      if Strict.null strToWrite then+                          if Strict.null remaining then+                              return (return ())+                          else+                              retry+                        else+                          do writtenStr <- readTVar (pWrittenStr pipe)+                             writeTVar (pWrittenStr pipe) (writtenStr `Lazy.append` (Lazy.fromChunks [strToWrite]))+                             writeTVar (pRequestLen pipe) (reqLen - Strict.length strToWrite)+                             return (loop remaining)   mkCloseAction :: Pipe -> CloseAction

@@ -1,7 +1,7 @@ GHCFLAGS = -fglasgow-exts  build:-	ghc $(GHCFLAGS) --make HelloWorld+	ghc $(GHCFLAGS) --make HelloWorld -threaded  run: build 	./HelloWorld