knob 0.1.1 → 0.2.2
raw patch · 4 files changed
Files
- knob.cabal +13/−16
- lib/Data/Knob.hs +149/−109
- tests/KnobTests.hs +273/−273
- tests/knob-tests.cabal +6/−5
knob.cabal view
@@ -1,15 +1,16 @@+cabal-version: 2.4 name: knob-version: 0.1.1+version: 0.2.2 license: MIT license-file: license.txt author: John Millikin <jmillikin@gmail.com>-maintainer: John Millikin <jmillikin@gmail.com>+maintainer: Naïm Favier <n@monade.li> build-type: Simple-cabal-version: >= 1.6+tested-with: GHC == 9.0.2, GHC == 9.2.1 category: System stability: experimental-homepage: https://john-millikin.com/software/knob/-bug-reports: mailto:jmillikin@gmail.com+homepage: https://github.com/ncfavier/knob+bug-reports: https://github.com/ncfavier/knob/issues synopsis: Memory-backed handles description:@@ -38,22 +39,18 @@ tests/KnobTests.hs source-repository head- type: bazaar- location: https://john-millikin.com/software/knob/--source-repository this- type: bazaar- location: https://john-millikin.com/branches/knob/0.1/- tag: knob_0.1.1+ type: git+ location: https://github.com/ncfavier/knob library+ default-language: Haskell2010 hs-source-dirs: lib- ghc-options: -Wall -O2+ ghc-options: -Wall build-depends:- base >= 4.2 && < 5.0- , bytestring >= 0.9- , transformers >= 0.2+ base >= 4.15 && < 5+ , bytestring >= 0.9 && < 0.12+ , transformers >= 0.2 && < 0.7 exposed-modules: Data.Knob
lib/Data/Knob.hs view
@@ -5,11 +5,11 @@ -- Copyright: 2011 John Millikin -- License: MIT ----- Maintainer: jmillikin@gmail.com+-- Maintainer: n@monade.li -- Portability: GHC only ----- Create memory‐backed 'IO.Handle's, referencing virtual files. This is--- mostly useful for testing 'IO.Handle'‐based APIs without having to+-- Create memory-backed 'IO.Handle's, referencing virtual files. This is+-- mostly useful for testing 'IO.Handle'-based APIs without having to -- interact with the filesystem. -- -- > import Data.ByteString (pack)@@ -24,15 +24,18 @@ -- > bytes <- Data.Knob.getContents knob -- > putStrLn ("Wrote bytes: " ++ show bytes) module Data.Knob- ( Knob- , newKnob- , Data.Knob.getContents- , setContents- - , newFileHandle- , withFileHandle- ) where+ ( Knob+ , newKnob+ , Data.Knob.getContents+ , setContents + , newFileHandle+ , withFileHandle++ , Device+ , newDevice+ ) where+ import qualified Control.Concurrent.MVar as MVar import Control.Exception (bracket, throwIO) import Control.Monad (when)@@ -48,111 +51,24 @@ import qualified GHC.IO.Exception as IO import qualified GHC.IO.Handle as IO import qualified System.IO as IO+import Data.Maybe (fromMaybe) -- | A knob is a basic virtual file, which contains a byte buffer. A knob can -- have multiple 'IO.Handle's open to it, each of which behaves like a standard -- file handle. ----- Use 'getContents' and 'setContents' to inspect and modify the knob’s+-- Use 'Data.Knob.getContents' and 'setContents' to inspect and modify the knob's -- byte buffer. newtype Knob = Knob (MVar.MVar ByteString) -data Device = Device IO.IOMode (MVar.MVar ByteString) (MVar.MVar Int)- deriving (Typeable)--instance IO.IODevice Device where- ready _ _ _ = return True- close _ = return ()- isTerminal _ = return False- isSeekable _ = return True- - seek (Device _ _ var) IO.AbsoluteSeek off = do- checkOffset off- MVar.modifyMVar_ var (\_ -> return (fromInteger 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))- - 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))- - tell (Device _ _ var) = fmap toInteger (MVar.readMVar var)- getSize (Device _ var _) = do- bytes <- MVar.readMVar var- return (toInteger (Data.ByteString.length bytes))- setSize dev size = setDeviceSize dev size- devType _ = return IO.RegularFile- checkOffset :: Integer -> IO () checkOffset off = when (toInteger (maxBound :: Int) < off) (throwIO err) where- err = IO.IOError Nothing IO.InvalidArgument "" "offset > (maxBound :: Int)" Nothing Nothing--setDeviceSize :: Device -> Integer -> IO ()-setDeviceSize (Device mode bytes_var _) size = checkSize >> setBytes where- intSize :: Int- intSize = fromInteger size- - checkSize = when (size > toInteger (maxBound :: Int)) $ do- throwIO (IO.IOError Nothing IO.InvalidArgument "" "size > (maxBound :: Int)" Nothing Nothing)- - setBytes = MVar.modifyMVar_ bytes_var $ \bytes -> case mode of- IO.ReadMode -> throwIO (IO.IOError Nothing IO.IllegalOperation "" "handle in ReadMode" Nothing Nothing)- IO.WriteMode -> return (Data.ByteString.replicate intSize 0)- IO.ReadWriteMode -> return (clip bytes)- IO.AppendMode -> return (clip bytes)- - clip bytes = case intSize - Data.ByteString.length bytes of- padLen | padLen > 0 -> Data.ByteString.append bytes (Data.ByteString.replicate padLen 0)- _ -> Data.ByteString.take intSize bytes--instance IO.BufferedIO Device where- newBuffer _ = IO.newByteBuffer 4096- - fillReadBuffer dev buf = do- (numRead, newBuf) <- IO.fillReadBuffer0 dev buf- return (maybe 0 id numRead, newBuf)- - fillReadBuffer0 (Device _ bytes_var pos_var) buf = do- MVar.withMVar bytes_var $ \bytes -> do- MVar.modifyMVar pos_var $ \pos -> do- if pos >= Data.ByteString.length bytes- then return (pos, (Nothing, buf))- else do- let chunk = Data.ByteString.take (IO.bufSize buf) (Data.ByteString.drop pos bytes)- unsafeUseAsCStringLen chunk $ \(chunkPtr, chunkLen) -> do- Foreign.withForeignPtr (IO.bufRaw buf) $ \ptr -> do- Foreign.copyArray ptr (Foreign.castPtr chunkPtr) chunkLen- return (pos + chunkLen, (Just chunkLen, (buf { IO.bufL = 0, IO.bufR = chunkLen })))- - flushWriteBuffer (Device _ bytes_var pos_var) buf = 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- - let bufStart ptr = Foreign.castPtr (Foreign.plusPtr ptr (IO.bufL buf))- let bufLen = IO.bufR buf - IO.bufL buf- bufBytes <- Foreign.withForeignPtr (IO.bufRaw buf) (\ptr ->- Data.ByteString.packCStringLen (bufStart ptr, bufLen))- let newBytes = Data.ByteString.concat [before, padding, bufBytes, Data.ByteString.drop bufLen after]- return (pos + bufLen, newBytes)- return (buf { IO.bufL = 0, IO.bufR = 0 })- - flushWriteBuffer0 dev buf = do- newBuf <- IO.flushWriteBuffer dev buf- return (IO.bufR buf - IO.bufL buf, newBuf)+ err = IO.IOError Nothing IO.InvalidArgument "" "offset > (maxBound :: Int)" Nothing Nothing newKnob :: MonadIO m => ByteString -> m Knob newKnob bytes = do- var <- liftIO (MVar.newMVar bytes)- return (Knob var)+ var <- liftIO (MVar.newMVar bytes)+ return (Knob var) getContents :: MonadIO m => Knob -> m ByteString getContents (Knob var) = liftIO (MVar.readMVar var)@@ -166,12 +82,9 @@ => Knob -> String -- ^ Filename shown in error messages -> IO.IOMode -> m IO.Handle-newFileHandle (Knob var) name mode = liftIO $ do- startPosition <- MVar.withMVar var $ \bytes -> return $ case mode of- IO.AppendMode -> Data.ByteString.length bytes- _ -> 0- posVar <- MVar.newMVar startPosition- IO.mkFileHandle (Device mode var posVar) name mode Nothing IO.noNewlineTranslation+newFileHandle knob name mode = liftIO $ do+ device <- newDevice knob mode+ IO.mkFileHandle device name mode Nothing IO.noNewlineTranslation -- | See 'newFileHandle'. withFileHandle :: MonadIO m@@ -179,3 +92,130 @@ -> String -- ^ Filename shown in error messages. -> IO.IOMode -> (IO.Handle -> IO a) -> m a withFileHandle knob name mode io = liftIO (bracket (newFileHandle knob name mode) IO.hClose io)++-- | An IO device backed by a 'Knob'. You shouldn't usually use this type directly;+-- use 'newFileHandle' or 'withFileHandle' instead.+data Device = Device IO.IOMode (MVar.MVar ByteString) (MVar.MVar Int)+ deriving (Typeable)++newDevice :: MonadIO m => Knob -> IO.IOMode -> m Device+newDevice (Knob var) mode = liftIO $ do+ startPosition <- MVar.withMVar var $ \bytes -> return $ case mode of+ IO.AppendMode -> Data.ByteString.length bytes+ _ -> 0+ posVar <- MVar.newMVar startPosition+ pure $ Device mode var posVar++instance IO.IODevice Device where+ ready _ _ _ = return True+ close _ = return ()+ isTerminal _ = return False+ isSeekable _ = return True++ seek (Device _ _ var) IO.AbsoluteSeek off = do+ checkOffset 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))++ 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))++ tell (Device _ _ var) = fmap toInteger (MVar.readMVar var)+ getSize (Device _ var _) = do+ bytes <- MVar.readMVar var+ return (toInteger (Data.ByteString.length bytes))+ setSize = setDeviceSize+ devType _ = return IO.RegularFile++setDeviceSize :: Device -> Integer -> IO ()+setDeviceSize (Device mode bytes_var _) size = checkSize >> setBytes where+ intSize :: Int+ intSize = fromInteger size++ checkSize = when (size > toInteger (maxBound :: Int)) $ do+ throwIO (IO.IOError Nothing IO.InvalidArgument "" "size > (maxBound :: Int)" Nothing Nothing)++ setBytes = MVar.modifyMVar_ bytes_var $ \bytes -> case mode of+ IO.ReadMode -> throwIO (IO.IOError Nothing IO.IllegalOperation "" "handle in ReadMode" Nothing Nothing)+ IO.WriteMode -> return (Data.ByteString.replicate intSize 0)+ IO.ReadWriteMode -> return (clip bytes)+ IO.AppendMode -> return (clip bytes)++ clip bytes = case intSize - Data.ByteString.length bytes of+ 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++ fillReadBuffer dev buf = do+ (numRead, newBuf) <- IO.fillReadBuffer0 dev buf+ return (fromMaybe 0 numRead, newBuf)++ fillReadBuffer0 (Device _ bytes_var pos_var) buf = do+ MVar.withMVar bytes_var $ \bytes -> do+ MVar.modifyMVar pos_var $ \pos -> do+ if pos >= Data.ByteString.length bytes+ then return (pos, (Nothing, buf))+ else do+ let chunk = Data.ByteString.take (IO.bufSize buf) (Data.ByteString.drop pos bytes)+ unsafeUseAsCStringLen chunk $ \(chunkPtr, chunkLen) -> do+ Foreign.withForeignPtr (IO.bufRaw buf) $ \ptr -> do+ Foreign.copyArray ptr (Foreign.castPtr chunkPtr) chunkLen+ return (pos + chunkLen, (Just chunkLen, (buf { IO.bufL = 0, IO.bufR = chunkLen })))++ flushWriteBuffer (Device _ bytes_var pos_var) buf = 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++ let bufStart ptr = Foreign.castPtr (Foreign.plusPtr ptr (IO.bufL buf))+ let bufLen = IO.bufR buf - IO.bufL buf+ bufBytes <- Foreign.withForeignPtr (IO.bufRaw buf) (\ptr ->+ Data.ByteString.packCStringLen (bufStart ptr, bufLen))+ let newBytes = Data.ByteString.concat [before, padding, bufBytes, Data.ByteString.drop bufLen after]+ return (pos + bufLen, newBytes)+ return (buf { IO.bufL = 0, IO.bufR = 0 })++ flushWriteBuffer0 dev buf = do+ newBuf <- IO.flushWriteBuffer dev buf+ return (IO.bufR buf - IO.bufL buf, newBuf)
tests/KnobTests.hs view
@@ -5,9 +5,9 @@ -- -- See license.txt for details module Main- ( tests- , main- ) where+ ( tests+ , main+ ) where import Control.Monad.IO.Class (liftIO) import qualified Data.ByteString@@ -24,315 +24,315 @@ main = Test.Chell.defaultMain tests tests :: [Suite]-tests = [test_File, test_Duplex]+tests = [suite_File, suite_Duplex] -test_File :: Suite-test_File = suite "file"- [ suite "read"- [ test_ReadFromStart- , test_ReadFromOffset- , test_ReadToEOF- , test_ReadPastEOF- ]- , suite "write"- [ test_WriteFromStart- , test_WriteFromOffset- , test_WritePastEOF- , test_WriteAppended- ]- , suite "seek"- [ test_SeekAbsolute- , test_SeekRelative- , test_SeekFromEnd- , test_SeekBeyondMaxInt- ]- , suite "setSize"- [ test_SetSize_Read- , test_SetSize_Write- , test_SetSize_ReadWrite- , test_SetSize_Append- ]- - , test_Ready- , test_Close- , test_SetContents- , test_WithFileHandle- ]+suite_File :: Suite+suite_File = suite "file" $ concatMap suiteTests+ [ suite "read"+ [ test_ReadFromStart+ , test_ReadFromOffset+ , test_ReadToEOF+ , test_ReadPastEOF+ ]+ , suite "write"+ [ test_WriteFromStart+ , test_WriteFromOffset+ , test_WritePastEOF+ , test_WriteAppended+ ]+ , suite "seek"+ [ test_SeekAbsolute+ , test_SeekRelative+ , test_SeekFromEnd+ , test_SeekBeyondMaxInt+ ]+ , suite "setSize"+ [ test_SetSize_Read+ , test_SetSize_Write+ , test_SetSize_ReadWrite+ , test_SetSize_Append+ ]+ ]+ ++ [ 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- - bytes <- liftIO $ Data.ByteString.hGet h 3- $expect (equal bytes "abc")- - off <- liftIO $ hTell h- $expect (equal off 3)+ k <- newKnob "abcde"+ h <- newFileHandle k "foo.txt" ReadMode -test_ReadFromOffset :: Suite+ bytes <- liftIO $ Data.ByteString.hGet h 3+ $expect (equal bytes "abc")++ off <- liftIO $ hTell h+ $expect (equal off 3)++test_ReadFromOffset :: Test test_ReadFromOffset = assertions "from-offset" $ do- k <- newKnob "abcde"- h <- newFileHandle k "foo.txt" ReadMode- - liftIO $ hSeek h AbsoluteSeek 1- bytes <- liftIO $ Data.ByteString.hGet h 3- $expect (equal bytes "bcd")- - off <- liftIO $ hTell h- $expect (equal off 4)+ k <- newKnob "abcde"+ h <- newFileHandle k "foo.txt" ReadMode -test_ReadToEOF :: Suite+ liftIO $ hSeek h AbsoluteSeek 1+ bytes <- liftIO $ Data.ByteString.hGet h 3+ $expect (equal bytes "bcd")++ off <- liftIO $ hTell h+ $expect (equal off 4)++test_ReadToEOF :: Test test_ReadToEOF = assertions "to-eof" $ do- k <- newKnob "abcde"- h <- newFileHandle k "foo.txt" ReadMode- - bytes <- liftIO $ Data.ByteString.hGet h 10- $expect (equal bytes "abcde")- - off <- liftIO $ hTell h- $expect (equal off 5)+ k <- newKnob "abcde"+ h <- newFileHandle k "foo.txt" ReadMode -test_ReadPastEOF :: Suite+ bytes <- liftIO $ Data.ByteString.hGet h 10+ $expect (equal bytes "abcde")++ off <- liftIO $ hTell h+ $expect (equal off 5)++test_ReadPastEOF :: Test test_ReadPastEOF = assertions "past-eof" $ do- k <- newKnob "abcde"- h <- newFileHandle k "foo.txt" ReadMode- - liftIO $ hSeek h AbsoluteSeek 10- bytes <- liftIO $ Data.ByteString.hGet h 10- $expect (equal bytes "")- - off <- liftIO $ hTell h- $expect (equal off 10)+ k <- newKnob "abcde"+ h <- newFileHandle k "foo.txt" ReadMode -test_WriteFromStart :: Suite+ liftIO $ hSeek h AbsoluteSeek 10+ bytes <- liftIO $ Data.ByteString.hGet h 10+ $expect (equal bytes "")++ off <- liftIO $ hTell h+ $expect (equal off 10)++test_WriteFromStart :: Test test_WriteFromStart = assertions "from-start" $ do- k <- newKnob ""- h <- newFileHandle k "foo.txt" WriteMode- liftIO $ hSetBuffering h NoBuffering- - liftIO $ Data.ByteString.hPut h "abcde"- bytes <- Data.Knob.getContents k- $expect (equal bytes "abcde")+ k <- newKnob ""+ h <- newFileHandle k "foo.txt" WriteMode+ liftIO $ hSetBuffering h NoBuffering -test_WriteFromOffset :: Suite+ liftIO $ Data.ByteString.hPut h "abcde"+ bytes <- Data.Knob.getContents k+ $expect (equal bytes "abcde")++test_WriteFromOffset :: Test test_WriteFromOffset = assertions "from-offset" $ do- k <- newKnob ""- h <- newFileHandle k "foo.txt" WriteMode- liftIO $ hSetBuffering h NoBuffering- - liftIO $ Data.ByteString.hPut h "abcde"- liftIO $ hSeek h AbsoluteSeek 2- liftIO $ Data.ByteString.hPut h "abcde"- - bytes <- Data.Knob.getContents k- $expect (equal bytes "ababcde")+ k <- newKnob ""+ h <- newFileHandle k "foo.txt" WriteMode+ liftIO $ hSetBuffering h NoBuffering -test_WritePastEOF :: Suite+ liftIO $ Data.ByteString.hPut h "abcde"+ liftIO $ hSeek h AbsoluteSeek 2+ liftIO $ Data.ByteString.hPut h "abcde"++ bytes <- Data.Knob.getContents k+ $expect (equal bytes "ababcde")++test_WritePastEOF :: Test test_WritePastEOF = assertions "past-eof" $ do- k <- newKnob ""- h <- newFileHandle k "foo.txt" WriteMode- liftIO $ hSetBuffering h NoBuffering- - liftIO $ hSeek h AbsoluteSeek 2- liftIO $ Data.ByteString.hPut h "abcde"- bytes <- Data.Knob.getContents k- $expect (equal bytes "\0\0abcde")+ k <- newKnob ""+ h <- newFileHandle k "foo.txt" WriteMode+ liftIO $ hSetBuffering h NoBuffering -test_WriteAppended :: Suite+ liftIO $ hSeek h AbsoluteSeek 2+ liftIO $ Data.ByteString.hPut h "abcde"+ bytes <- Data.Knob.getContents k+ $expect (equal bytes "\0\0abcde")++test_WriteAppended :: Test test_WriteAppended = assertions "appended" $ do- k <- newKnob "foo"- h <- newFileHandle k "foo.txt" AppendMode- liftIO $ hSetBuffering h NoBuffering- - liftIO $ Data.ByteString.hPut h "bar"- bytes <- Data.Knob.getContents k- $expect (equal bytes "foobar")+ k <- newKnob "foo"+ h <- newFileHandle k "foo.txt" AppendMode+ liftIO $ hSetBuffering h NoBuffering -test_SeekAbsolute :: Suite+ liftIO $ Data.ByteString.hPut h "bar"+ bytes <- Data.Knob.getContents k+ $expect (equal bytes "foobar")++test_SeekAbsolute :: Test test_SeekAbsolute = assertions "absolute" $ do- k <- newKnob ""- h <- newFileHandle k "foo.txt" ReadMode- - before <- liftIO $ hTell h- liftIO $ hSeek h AbsoluteSeek 2- after <- liftIO $ hTell h- - $expect (equal before 0)- $expect (equal after 2)+ k <- newKnob ""+ h <- newFileHandle k "foo.txt" ReadMode -test_SeekRelative :: Suite+ before <- liftIO $ hTell h+ liftIO $ hSeek h AbsoluteSeek 2+ after <- liftIO $ hTell h++ $expect (equal before 0)+ $expect (equal after 2)++test_SeekRelative :: Test test_SeekRelative = assertions "relative" $ do- k <- newKnob ""- h <- newFileHandle k "foo.txt" ReadMode- - before <- liftIO $ hTell h- liftIO $ hSeek h RelativeSeek 2- after1 <- liftIO $ hTell h- liftIO $ hSeek h RelativeSeek 2- after2 <- liftIO $ hTell h- - $expect (equal before 0)- $expect (equal after1 2)- $expect (equal after2 4)+ k <- newKnob ""+ h <- newFileHandle k "foo.txt" ReadMode -test_SeekFromEnd :: Suite+ before <- liftIO $ hTell h+ liftIO $ hSeek h RelativeSeek 2+ after1 <- liftIO $ hTell h+ liftIO $ hSeek h RelativeSeek 2+ after2 <- liftIO $ hTell h++ $expect (equal before 0)+ $expect (equal after1 2)+ $expect (equal after2 4)++test_SeekFromEnd :: Test test_SeekFromEnd = assertions "from-end" $ do- k <- newKnob "abcde"- h <- newFileHandle k "foo.txt" ReadMode- - before <- liftIO $ hTell h- liftIO $ hSeek h SeekFromEnd (- 2)- after <- liftIO $ hTell h- - $expect (equal before 0)- $expect (equal after 3)+ k <- newKnob "abcde"+ h <- newFileHandle k "foo.txt" ReadMode -test_SeekBeyondMaxInt :: Suite+ before <- liftIO $ hTell h+ liftIO $ hSeek h SeekFromEnd (- 2)+ after <- liftIO $ hTell h++ $expect (equal before 0)+ $expect (equal after 3)++test_SeekBeyondMaxInt :: Test test_SeekBeyondMaxInt = assertions "beyond-max-int" $ do- k <- newKnob "abcde"- h <- newFileHandle k "foo.txt" ReadMode- - let intPlusOne = toInteger (maxBound :: Int) + 1- - $expect $ throwsEq- (GHC.IOError (Just h) GHC.InvalidArgument "hSeek" "offset > (maxBound :: Int)" Nothing (Just "foo.txt"))- (hSeek h AbsoluteSeek intPlusOne)- $expect $ throwsEq- (GHC.IOError (Just h) GHC.InvalidArgument "hSeek" "offset > (maxBound :: Int)" Nothing (Just "foo.txt"))- (hSeek h RelativeSeek intPlusOne)- - -- testing this with real contents is difficult/impossible on a- -- 64-bit system, so use an unsafe function to corrupt the knob's- -- internal buffer first.- hugeBytes <- liftIO (unsafePackCStringLen (nullPtr, maxBound))- liftIO $ hSeek h AbsoluteSeek (intPlusOne - 1)- setContents k hugeBytes- $expect $ throwsEq- (GHC.IOError (Just h) GHC.InvalidArgument "hSeek" "offset > (maxBound :: Int)" Nothing (Just "foo.txt"))- (hSeek h SeekFromEnd 2)+ k <- newKnob "abcde"+ h <- newFileHandle k "foo.txt" ReadMode -test_Ready :: Suite+ let intPlusOne = toInteger (maxBound :: Int) + 1++ $expect $ throwsEq+ (GHC.IOError (Just h) GHC.InvalidArgument "hSeek" "offset > (maxBound :: Int)" Nothing (Just "foo.txt"))+ (hSeek h AbsoluteSeek intPlusOne)+ $expect $ throwsEq+ (GHC.IOError (Just h) GHC.InvalidArgument "hSeek" "offset > (maxBound :: Int)" Nothing (Just "foo.txt"))+ (hSeek h RelativeSeek intPlusOne)++ -- testing this with real contents is difficult/impossible on a+ -- 64-bit system, so use an unsafe function to corrupt the knob's+ -- internal buffer first.+ hugeBytes <- liftIO (unsafePackCStringLen (nullPtr, maxBound))+ liftIO $ hSeek h AbsoluteSeek (intPlusOne - 1)+ setContents k hugeBytes+ $expect $ throwsEq+ (GHC.IOError (Just h) GHC.InvalidArgument "hSeek" "offset > (maxBound :: Int)" Nothing (Just "foo.txt"))+ (hSeek h SeekFromEnd 2)++test_Ready :: Test test_Ready = assertions "ready" $ do- k <- newKnob "abcde"- h <- newFileHandle k "foo.txt" ReadMode- - ready <- liftIO $ hReady h- $expect ready- - _ <- liftIO $ Data.ByteString.hGet h 10- $expect $ throwsEq- (GHC.IOError (Just h) GHC.EOF "hWaitForInput" "" Nothing (Just "foo.txt"))- (hReady h)+ k <- newKnob "abcde"+ h <- newFileHandle k "foo.txt" ReadMode -test_Close :: Suite+ ready <- liftIO $ hReady h+ $expect ready++ _ <- liftIO $ Data.ByteString.hGet h 10+ $expect $ throwsEq+ (GHC.IOError (Just h) GHC.EOF "hWaitForInput" "" Nothing (Just "foo.txt"))+ (hReady h)++test_Close :: Test test_Close = assertions "close" $ do- k <- newKnob "abcde"- h <- newFileHandle k "foo.txt" ReadMode- - liftIO $ hClose h- $expect $ throwsEq- (GHC.IOError (Just h) GHC.IllegalOperation "hGetBuf" "handle is closed" Nothing (Just "foo.txt"))- (Data.ByteString.hGet h 1)- $expect $ throwsEq- (GHC.IOError (Just h) GHC.IllegalOperation "hWaitForInput" "handle is closed" Nothing (Just "foo.txt"))- (hReady h)+ k <- newKnob "abcde"+ h <- newFileHandle k "foo.txt" ReadMode -test_SetSize_Read :: Suite+ liftIO $ hClose h+ $expect $ throwsEq+ (GHC.IOError (Just h) GHC.IllegalOperation "hGetBuf" "handle is closed" Nothing (Just "foo.txt"))+ (Data.ByteString.hGet h 1)+ $expect $ throwsEq+ (GHC.IOError (Just h) GHC.IllegalOperation "hWaitForInput" "handle is closed" Nothing (Just "foo.txt"))+ (hReady h)++test_SetSize_Read :: Test test_SetSize_Read = assertions "ReadMode" $ do- k <- newKnob "abcde"- h <- newFileHandle k "foo.txt" ReadMode- - let intPlusOne = toInteger (maxBound :: Int) + 1- $expect $ throwsEq- (GHC.IOError (Just h) GHC.InvalidArgument "hSetFileSize" "size > (maxBound :: Int)" Nothing (Just "foo.txt"))- (hSetFileSize h intPlusOne)- - $expect $ throwsEq- (GHC.IOError (Just h) GHC.IllegalOperation "hSetFileSize" "handle in ReadMode" Nothing (Just "foo.txt"))- (hSetFileSize h 2)+ k <- newKnob "abcde"+ h <- newFileHandle k "foo.txt" ReadMode -test_SetSize_Write :: Suite+ let intPlusOne = toInteger (maxBound :: Int) + 1+ $expect $ throwsEq+ (GHC.IOError (Just h) GHC.InvalidArgument "hSetFileSize" "size > (maxBound :: Int)" Nothing (Just "foo.txt"))+ (hSetFileSize h intPlusOne)++ $expect $ throwsEq+ (GHC.IOError (Just h) GHC.IllegalOperation "hSetFileSize" "handle in ReadMode" Nothing (Just "foo.txt"))+ (hSetFileSize h 2)++test_SetSize_Write :: Test test_SetSize_Write = assertions "WriteMode" $ do- k <- newKnob "abcde"- h <- newFileHandle k "foo.txt" WriteMode- - let intPlusOne = toInteger (maxBound :: Int) + 1- $expect $ throwsEq- (GHC.IOError (Just h) GHC.InvalidArgument "hSetFileSize" "size > (maxBound :: Int)" Nothing (Just "foo.txt"))- (hSetFileSize h intPlusOne)- - -- Resets contents to all NULL, regardless of offset- liftIO $ hSeek h AbsoluteSeek 2- liftIO $ hSetFileSize h 4- - bytes <- Data.Knob.getContents k- $expect (equal bytes "\0\0\0\0")+ k <- newKnob "abcde"+ h <- newFileHandle k "foo.txt" WriteMode -test_SetSize_ReadWrite :: Suite+ let intPlusOne = toInteger (maxBound :: Int) + 1+ $expect $ throwsEq+ (GHC.IOError (Just h) GHC.InvalidArgument "hSetFileSize" "size > (maxBound :: Int)" Nothing (Just "foo.txt"))+ (hSetFileSize h intPlusOne)++ -- Resets contents to all NULL, regardless of offset+ liftIO $ hSeek h AbsoluteSeek 2+ liftIO $ hSetFileSize h 4++ bytes <- Data.Knob.getContents k+ $expect (equal bytes "\0\0\0\0")++test_SetSize_ReadWrite :: Test test_SetSize_ReadWrite = assertions "ReadWriteMode" $ do- k <- newKnob "abcde"- h <- newFileHandle k "foo.txt" ReadWriteMode- - let intPlusOne = toInteger (maxBound :: Int) + 1- $expect $ throwsEq- (GHC.IOError (Just h) GHC.InvalidArgument "hSetFileSize" "size > (maxBound :: Int)" Nothing (Just "foo.txt"))- (hSetFileSize h intPlusOne)- - -- Truncates contents, regardless of offset- do- liftIO $ hSeek h AbsoluteSeek 2- liftIO $ hSetFileSize h 4- bytes <- Data.Knob.getContents k- $expect (equal bytes "abcd")- - do- liftIO $ hSetFileSize h 6- bytes <- Data.Knob.getContents k- $expect (equal bytes "abcd\0\0")+ k <- newKnob "abcde"+ h <- newFileHandle k "foo.txt" ReadWriteMode -test_SetSize_Append :: Suite+ let intPlusOne = toInteger (maxBound :: Int) + 1+ $expect $ throwsEq+ (GHC.IOError (Just h) GHC.InvalidArgument "hSetFileSize" "size > (maxBound :: Int)" Nothing (Just "foo.txt"))+ (hSetFileSize h intPlusOne)++ -- Truncates contents, regardless of offset+ do+ liftIO $ hSeek h AbsoluteSeek 2+ liftIO $ hSetFileSize h 4+ bytes <- Data.Knob.getContents k+ $expect (equal bytes "abcd")++ do+ liftIO $ hSetFileSize h 6+ bytes <- Data.Knob.getContents k+ $expect (equal bytes "abcd\0\0")++test_SetSize_Append :: Test test_SetSize_Append = assertions "AppendMode" $ do- k <- newKnob "abcde"- h <- newFileHandle k "foo.txt" AppendMode- - let intPlusOne = toInteger (maxBound :: Int) + 1- $expect $ throwsEq- (GHC.IOError (Just h) GHC.InvalidArgument "hSetFileSize" "size > (maxBound :: Int)" Nothing (Just "foo.txt"))- (hSetFileSize h intPlusOne)- - do- liftIO $ hSetFileSize h 4- bytes <- Data.Knob.getContents k- $expect (equal bytes "abcd")- - do- liftIO $ hSetFileSize h 6- bytes <- Data.Knob.getContents k- $expect (equal bytes "abcd\0\0")+ k <- newKnob "abcde"+ h <- newFileHandle k "foo.txt" AppendMode -test_SetContents :: Suite+ let intPlusOne = toInteger (maxBound :: Int) + 1+ $expect $ throwsEq+ (GHC.IOError (Just h) GHC.InvalidArgument "hSetFileSize" "size > (maxBound :: Int)" Nothing (Just "foo.txt"))+ (hSetFileSize h intPlusOne)++ do+ liftIO $ hSetFileSize h 4+ bytes <- Data.Knob.getContents k+ $expect (equal bytes "abcd")++ do+ liftIO $ hSetFileSize h 6+ bytes <- Data.Knob.getContents k+ $expect (equal bytes "abcd\0\0")++test_SetContents :: Test test_SetContents = assertions "setContents" $ do- k <- newKnob "abcde"- before <- Data.Knob.getContents k- setContents k "foo"- after <- Data.Knob.getContents k- - $expect (equal before "abcde")- $expect (equal after "foo")+ k <- newKnob "abcde"+ before <- Data.Knob.getContents k+ setContents k "foo"+ after <- Data.Knob.getContents k -test_WithFileHandle :: Suite+ $expect (equal before "abcde")+ $expect (equal after "foo")++test_WithFileHandle :: Test test_WithFileHandle = assertions "withFileHandle" $ do- k <- newKnob ""- h <- withFileHandle k "test.txt" WriteMode $ \h -> do- Data.ByteString.hPut h "abcde"- return h- - bytes <- Data.Knob.getContents k- $expect (equal bytes "abcde")- - closed <- liftIO $ hIsClosed h- $expect closed+ k <- newKnob ""+ h <- withFileHandle k "test.txt" WriteMode $ \h -> do+ Data.ByteString.hPut h "abcde"+ return h -test_Duplex :: Suite-test_Duplex = suite "duplex" []+ bytes <- Data.Knob.getContents k+ $expect (equal bytes "abcde")++ closed <- liftIO $ hIsClosed h+ $expect closed++suite_Duplex :: Suite+suite_Duplex = suite "duplex" []
tests/knob-tests.cabal view
@@ -1,7 +1,7 @@ name: knob-tests version: 0 build-type: Simple-cabal-version: >= 1.6+cabal-version: >= 1.8 flag coverage default: False@@ -11,12 +11,13 @@ main-is: KnobTests.hs ghc-options: -Wall hs-source-dirs: ../lib,.+ other-modules: Data.Knob 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+ base >= 4.15 && < 5+ , bytestring >= 0.9 && < 0.12+ , chell >= 0.2 && < 0.6+ , transformers >= 0.2 && < 0.7