[arch-commits] Commit in haskell-knob/repos (3 files)

Felix Yan felixonmars at gemini.archlinux.org
Sun Nov 28 23:00:47 UTC 2021


    Date: Sunday, November 28, 2021 @ 23:00:47
  Author: felixonmars
Revision: 1055777

archrelease: copy trunk to community-staging-x86_64

Added:
  haskell-knob/repos/community-staging-x86_64/
  haskell-knob/repos/community-staging-x86_64/PKGBUILD
    (from rev 1055776, haskell-knob/trunk/PKGBUILD)
  haskell-knob/repos/community-staging-x86_64/base4.15.patch
    (from rev 1055776, haskell-knob/trunk/base4.15.patch)

----------------+
 PKGBUILD       |   49 +++++
 base4.15.patch |  496 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 545 insertions(+)

Copied: haskell-knob/repos/community-staging-x86_64/PKGBUILD (from rev 1055776, haskell-knob/trunk/PKGBUILD)
===================================================================
--- community-staging-x86_64/PKGBUILD	                        (rev 0)
+++ community-staging-x86_64/PKGBUILD	2021-11-28 23:00:47 UTC (rev 1055777)
@@ -0,0 +1,49 @@
+# Maintainer: Felix Yan <felixonmars at archlinux.org>
+# Contributor: Arch Haskell Team <arch-haskell at haskell.org>
+
+_hkgname=knob
+pkgname=haskell-knob
+pkgver=0.1.1
+pkgrel=40
+pkgdesc="Memory-backed handles"
+url="https://github.com/felixonmars/knob"
+license=("MIT")
+arch=('x86_64')
+depends=('ghc-libs')
+makedepends=('ghc' 'haskell-chell')
+source=("https://hackage.haskell.org/packages/archive/${_hkgname}/${pkgver}/${_hkgname}-${pkgver}.tar.gz"
+        base4.15.patch)
+sha512sums=('b13e9a88de99fa941521135c7f61be4ad5b838806e7424ac4b38607d59635ec2ddd6808560f1568f6d974c531185d43b5e1510886e07bcb567b859a12659277b'
+            '80b0f41c2e874fc004908afae26bea0fdd83094460e22a26ec4617f6adcfbe3671da16e2c59ef32b90c75414ddcd3ac3b667667e151be7b7f5c0fefd07851ba4')
+
+prepare() {
+    patch -d $_hkgname-$pkgver -p1 < base4.15.patch
+}
+
+build() {
+    cd $_hkgname-$pkgver
+
+    runhaskell Setup configure -O --enable-shared --enable-executable-dynamic --disable-library-vanilla \
+        --prefix=/usr --docdir=/usr/share/doc/$pkgname --enable-tests \
+        --dynlibdir=/usr/lib --libsubdir=\$compiler/site-local/\$pkgid --ghc-option=-fllvm
+    runhaskell Setup build $MAKEFLAGS
+    runhaskell Setup register --gen-script
+    runhaskell Setup unregister --gen-script
+    sed -i -r -e "s|ghc-pkg.*update[^ ]* |&'--force' |" register.sh
+    sed -i -r -e "s|ghc-pkg.*unregister[^ ]* |&'--force' |" unregister.sh
+}
+
+check() {
+    cd $_hkgname-$pkgver
+    runhaskell Setup test --show-details=direct
+}
+
+package() {
+    cd $_hkgname-$pkgver
+
+    install -D -m744 register.sh "$pkgdir"/usr/share/haskell/register/$pkgname.sh
+    install -D -m744 unregister.sh "$pkgdir"/usr/share/haskell/unregister/$pkgname.sh
+    runhaskell Setup copy --destdir="$pkgdir"
+    install -D -m644 "license.txt" "${pkgdir}/usr/share/licenses/${pkgname}/license.txt"
+    rm -f "${pkgdir}/usr/share/doc/${pkgname}/license.txt"
+}

Copied: haskell-knob/repos/community-staging-x86_64/base4.15.patch (from rev 1055776, haskell-knob/trunk/base4.15.patch)
===================================================================
--- community-staging-x86_64/base4.15.patch	                        (rev 0)
+++ community-staging-x86_64/base4.15.patch	2021-11-28 23:00:47 UTC (rev 1055777)
@@ -0,0 +1,496 @@
+From ded495e7815d398c33a2a901d146f73bde60b7a9 Mon Sep 17 00:00:00 2001
+From: Felix Yan <felixonmars at archlinux.org>
+Date: Fri, 18 Jun 2021 05:14:00 +0800
+Subject: [PATCH] Port tests to chell-0.3+ and make it a test-suite of knob
+
+---
+ knob.cabal             | 21 ++++++++++++-
+ tests/KnobTests.hs     | 70 +++++++++++++++++++-----------------------
+ tests/knob-tests.cabal | 22 -------------
+ 3 files changed, 52 insertions(+), 61 deletions(-)
+ delete mode 100644 tests/knob-tests.cabal
+
+diff --git a/knob.cabal b/knob.cabal
+index 85d4e10..246b185 100644
+--- a/knob.cabal
++++ b/knob.cabal
+@@ -5,7 +5,7 @@ license-file: license.txt
+ author: John Millikin <jmillikin at gmail.com>
+ maintainer: John Millikin <jmillikin at gmail.com>
+ build-type: Simple
+-cabal-version: >= 1.6
++cabal-version: >= 1.8
+ category: System
+ stability: experimental
+ homepage: https://john-millikin.com/software/knob/
+@@ -46,6 +46,10 @@ source-repository this
+   location: https://john-millikin.com/branches/knob/0.1/
+   tag: knob_0.1.1
+ 
++flag coverage
++  default: False
++  manual: True
++
+ library
+   hs-source-dirs: lib
+   ghc-options: -Wall -O2
+@@ -57,3 +61,18 @@ library
+ 
+   exposed-modules:
+     Data.Knob
++
++test-suite knob_tests
++  type: exitcode-stdio-1.0
++  main-is: tests/KnobTests.hs
++  ghc-options: -Wall
++
++  if flag(coverage)
++    ghc-options: -fhpc
++
++  build-depends:
++      base >= 4.2 && < 5.0
++    , bytestring >= 0.9 && < 0.11
++    , chell >= 0.2 && < 0.6
++    , transformers >= 0.2 && < 0.6
++    , knob
+diff --git a/tests/KnobTests.hs b/tests/KnobTests.hs
+index f5a06d4..b8e4d61 100644
+--- a/tests/KnobTests.hs
++++ b/tests/KnobTests.hs
+@@ -21,45 +21,42 @@ import           Test.Chell
+ import           Data.Knob
+ 
+ main :: IO ()
+-main = Test.Chell.defaultMain tests
++main = Test.Chell.defaultMain [tests]
+ 
+-tests :: [Suite]
+-tests = [test_File, test_Duplex]
+-
+-test_File :: Suite
+-test_File = suite "file"
+-	[ suite "read"
++tests :: Suite
++tests = suite "tests" $
++	suiteTests (suite "read"
+ 		[ test_ReadFromStart
+ 		, test_ReadFromOffset
+ 		, test_ReadToEOF
+ 		, test_ReadPastEOF
+-		]
+-	, suite "write"
++		]) ++
++	suiteTests (suite "write"
+ 		[ test_WriteFromStart
+ 		, test_WriteFromOffset
+ 		, test_WritePastEOF
+ 		, test_WriteAppended
+-		]
+-	, suite "seek"
++		]) ++
++	suiteTests (suite "seek"
+ 		[ test_SeekAbsolute
+ 		, test_SeekRelative
+ 		, test_SeekFromEnd
+ 		, test_SeekBeyondMaxInt
+-		]
+-	, suite "setSize"
++		]) ++
++	suiteTests (suite "setSize"
+ 		[ test_SetSize_Read
+ 		, test_SetSize_Write
+ 		, test_SetSize_ReadWrite
+ 		, test_SetSize_Append
+-		]
++		]) ++
+ 	
+-	, test_Ready
++	[ test_Ready
+ 	, test_Close
+ 	, test_SetContents
+ 	, test_WithFileHandle
+ 	]
+ 
+-test_ReadFromStart :: Suite
++test_ReadFromStart :: Test
+ test_ReadFromStart = assertions "from-start" $ do
+ 	k <- newKnob "abcde"
+ 	h <- newFileHandle k "foo.txt" ReadMode
+@@ -70,7 +67,7 @@ test_ReadFromStart = assertions "from-start" $ do
+ 	off <- liftIO $ hTell h
+ 	$expect (equal off 3)
+ 
+-test_ReadFromOffset :: Suite
++test_ReadFromOffset :: Test
+ test_ReadFromOffset = assertions "from-offset" $ do
+ 	k <- newKnob "abcde"
+ 	h <- newFileHandle k "foo.txt" ReadMode
+@@ -82,7 +79,7 @@ test_ReadFromOffset = assertions "from-offset" $ do
+ 	off <- liftIO $ hTell h
+ 	$expect (equal off 4)
+ 
+-test_ReadToEOF :: Suite
++test_ReadToEOF :: Test
+ test_ReadToEOF = assertions "to-eof" $ do
+ 	k <- newKnob "abcde"
+ 	h <- newFileHandle k "foo.txt" ReadMode
+@@ -93,7 +90,7 @@ test_ReadToEOF = assertions "to-eof" $ do
+ 	off <- liftIO $ hTell h
+ 	$expect (equal off 5)
+ 
+-test_ReadPastEOF :: Suite
++test_ReadPastEOF :: Test
+ test_ReadPastEOF = assertions "past-eof" $ do
+ 	k <- newKnob "abcde"
+ 	h <- newFileHandle k "foo.txt" ReadMode
+@@ -105,7 +102,7 @@ test_ReadPastEOF = assertions "past-eof" $ do
+ 	off <- liftIO $ hTell h
+ 	$expect (equal off 10)
+ 
+-test_WriteFromStart :: Suite
++test_WriteFromStart :: Test
+ test_WriteFromStart = assertions "from-start" $ do
+ 	k <- newKnob ""
+ 	h <- newFileHandle k "foo.txt" WriteMode
+@@ -115,7 +112,7 @@ test_WriteFromStart = assertions "from-start" $ do
+ 	bytes <- Data.Knob.getContents k
+ 	$expect (equal bytes "abcde")
+ 
+-test_WriteFromOffset :: Suite
++test_WriteFromOffset :: Test
+ test_WriteFromOffset = assertions "from-offset" $ do
+ 	k <- newKnob ""
+ 	h <- newFileHandle k "foo.txt" WriteMode
+@@ -128,7 +125,7 @@ test_WriteFromOffset = assertions "from-offset" $ do
+ 	bytes <- Data.Knob.getContents k
+ 	$expect (equal bytes "ababcde")
+ 
+-test_WritePastEOF :: Suite
++test_WritePastEOF :: Test
+ test_WritePastEOF = assertions "past-eof" $ do
+ 	k <- newKnob ""
+ 	h <- newFileHandle k "foo.txt" WriteMode
+@@ -139,7 +136,7 @@ test_WritePastEOF = assertions "past-eof" $ do
+ 	bytes <- Data.Knob.getContents k
+ 	$expect (equal bytes "\0\0abcde")
+ 
+-test_WriteAppended :: Suite
++test_WriteAppended :: Test
+ test_WriteAppended = assertions "appended" $ do
+ 	k <- newKnob "foo"
+ 	h <- newFileHandle k "foo.txt" AppendMode
+@@ -149,7 +146,7 @@ test_WriteAppended = assertions "appended" $ do
+ 	bytes <- Data.Knob.getContents k
+ 	$expect (equal bytes "foobar")
+ 
+-test_SeekAbsolute :: Suite
++test_SeekAbsolute :: Test
+ test_SeekAbsolute = assertions "absolute" $ do
+ 	k <- newKnob ""
+ 	h <- newFileHandle k "foo.txt" ReadMode
+@@ -161,7 +158,7 @@ test_SeekAbsolute = assertions "absolute" $ do
+ 	$expect (equal before 0)
+ 	$expect (equal after 2)
+ 
+-test_SeekRelative :: Suite
++test_SeekRelative :: Test
+ test_SeekRelative = assertions "relative" $ do
+ 	k <- newKnob ""
+ 	h <- newFileHandle k "foo.txt" ReadMode
+@@ -176,7 +173,7 @@ test_SeekRelative = assertions "relative" $ do
+ 	$expect (equal after1 2)
+ 	$expect (equal after2 4)
+ 
+-test_SeekFromEnd :: Suite
++test_SeekFromEnd :: Test
+ test_SeekFromEnd = assertions "from-end" $ do
+ 	k <- newKnob "abcde"
+ 	h <- newFileHandle k "foo.txt" ReadMode
+@@ -188,7 +185,7 @@ test_SeekFromEnd = assertions "from-end" $ do
+ 	$expect (equal before 0)
+ 	$expect (equal after 3)
+ 
+-test_SeekBeyondMaxInt :: Suite
++test_SeekBeyondMaxInt :: Test
+ test_SeekBeyondMaxInt = assertions "beyond-max-int" $ do
+ 	k <- newKnob "abcde"
+ 	h <- newFileHandle k "foo.txt" ReadMode
+@@ -212,7 +209,7 @@ test_SeekBeyondMaxInt = assertions "beyond-max-int" $ do
+ 		(GHC.IOError (Just h) GHC.InvalidArgument "hSeek" "offset > (maxBound :: Int)" Nothing (Just "foo.txt"))
+ 		(hSeek h SeekFromEnd 2)
+ 
+-test_Ready :: Suite
++test_Ready :: Test
+ test_Ready = assertions "ready" $ do
+ 	k <- newKnob "abcde"
+ 	h <- newFileHandle k "foo.txt" ReadMode
+@@ -225,7 +222,7 @@ test_Ready = assertions "ready" $ do
+ 		(GHC.IOError (Just h) GHC.EOF "hWaitForInput" "" Nothing (Just "foo.txt"))
+ 		(hReady h)
+ 
+-test_Close :: Suite
++test_Close :: Test
+ test_Close = assertions "close" $ do
+ 	k <- newKnob "abcde"
+ 	h <- newFileHandle k "foo.txt" ReadMode
+@@ -238,7 +235,7 @@ test_Close = assertions "close" $ do
+ 		(GHC.IOError (Just h) GHC.IllegalOperation "hWaitForInput" "handle is closed" Nothing (Just "foo.txt"))
+ 		(hReady h)
+ 
+-test_SetSize_Read :: Suite
++test_SetSize_Read :: Test
+ test_SetSize_Read = assertions "ReadMode" $ do
+ 	k <- newKnob "abcde"
+ 	h <- newFileHandle k "foo.txt" ReadMode
+@@ -252,7 +249,7 @@ test_SetSize_Read = assertions "ReadMode" $ do
+ 		(GHC.IOError (Just h) GHC.IllegalOperation "hSetFileSize" "handle in ReadMode" Nothing (Just "foo.txt"))
+ 		(hSetFileSize h 2)
+ 
+-test_SetSize_Write :: Suite
++test_SetSize_Write :: Test
+ test_SetSize_Write = assertions "WriteMode" $ do
+ 	k <- newKnob "abcde"
+ 	h <- newFileHandle k "foo.txt" WriteMode
+@@ -269,7 +266,7 @@ test_SetSize_Write = assertions "WriteMode" $ do
+ 	bytes <- Data.Knob.getContents k
+ 	$expect (equal bytes "\0\0\0\0")
+ 
+-test_SetSize_ReadWrite :: Suite
++test_SetSize_ReadWrite :: Test
+ test_SetSize_ReadWrite = assertions "ReadWriteMode" $ do
+ 	k <- newKnob "abcde"
+ 	h <- newFileHandle k "foo.txt" ReadWriteMode
+@@ -291,7 +288,7 @@ test_SetSize_ReadWrite = assertions "ReadWriteMode" $ do
+ 		bytes <- Data.Knob.getContents k
+ 		$expect (equal bytes "abcd\0\0")
+ 
+-test_SetSize_Append :: Suite
++test_SetSize_Append :: Test
+ test_SetSize_Append = assertions "AppendMode" $ do
+ 	k <- newKnob "abcde"
+ 	h <- newFileHandle k "foo.txt" AppendMode
+@@ -311,7 +308,7 @@ test_SetSize_Append = assertions "AppendMode" $ do
+ 		bytes <- Data.Knob.getContents k
+ 		$expect (equal bytes "abcd\0\0")
+ 
+-test_SetContents :: Suite
++test_SetContents :: Test
+ test_SetContents = assertions "setContents" $ do
+ 	k <- newKnob "abcde"
+ 	before <- Data.Knob.getContents k
+@@ -321,7 +318,7 @@ test_SetContents = assertions "setContents" $ do
+ 	$expect (equal before "abcde")
+ 	$expect (equal after "foo")
+ 
+-test_WithFileHandle :: Suite
++test_WithFileHandle :: Test
+ test_WithFileHandle = assertions "withFileHandle" $ do
+ 	k <- newKnob ""
+ 	h <- withFileHandle k "test.txt" WriteMode $ \h -> do
+@@ -333,6 +330,3 @@ test_WithFileHandle = assertions "withFileHandle" $ do
+ 	
+ 	closed <- liftIO $ hIsClosed h
+ 	$expect closed
+-
+-test_Duplex :: Suite
+-test_Duplex = suite "duplex" []
+diff --git a/tests/knob-tests.cabal b/tests/knob-tests.cabal
+deleted file mode 100644
+index 6530abe..0000000
+--- a/tests/knob-tests.cabal
++++ /dev/null
+@@ -1,22 +0,0 @@
+-name: knob-tests
+-version: 0
+-build-type: Simple
+-cabal-version: >= 1.6
+-
+-flag coverage
+-  default: False
+-  manual: True
+-
+-executable knob_tests
+-  main-is: KnobTests.hs
+-  ghc-options: -Wall
+-  hs-source-dirs: ../lib,.
+-
+-  if flag(coverage)
+-    ghc-options: -fhpc
+-
+-  build-depends:
+-      base >= 4.2 && < 5.0
+-    , bytestring >= 0.9 && < 0.10
+-    , chell >= 0.2 && < 0.3
+-    , transformers >= 0.2 && < 0.3
+-- 
+2.32.0
+
+
+From 70143ee43cc3654d28774a40aed6e5a9b72a2eff Mon Sep 17 00:00:00 2001
+From: Felix Yan <felixonmars at archlinux.org>
+Date: Fri, 18 Jun 2021 05:54:26 +0800
+Subject: [PATCH] Very basic attempt to fix build with base-4.15
+
+---
+ knob.cabal       |  4 ++--
+ lib/Data/Knob.hs | 16 +++++++++++-----
+ 2 files changed, 13 insertions(+), 7 deletions(-)
+
+diff --git a/knob.cabal b/knob.cabal
+index 246b185..c76cf07 100644
+--- a/knob.cabal
++++ b/knob.cabal
+@@ -55,7 +55,7 @@ library
+   ghc-options: -Wall -O2
+ 
+   build-depends:
+-      base >= 4.2 && < 5.0
++      base >= 4.15 && < 5.0
+     , bytestring >= 0.9
+     , transformers >= 0.2
+ 
+@@ -71,7 +71,7 @@ test-suite knob_tests
+     ghc-options: -fhpc
+ 
+   build-depends:
+-      base >= 4.2 && < 5.0
++      base >= 4.15 && < 5.0
+     , bytestring >= 0.9 && < 0.11
+     , chell >= 0.2 && < 0.6
+     , transformers >= 0.2 && < 0.6
+diff --git a/lib/Data/Knob.hs b/lib/Data/Knob.hs
+index fa87ad2..a699c5e 100644
+--- a/lib/Data/Knob.hs
++++ b/lib/Data/Knob.hs
+@@ -60,6 +60,12 @@ newtype Knob = Knob (MVar.MVar ByteString)
+ data Device = Device IO.IOMode (MVar.MVar ByteString) (MVar.MVar Int)
+ 	deriving (Typeable)
+ 
++instance IO.RawIO Device where
++	read _ _ _ _ = return 0
++	readNonBlocking _ _ _ _ = return Nothing
++	write _ _ _ _ = return ()
++	writeNonBlocking _ _ _ _ = return 0
++
+ instance IO.IODevice Device where
+ 	ready _ _ _ = return True
+ 	close _ = return ()
+@@ -68,20 +74,20 @@ instance IO.IODevice Device where
+ 	
+ 	seek (Device _ _ var) IO.AbsoluteSeek off = do
+ 		checkOffset off
+-		MVar.modifyMVar_ var (\_ -> return (fromInteger off))
++		MVar.modifyMVar var (\_ -> return ((fromInteger off), off))
+ 	
+ 	seek (Device _ _ var) IO.RelativeSeek off = do
+-		MVar.modifyMVar_ var (\old_off -> do
++		MVar.modifyMVar var (\old_off -> do
+ 			let new_off = toInteger old_off + off
+ 			checkOffset new_off
+-			return (fromInteger new_off))
++			return ((fromInteger new_off), new_off))
+ 	
+ 	seek dev@(Device _ _ off_var) IO.SeekFromEnd off = do
+-		MVar.modifyMVar_ off_var (\_ -> do
++		MVar.modifyMVar off_var (\_ -> do
+ 			size <- IO.getSize dev
+ 			let new_off = size + off
+ 			checkOffset new_off
+-			return (fromInteger new_off))
++			return ((fromInteger new_off), new_off))
+ 	
+ 	tell (Device _ _ var) = fmap toInteger (MVar.readMVar var)
+ 	getSize (Device _ var _) = do
+-- 
+2.32.0
+
+
+From e2ecfb3fc99abec39eff98f6dfe152a18a4bc35f Mon Sep 17 00:00:00 2001
+From: Liu Xiaoyi <circuitcoder0 at gmail.com>
+Date: Fri, 18 Jun 2021 06:22:09 +0800
+Subject: [PATCH] RawIO implmentation for the base-4.15 update
+
+---
+ lib/Data/Knob.hs | 41 ++++++++++++++++++++++++++++++++---------
+ 1 file changed, 32 insertions(+), 9 deletions(-)
+
+diff --git a/lib/Data/Knob.hs b/lib/Data/Knob.hs
+index a699c5e..77009b2 100644
+--- a/lib/Data/Knob.hs
++++ b/lib/Data/Knob.hs
+@@ -60,12 +60,6 @@ newtype Knob = Knob (MVar.MVar ByteString)
+ data Device = Device IO.IOMode (MVar.MVar ByteString) (MVar.MVar Int)
+ 	deriving (Typeable)
+ 
+-instance IO.RawIO Device where
+-	read _ _ _ _ = return 0
+-	readNonBlocking _ _ _ _ = return Nothing
+-	write _ _ _ _ = return ()
+-	writeNonBlocking _ _ _ _ = return 0
+-
+ instance IO.IODevice Device where
+ 	ready _ _ _ = return True
+ 	close _ = return ()
+@@ -74,20 +68,20 @@ instance IO.IODevice Device where
+ 	
+ 	seek (Device _ _ var) IO.AbsoluteSeek off = do
+ 		checkOffset off
+-		MVar.modifyMVar var (\_ -> return ((fromInteger off), off))
++		MVar.modifyMVar var (\_ -> return (fromInteger off, off))
+ 	
+ 	seek (Device _ _ var) IO.RelativeSeek off = do
+ 		MVar.modifyMVar var (\old_off -> do
+ 			let new_off = toInteger old_off + off
+ 			checkOffset new_off
+-			return ((fromInteger new_off), new_off))
++			return (fromInteger new_off, new_off))
+ 	
+ 	seek dev@(Device _ _ off_var) IO.SeekFromEnd off = do
+ 		MVar.modifyMVar off_var (\_ -> do
+ 			size <- IO.getSize dev
+ 			let new_off = size + off
+ 			checkOffset new_off
+-			return ((fromInteger new_off), new_off))
++			return (fromInteger new_off, new_off))
+ 	
+ 	tell (Device _ _ var) = fmap toInteger (MVar.readMVar var)
+ 	getSize (Device _ var _) = do
+@@ -118,6 +112,35 @@ setDeviceSize (Device mode bytes_var _) size = checkSize >> setBytes where
+ 		padLen | padLen > 0 -> Data.ByteString.append bytes (Data.ByteString.replicate padLen 0)
+ 		_ -> Data.ByteString.take intSize bytes
+ 
++{- What about non-POSIX environment? -}
++instance IO.RawIO Device where
++	read (Device _ bytes_var pos_var) ptr _ bufSize = do
++		MVar.withMVar bytes_var $ \bytes -> do
++			MVar.modifyMVar pos_var $ \pos -> do
++				if pos >= Data.ByteString.length bytes
++					then return (pos, 0)
++					else do
++						let chunk = Data.ByteString.take bufSize (Data.ByteString.drop pos bytes)
++						unsafeUseAsCStringLen chunk $ \(chunkPtr, chunkLen) -> do
++							Foreign.copyArray ptr (Foreign.castPtr chunkPtr) chunkLen
++							return (pos + chunkLen, chunkLen)
++
++	write (Device _ bytes_var pos_var) ptr _ bufSize = do
++		MVar.modifyMVar_ bytes_var $ \bytes -> do
++			MVar.modifyMVar pos_var $ \pos -> do
++				let (before, after) = Data.ByteString.splitAt pos bytes
++				let padding = Data.ByteString.replicate (pos - Data.ByteString.length before) 0
++
++				bufBytes <- Data.ByteString.packCStringLen (Foreign.castPtr ptr, bufSize)
++				let newBytes = Data.ByteString.concat [before, padding, bufBytes, Data.ByteString.drop bufSize after]
++				return (pos + bufSize, newBytes)
++		return ()
++
++	readNonBlocking dev buf off size = IO.read dev buf off size >>= \cnt -> if cnt == 0
++		then return Nothing
++		else return $ Just cnt
++	writeNonBlocking dev buf off cnt = IO.write dev buf off cnt >> return cnt
++
+ instance IO.BufferedIO Device where
+ 	newBuffer _ = IO.newByteBuffer 4096
+ 	
+-- 
+2.32.0
+



More information about the arch-commits mailing list