diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Revision history for Z-IO +## 0.3.0.0 -- 2020-12-29 + +* Add `getSystemTime'` to `Z.IO.Time`. +* Add `shutdownUVStream` to `Z.IO.UV.UVStream`. +* Rename `sourceFrom/sinkToFile` to `initSourceFrom/initSinkToFile`. +* Bump `Z-Data` version. ## 0.2.0.0 -- 2020-12-16 diff --git a/Z-IO.cabal b/Z-IO.cabal --- a/Z-IO.cabal +++ b/Z-IO.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: Z-IO -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Simple and high performance IO toolkit for Haskell description: Simple and high performance IO toolkit for Haskell, including file system, network, ipc and more! @@ -124,11 +124,11 @@ , exceptions == 0.10.* , primitive >= 0.7.1 && < 0.7.2 , stm == 2.5.* - , time >= 1.8 && < 2.0 - , unix-time >= 0.4.7 && < 0.5 , unordered-containers == 0.2.* , containers == 0.6.* - , Z-Data >= 0.2.0 && < 0.3 + , Z-Data == 0.3.* + , time >= 1.9 && <= 2.0 + , unix-time >= 0.4.7 && <= 0.5 default-language: Haskell2010 default-extensions: BangPatterns diff --git a/Z/IO/BIO.hs b/Z/IO/BIO.hs --- a/Z/IO/BIO.hs +++ b/Z/IO/BIO.hs @@ -35,8 +35,8 @@ base64Enc <- newBase64Encoder (_, zlibCompressor) <- newCompress defaultCompressConfig{compressWindowBits = 31} - withResource (sourceFromFile origin) $ \ src -> - withResource (sinkToFile target) $ \ sink -> + withResource (initSourceFromFile origin) $ \ src -> + withResource (initSinkToFile target) $ \ sink -> runBIO $ src >|> base64Enc >|> zlibCompressor >|> sink > base64AndCompressFile "test" "test.gz" @@ -47,7 +47,7 @@ module Z.IO.BIO ( -- * The BIO type BIO(..), Source, Sink - , BIOException(..), ParseException(..), JSONConvertException(..) + , BIOException(..), BIOParseException(..), JSONConvertException(..) -- ** Basic combinators , (>|>), (>~>), (>!>), appendSource , concatSource, zipSource, zipBIO @@ -61,7 +61,7 @@ , pureBIO, ioBIO -- ** Source , sourceFromList - , sourceFromFile + , initSourceFromFile , sourceFromBuffered, sourceFromInput , sourceTextFromBuffered, sourceTextFromInput , sourceJSONFromBuffered, sourceJSONFromInput @@ -71,7 +71,7 @@ , sinkToBuffered , sinkBuilderToBuffered , sinkToOutput - , sinkToFile + , initSinkToFile , sinkBuilderToOutput , sinkToIO -- ** Bytes specific @@ -197,10 +197,10 @@ -- | Exception when BIO parse failed, this exception is one of a particular -- 'BIOException'. -data ParseException = ParseException P.ParseError CallStack +data BIOParseException = BIOParseException P.ParseError CallStack deriving Show -instance Exception ParseException where +instance Exception BIOParseException where toException = bioExceptionToException fromException = bioExceptionFromException @@ -513,7 +513,7 @@ (rest, r) <- P.parseChunks p (readBuffer bi) bs unReadBuffer rest bi case r of Right v -> return (Just v) - Left e -> throwIO (ParseException e callStack)} + Left e -> throwIO (BIOParseException e callStack)} -- | Turn an input device into a 'V.Bytes' source. sourceFromInput :: Input i => i -> IO (Source V.Bytes) @@ -531,9 +531,9 @@ {-# INLINABLE sourceJSONFromInput #-} -- | Turn a file into a 'V.Bytes' source. -sourceFromFile :: CBytes -> Resource (Source V.Bytes) -{-# INLINABLE sourceFromFile #-} -sourceFromFile p = do +initSourceFromFile :: CBytes -> Resource (Source V.Bytes) +{-# INLINABLE initSourceFromFile #-} +initSourceFromFile p = do f <- FS.initFile p FS.O_RDONLY FS.DEFAULT_MODE liftIO (sourceFromInput f) @@ -577,9 +577,9 @@ -- -- Note the file will be opened in @'FS.O_APPEND' .|. 'FS.O_CREAT' .|. 'FS.O_WRONLY'@ mode, -- bytes will be written after the end of the original file if there'are old bytes. -sinkToFile :: HasCallStack => CBytes -> Resource (Sink V.Bytes) -{-# INLINABLE sinkToFile #-} -sinkToFile p = do +initSinkToFile :: HasCallStack => CBytes -> Resource (Sink V.Bytes) +{-# INLINABLE initSinkToFile #-} +initSinkToFile p = do f <- FS.initFile p (FS.O_APPEND .|. FS.O_CREAT .|. FS.O_WRONLY) FS.DEFAULT_MODE liftIO (sinkToOutput f) @@ -669,7 +669,7 @@ -- This function will continuously draw data from input before parsing finish. -- Unconsumed bytes will be returned to buffer. -- --- Return 'Nothing' if reach EOF before parsing, throw 'ParseException' if +-- Return 'Nothing' if reach EOF before parsing, throw 'BIOParseException' if -- parsing fail. newParserNode :: P.Parser a -> IO (BIO V.Bytes a) {-# INLINABLE newParserNode #-} @@ -688,7 +688,7 @@ writeIORef resultRef (Left trailing') return (Just a) P.Failure e _ -> - throwIO (ParseException e callStack) + throwIO (BIOParseException e callStack) P.Partial f' -> do writeIORef resultRef (Right f') return Nothing @@ -708,9 +708,9 @@ writeIORef resultRef (Left trailing') return (Just a) P.Failure e _ -> - throwIO (ParseException e callStack) + throwIO (BIOParseException e callStack) P.Partial _ -> - throwIO (ParseException ["last chunk partial parse"] callStack) + throwIO (BIOParseException ["last chunk partial parse"] callStack) -- | Make a new UTF8 decoder, which decode bytes streams into text streams. -- diff --git a/Z/IO/BIO/Zlib.hsc b/Z/IO/BIO/Zlib.hsc --- a/Z/IO/BIO/Zlib.hsc +++ b/Z/IO/BIO/Zlib.hsc @@ -55,7 +55,7 @@ import Z.Data.Array as A import Z.Data.CBytes as CBytes import Z.Data.JSON (EncodeJSON, FromValue, ToValue) -import Z.Data.Text.ShowT (ShowT) +import Z.Data.Text.Print (Print) import Z.Data.Vector.Base as V import Z.Foreign import Z.IO.BIO @@ -110,7 +110,7 @@ , compressStrategy :: Strategy , compressBufferSize :: Int } deriving (Show, Eq, Ord, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) defaultCompressConfig :: CompressConfig defaultCompressConfig = @@ -127,7 +127,7 @@ => CompressConfig -> IO (ZStream, BIO V.Bytes V.Bytes) newCompress (CompressConfig level windowBits memLevel dict strategy bufSiz) = do - zs <- newForeignPtr free_z_stream_deflate =<< create_z_stream + zs <- mask_ (newForeignPtr free_z_stream_deflate =<< create_z_stream) buf <- A.newPinnedPrimArray bufSiz set_avail_out zs buf bufSiz bufRef <- newIORef buf @@ -204,7 +204,7 @@ , decompressDictionary :: V.Bytes , decompressBufferSize :: Int } deriving (Show, Eq, Ord, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) defaultDecompressConfig :: DecompressConfig defaultDecompressConfig = DecompressConfig defaultWindowBits V.empty V.defaultChunkSize diff --git a/Z/IO/Exception.hs b/Z/IO/Exception.hs --- a/Z/IO/Exception.hs +++ b/Z/IO/Exception.hs @@ -80,7 +80,7 @@ import Foreign.Ptr import GHC.Stack import qualified Z.Data.Text as T -import qualified Z.Data.Text.ShowT as T +import qualified Z.Data.Text.Print as T import Z.IO.UV.Errno @@ -191,7 +191,7 @@ instance Show IOEInfo where show = T.toString -instance T.ShowT IOEInfo where +instance T.Print IOEInfo where toUTF8BuilderP _ (IOEInfo errno desc cstack) = do "{name:" T.text errno diff --git a/Z/IO/FileSystem.hs b/Z/IO/FileSystem.hs --- a/Z/IO/FileSystem.hs +++ b/Z/IO/FileSystem.hs @@ -113,7 +113,7 @@ import Z.Data.CBytes as CBytes import Z.Data.PrimRef.PrimIORef import qualified Z.Data.Text as T -import qualified Z.Data.Text.ShowT as T +import qualified Z.Data.Text.Print as T import qualified Z.Data.Vector as V import Z.Foreign import Z.IO.Buffered @@ -137,7 +137,7 @@ instance Show File where show = T.toString -instance T.ShowT File where +instance T.Print File where toUTF8BuilderP _ (File fd _) = "File " >> T.int fd -- | Return File fd. diff --git a/Z/IO/FileSystem/FilePath.hsc b/Z/IO/FileSystem/FilePath.hsc --- a/Z/IO/FileSystem/FilePath.hsc +++ b/Z/IO/FileSystem/FilePath.hsc @@ -41,10 +41,10 @@ import Data.Bits import qualified Data.List as List import GHC.Generics -import Z.Data.CBytes (CBytes(CB), allocCBytesUnsafe, withCBytesUnsafe, withCBytesListUnsafe) -import qualified Z.Data.CBytes as CB -import qualified Z.Data.Text.ShowT as T -import Z.Data.JSON (FromValue, ToValue, EncodeJSON) +import qualified Z.Data.CBytes as CB +import Z.Data.CBytes (CBytes(CB), allocCBytesUnsafe, withCBytesUnsafe, withCBytesListUnsafe) +import Z.Data.JSON (FromValue, ToValue, EncodeJSON) +import qualified Z.Data.Text as T import qualified Z.Data.Vector.Base as V import qualified Z.Data.Vector as V import Z.Foreign @@ -71,7 +71,7 @@ data PathStyle = WindowsStyle -- ^ Use backslashes as a separator and volume for the root. | UnixStyle -- ^ Use slashes as a separator and a slash for the root. deriving (Show, Eq, Ord, Generic) - deriving anyclass (T.ShowT, FromValue, ToValue, EncodeJSON) + deriving anyclass (T.Print, FromValue, ToValue, EncodeJSON) enumToPathStyle_ :: CInt -> PathStyle enumToPathStyle_ (#const CWK_STYLE_WINDOWS) = WindowsStyle diff --git a/Z/IO/FileSystem/Threaded.hs b/Z/IO/FileSystem/Threaded.hs --- a/Z/IO/FileSystem/Threaded.hs +++ b/Z/IO/FileSystem/Threaded.hs @@ -116,7 +116,7 @@ import Z.Data.CBytes as CBytes import Z.Data.PrimRef.PrimIORef import qualified Z.Data.Text as T -import qualified Z.Data.Text.ShowT as T +import qualified Z.Data.Text.Print as T import qualified Z.Data.Vector as V import Z.Foreign import Z.IO.Buffered @@ -144,7 +144,7 @@ instance Show File where show = T.toString -instance T.ShowT File where +instance T.Print File where toUTF8BuilderP _ (File fd _) = "File " >> T.int fd -- | Return File fd. diff --git a/Z/IO/FileSystem/Watch.hs b/Z/IO/FileSystem/Watch.hs --- a/Z/IO/FileSystem/Watch.hs +++ b/Z/IO/FileSystem/Watch.hs @@ -40,7 +40,7 @@ import Z.Data.CBytes (CBytes) import qualified Z.Data.CBytes as CBytes import Z.Data.JSON (EncodeJSON, FromValue, ToValue) -import Z.Data.Text.ShowT (ShowT) +import Z.Data.Text.Print (Print) import Z.Data.Vector (defaultChunkSize) import Z.Foreign import Z.IO.BIO @@ -55,7 +55,7 @@ -- | File event with path info. data FileEvent = FileAdd CBytes | FileRemove CBytes | FileModify CBytes deriving (Show, Read, Ord, Eq, Generic) - deriving anyclass (ShowT, FromValue, ToValue, EncodeJSON) + deriving anyclass (Print, FromValue, ToValue, EncodeJSON) -- | Start watching a list of given directories. @@ -160,7 +160,7 @@ | i >= siz = return acc | otherwise = let !event = indexBA buf# i - !path = indexBA buf# (i + 1) + !path = CBytes.indexBACBytes buf# (i + 1) in loopReadFileEvent buf# (i + CBytes.length path + 2) ((event,path):acc) where siz = sizeofPrimArray (PrimArray buf# :: PrimArray Word8) diff --git a/Z/IO/Logger.hs b/Z/IO/Logger.hs --- a/Z/IO/Logger.hs +++ b/Z/IO/Logger.hs @@ -138,7 +138,7 @@ {-# NOINLINE defaultTSCache #-} defaultTSCache = unsafePerformIO $ do throttle 1 $ do - t <- getSystemTime + t <- getSystemTime' CB.toBuilder <$> formatSystemTime iso8061DateFormat t -- | Make a new simple logger. diff --git a/Z/IO/Network/DNS.hsc b/Z/IO/Network/DNS.hsc --- a/Z/IO/Network/DNS.hsc +++ b/Z/IO/Network/DNS.hsc @@ -31,7 +31,7 @@ import Foreign.Storable import GHC.Generics import Z.Data.CBytes as CBytes -import Z.Data.Text.ShowT (ShowT(..)) +import Z.Data.Text.Print (Print(..)) import Z.Data.JSON (EncodeJSON, ToValue, FromValue) import Z.Foreign import Z.IO.Exception @@ -86,7 +86,7 @@ -- returned. (Only some platforms support this.) | AI_V4MAPPED deriving (Eq, Ord, Read, Show, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) addrInfoFlagMapping :: [(AddrInfoFlag, CInt)] addrInfoFlagMapping = @@ -129,7 +129,7 @@ , addrAddress :: SocketAddr , addrCanonName :: CBytes } deriving (Eq, Ord, Show, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) instance Storable AddrInfo where diff --git a/Z/IO/Network/IPC.hs b/Z/IO/Network/IPC.hs --- a/Z/IO/Network/IPC.hs +++ b/Z/IO/Network/IPC.hs @@ -39,7 +39,7 @@ import Foreign.Ptr import GHC.Generics import Z.Data.CBytes -import Z.Data.Text.ShowT (ShowT(..)) +import Z.Data.Text.Print (Print) import Z.Data.JSON (EncodeJSON, ToValue, FromValue) import Z.IO.Exception import Z.IO.Resource @@ -57,7 +57,7 @@ -- won't bind if set to 'Nothing'. , ipcTargetName :: CBytes -- ^ target path (Unix) or a name (Windows). } deriving (Eq, Ord, Show, Read, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) -- | Default config, connect to ".\/ipc". -- @@ -88,7 +88,7 @@ { ipcListenName :: CBytes -- ^ listening path (Unix) or a name (Windows). , ipcListenBacklog :: Int -- ^ listening pipe's backlog size, should be large enough(>128) } deriving (Eq, Ord, Show, Read, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) -- | A default hello world server on @.\/ipc@ -- @@ -183,7 +183,7 @@ uvm <- getUVManager withResource (initUVStream (\ loop hdl -> do throwUVIfMinus_ (uv_pipe_init loop hdl 0) - throwUVIfMinus_ (hs_uv_pipe_open hdl fd)) uvm) $ \ uvs -> do + throwUVIfMinus_ (uv_pipe_open hdl fd)) uvm) $ \ uvs -> do ipcServerWorker uvs -------------------------------------------------------------------------------- diff --git a/Z/IO/Network/SocketAddr.hsc b/Z/IO/Network/SocketAddr.hsc --- a/Z/IO/Network/SocketAddr.hsc +++ b/Z/IO/Network/SocketAddr.hsc @@ -80,8 +80,8 @@ import Numeric (showHex) import System.IO.Unsafe import Z.Data.CBytes -import Z.Data.Text.ShowT (ShowT(..)) -import qualified Z.Data.Text.ShowT as T +import Z.Data.Text.Print (Print(..)) +import qualified Z.Data.Text.Print as T import Z.Data.JSON (EncodeJSON(..), ToValue(..), FromValue(..), (.:)) import qualified Z.Data.JSON as JSON import qualified Z.Data.JSON.Builder as B @@ -183,7 +183,7 @@ instance Show SocketAddr where show = T.toString -instance ShowT SocketAddr where +instance Print SocketAddr where toUTF8BuilderP _ (SocketAddrIPv4 addr port) = T.toUTF8Builder addr >> T.char7 ':' >> T.toUTF8Builder port toUTF8BuilderP _ (SocketAddrIPv6 addr port _ _) = do @@ -233,7 +233,7 @@ fromValue v = tupleToIPv4Addr <$> fromValue v instance Show IPv4 where show = T.toString -instance ShowT IPv4 where +instance Print IPv4 where toUTF8BuilderP _ ia = do let (a,b,c,d) = ipv4AddrToTuple ia T.int a @@ -279,7 +279,7 @@ poke p (IPv4 ia) = pokeByteOff p 0 (htonl ia) instance Unaligned IPv4 where - unalignedSize _ = 4 + unalignedSize = 4 pokeMBA p off x = pokeMBA p off (htonl (getIPv4Addr x)) peekMBA p off = IPv4 . ntohl <$> peekMBA p off indexBA p off = IPv4 (ntohl (indexBA p off)) @@ -326,7 +326,7 @@ return $! tupleToIPv6Addr (a,b,c,d,e,f,g,h) instance Show IPv6 where show = T.toString -instance ShowT IPv6 where +instance Print IPv6 where toUTF8BuilderP _ ia6@(IPv6 a1 a2 a3 a4) -- IPv4-Mapped IPv6 Address | a1 == 0 && a2 == 0 && a3 == 0xffff = @@ -416,7 +416,7 @@ pokeByte 3 (a `sr` 0) instance Unaligned IPv6 where - unalignedSize _ = (#size struct in6_addr) + unalignedSize = (#size struct in6_addr) indexBA p off = let a = indexBA p (off + s6_addr_offset + 0) @@ -598,7 +598,7 @@ -- 60000 newtype PortNumber = PortNumber Word16 deriving (Eq, Ord, Enum, Generic) - deriving newtype (Show, ShowT, Read, Num, Bounded, Real, Integral, EncodeJSON, ToValue, FromValue) + deriving newtype (Show, Print, Read, Num, Bounded, Real, Integral, EncodeJSON, ToValue, FromValue) -- | @:0@ portAny :: PortNumber @@ -611,7 +611,7 @@ peek p = PortNumber . ntohs <$> peek (castPtr p) instance Unaligned PortNumber where - unalignedSize _ = 2 + unalignedSize = 2 indexBA p off = PortNumber . ntohs $ indexBA p off pokeMBA p off (PortNumber po) = pokeMBA p off (htons po) peekMBA p off = PortNumber . ntohs <$> peekMBA p off diff --git a/Z/IO/Network/TCP.hs b/Z/IO/Network/TCP.hs --- a/Z/IO/Network/TCP.hs +++ b/Z/IO/Network/TCP.hs @@ -38,7 +38,7 @@ import Data.Primitive.PrimArray import Foreign.Ptr import GHC.Generics -import Z.Data.Text.ShowT (ShowT(..)) +import Z.Data.Text.Print (Print) import Z.Data.JSON (EncodeJSON, ToValue, FromValue) import Z.IO.Exception import Z.IO.Network.SocketAddr @@ -59,7 +59,7 @@ , tcpClientNoDelay :: Bool -- ^ if we want to use @TCP_NODELAY@ , tcpClientKeepAlive :: CUInt -- ^ set keepalive delay for client socket, see 'setTCPKeepAlive' } deriving (Eq, Ord, Show, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) -- | Default config, connect to @localhost:8888@. -- @@ -96,7 +96,7 @@ , tcpServerWorkerNoDelay :: Bool -- ^ if we want to use @TCP_NODELAY@ , tcpServerWorkerKeepAlive :: CUInt -- ^ set keepalive delay for worker socket, see 'setTCPKeepAlive' } deriving (Eq, Ord, Show, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) -- | A default hello world server on 0.0.0.0:8888 -- @@ -196,7 +196,7 @@ uvm <- getUVManager withResource (initUVStream (\ loop hdl -> do throwUVIfMinus_ (uv_tcp_init loop hdl) - throwUVIfMinus_ (hs_uv_tcp_open hdl fd)) uvm) $ \ uvs -> do + throwUVIfMinus_ (uv_tcp_open hdl fd)) uvm) $ \ uvs -> do -- safe without withUVManager when tcpServerWorkerNoDelay . throwUVIfMinus_ $ uv_tcp_nodelay (uvsHandle uvs) 1 diff --git a/Z/IO/Network/UDP.hs b/Z/IO/Network/UDP.hs --- a/Z/IO/Network/UDP.hs +++ b/Z/IO/Network/UDP.hs @@ -72,8 +72,7 @@ import Z.Data.Vector.Base as V import Z.Data.Vector.Extra as V import Z.Data.CBytes as CBytes -import qualified Z.Data.Text.ShowT as T -import Z.Data.Text.ShowT (ShowT(..)) +import qualified Z.Data.Text.Print as T import Z.Data.JSON (EncodeJSON, ToValue, FromValue) import Z.IO.Network.SocketAddr import Z.Foreign @@ -97,7 +96,7 @@ } instance Show UDP where show = T.toString -instance ShowT UDP where +instance T.Print UDP where toUTF8BuilderP _ (UDP hdl slot uvm _ _) = do "UDP{udpHandle=" >> T.toUTF8Builder hdl ",udpSlot=" >> T.toUTF8Builder slot @@ -114,7 +113,7 @@ , udpLocalAddr :: Maybe (SocketAddr, UDPFlag) -- ^ do we want bind a local address before receiving & sending? -- set to Nothing to let OS pick a random one. } deriving (Eq, Ord, Show, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (T.Print, EncodeJSON, ToValue, FromValue) -- | @UDPConfig 512 Nothing@ defaultUDPConfig :: UDPConfig @@ -313,7 +312,7 @@ -- increase this number can improve receiving performance, -- at the cost of memory and potential GHC thread starving. } deriving (Eq, Ord, Show, Read, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (T.Print, EncodeJSON, ToValue, FromValue) -- | @UDPRecvConfig 512 6@ defaultUDPRecvConfig :: UDPRecvConfig diff --git a/Z/IO/Process.hsc b/Z/IO/Process.hsc --- a/Z/IO/Process.hsc +++ b/Z/IO/Process.hsc @@ -67,12 +67,11 @@ import GHC.Conc.Signal (Signal) import System.Exit import Z.Data.CBytes -import Z.Data.CBytes as CBytes -import Z.Data.JSON (EncodeJSON, ToValue, FromValue) -import Z.Data.Vector as V -import Z.Data.Text as T -import Z.Data.Text.ShowT (ShowT) -import qualified Data.List as List +import Z.Data.CBytes as CBytes +import Z.Data.JSON (EncodeJSON, ToValue, FromValue) +import Z.Data.Vector as V +import qualified Z.Data.Text as T +import qualified Data.List as List import Z.Data.Array.Unaligned import Z.Foreign import Z.IO.Buffered @@ -101,7 +100,7 @@ -- | Process state data ProcessState = ProcessRunning PID | ProcessExited ExitCode deriving (Show, Eq, Ord, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (T.Print, EncodeJSON, ToValue, FromValue) -- | Wait until process exit and return the 'ExitCode'. waitProcessExit :: TVar ProcessState -> IO ExitCode diff --git a/Z/IO/Resource.hs b/Z/IO/Resource.hs --- a/Z/IO/Resource.hs +++ b/Z/IO/Resource.hs @@ -29,6 +29,8 @@ , initInPool , withResourceInPool , poolStat, poolInUse + -- * Re-export + , liftIO ) where import Control.Concurrent.STM diff --git a/Z/IO/StdStream.hs b/Z/IO/StdStream.hs --- a/Z/IO/StdStream.hs +++ b/Z/IO/StdStream.hs @@ -18,7 +18,7 @@ import qualified Z.Data.Builder as B main = do -- read by '\n' - b1 <- readLineStd + b1 <- readStd -- read whatever user input in 3s, otherwise get Nothing b2 <- timeoutLowRes 30 $ withMVar stdinBuf readBuffer ... @@ -45,11 +45,7 @@ , stdin, stdout, stderr , stdinBuf, stdoutBuf, stderrBuf -- * utils - , readLineStd - , printStd - , printLineStd - , putStd - , putLineStd + , readStd, printStd, putStd -- * re-export , withMVar -- * Constant @@ -63,9 +59,9 @@ import Control.Concurrent.MVar import Foreign.Ptr import System.IO.Unsafe -import Z.Data.Builder as B -import Z.Data.Vector as V -import qualified Z.Data.Text.ShowT as T +import qualified Z.Data.Builder as B +import qualified Z.Data.Text.Print as T +import qualified Z.Data.Vector as V import Z.IO.UV.FFI import Z.IO.UV.Manager import Z.IO.UV.Errno @@ -88,7 +84,7 @@ instance Show StdStream where show = T.toString -instance T.ShowT StdStream where +instance T.Print StdStream where toUTF8BuilderP p (StdTTY ptr slot uvm) = T.parenWhen (p > 10) $ do "StdTTY " T.toUTF8Builder ptr @@ -230,23 +226,13 @@ -------------------------------------------------------------------------------- --- | Print a 'ShowT' and flush to stdout. -printStd :: (HasCallStack, T.ShowT a) => a -> IO () +-- | Print a 'Print' and flush to stdout, with a linefeed. +printStd :: (HasCallStack, T.Print a) => a -> IO () printStd s = putStd (T.toUTF8Builder s) --- | Print a 'Builder' and flush to stdout. -putStd :: HasCallStack => Builder a -> IO () -putStd b = withMVar stdoutBuf $ \ o -> do - writeBuilder o b - flushBuffer o - --- | Print a 'ShowT' and flush to stdout, with a linefeed. -printLineStd :: (HasCallStack, T.ShowT a) => a -> IO () -printLineStd s = putLineStd (T.toUTF8Builder s) - -- | Print a 'Builder' and flush to stdout, with a linefeed. -putLineStd :: HasCallStack => Builder a -> IO () -putLineStd b = withMVar stdoutBuf $ \ o -> do +putStd :: HasCallStack => B.Builder a -> IO () +putStd b = withMVar stdoutBuf $ \ o -> do writeBuilder o (b >> B.char8 '\n') flushBuffer o @@ -254,8 +240,8 @@ -- -- This function will throw 'ECLOSED' when meet EOF, which may cause trouble if stdin is connected -- to a file, use 'readLine' instead. -readLineStd :: HasCallStack => IO V.Bytes -readLineStd = withMVar stdinBuf $ \ s -> do +readStd :: HasCallStack => IO V.Bytes +readStd = withMVar stdinBuf $ \ s -> do line <- readLine s case line of Just line' -> return line' Nothing -> throwIO (ResourceVanished diff --git a/Z/IO/StdStream/Ansi.hs b/Z/IO/StdStream/Ansi.hs --- a/Z/IO/StdStream/Ansi.hs +++ b/Z/IO/StdStream/Ansi.hs @@ -48,7 +48,6 @@ import qualified Z.Data.Builder as B import qualified Z.Data.Text as T -import qualified Z.Data.Text.ShowT as T import Data.Word import GHC.Generics @@ -247,7 +246,7 @@ | Cyan | White deriving (Eq, Ord, Bounded, Enum, Show, Read, Generic) - deriving anyclass T.ShowT + deriving anyclass T.Print colorToCode :: AnsiColor -> Word8 colorToCode c = case c of diff --git a/Z/IO/Time.hs b/Z/IO/Time.hs --- a/Z/IO/Time.hs +++ b/Z/IO/Time.hs @@ -14,7 +14,7 @@ -} module Z.IO.Time ( -- * SystemTime - SystemTime(..), getSystemTime + SystemTime(..), getSystemTime' -- * Parsing , parseSystemTime, parseSystemTimeGMT -- * Formatting @@ -29,7 +29,16 @@ import Foreign.C.Types import Z.Foreign import Z.Data.CBytes +import Z.IO.UV.FFI +import Z.IO.Exception import System.IO.Unsafe (unsafePerformIO) + + +-- | A alternative version of 'getSystemTime'' based on libuv's @uv_gettimeofday@, which also doesn't use pinned allocation. +getSystemTime' :: HasCallStack => IO SystemTime +getSystemTime' = do + (TimeVal64 s us) <- getTimeOfDay + return (MkSystemTime s (fromIntegral us * 1000)) -- | time format. type TimeFormat = CBytes diff --git a/Z/IO/UV/FFI.hsc b/Z/IO/UV/FFI.hsc --- a/Z/IO/UV/FFI.hsc +++ b/Z/IO/UV/FFI.hsc @@ -23,11 +23,11 @@ import Foreign.Ptr import Foreign.Storable import Z.Data.Array.Unaligned -import Z.Data.Text.ShowT (ShowT(..)) +import Z.Data.Text.Print (Print(..)) import Z.Data.JSON (EncodeJSON, ToValue, FromValue) import Z.Data.CBytes as CBytes import Z.Foreign -import Z.IO.Exception (throwUVIfMinus_, bracket) +import Z.IO.Exception (throwUVIfMinus_, bracket, HasCallStack) import Z.IO.Network.SocketAddr (SocketAddr) import System.Posix.Types (CSsize (..)) import GHC.Generics @@ -142,11 +142,12 @@ foreign import ccall unsafe uv_read_stop :: Ptr UVHandle -> IO CInt foreign import ccall unsafe hs_uv_write :: Ptr UVHandle -> Ptr Word8 -> Int -> IO UVSlotUnsafe +foreign import ccall unsafe hs_uv_shutdown :: Ptr UVHandle -> IO UVSlotUnsafe foreign import ccall unsafe hs_uv_accept_check_start :: Ptr UVHandle -> IO CInt -------------------------------------------------------------------------------- -- tcp & pipe -foreign import ccall unsafe hs_uv_tcp_open :: Ptr UVHandle -> FD -> IO CInt +foreign import ccall unsafe uv_tcp_open :: Ptr UVHandle -> FD -> IO CInt foreign import ccall unsafe uv_tcp_init :: Ptr UVLoop -> Ptr UVHandle -> IO CInt foreign import ccall unsafe uv_tcp_init_ex :: Ptr UVLoop -> Ptr UVHandle -> CUInt -> IO CInt foreign import ccall unsafe uv_tcp_nodelay :: Ptr UVHandle -> CInt -> IO CInt @@ -161,7 +162,7 @@ foreign import ccall unsafe hs_uv_tcp_connect :: Ptr UVHandle -> MBA## SocketAddr -> IO UVSlotUnsafe foreign import ccall unsafe hs_set_socket_reuse :: Ptr UVHandle -> IO CInt -foreign import ccall unsafe hs_uv_pipe_open :: Ptr UVHandle -> FD -> IO CInt +foreign import ccall unsafe uv_pipe_open :: Ptr UVHandle -> FD -> IO CInt foreign import ccall unsafe uv_pipe_init :: Ptr UVLoop -> Ptr UVHandle -> CInt -> IO CInt foreign import ccall unsafe uv_pipe_bind :: Ptr UVHandle -> BA## Word8 -> IO CInt foreign import ccall unsafe hs_uv_pipe_connect :: Ptr UVHandle -> BA## Word8 -> IO UVSlotUnsafe @@ -494,7 +495,7 @@ | DirEntChar | DirEntBlock deriving (Read, Show, Eq, Ord, Enum, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) fromUVDirEntType :: UVDirEntType -> DirEntType fromUVDirEntType t @@ -527,7 +528,7 @@ { uvtSecond :: {-# UNPACK #-} !CLong , uvtNanoSecond :: {-# UNPACK #-} !CLong } deriving (Show, Read, Eq, Ord, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) instance Storable UVTimeSpec where sizeOf _ = #{size uv_timespec_t} @@ -556,7 +557,7 @@ , stCtim :: {-# UNPACK #-} !UVTimeSpec , stBirthtim :: {-# UNPACK #-} !UVTimeSpec } deriving (Show, Read, Eq, Ord, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) uvStatSize :: Int uvStatSize = #{size uv_stat_t} @@ -639,7 +640,7 @@ data AccessResult = NoExistence | NoPermission | AccessOK deriving (Show, Eq, Ord, Enum, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) foreign import ccall unsafe hs_uv_fs_access :: BA## Word8 -> AccessMode -> IO Int foreign import ccall unsafe hs_uv_fs_access_threaded @@ -723,7 +724,7 @@ #endif deriving (Eq, Ord, Show, Read, Generic) deriving newtype (Storable, Prim, Unaligned, Num, EncodeJSON, ToValue, FromValue) - deriving anyclass ShowT + deriving anyclass Print newtype GID = GID #if defined(_WIN32) @@ -733,7 +734,7 @@ #endif deriving (Eq, Ord, Show, Read, Generic) deriving newtype (Storable, Prim, Unaligned, Num, EncodeJSON, ToValue, FromValue) - deriving anyclass ShowT + deriving anyclass Print type ProcessFlag = CUInt @@ -804,14 +805,14 @@ , processStdStreams :: (ProcessStdStream, ProcessStdStream, ProcessStdStream) -- ^ Specifying how (stdin, stdout, stderr) should be passed/created to the child, see 'ProcessStdStream' } deriving (Eq, Ord, Show, Read, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) data ProcessStdStream = ProcessIgnore -- ^ redirect process std stream to \/dev\/null | ProcessCreate -- ^ create a new std stream | ProcessInherit FD -- ^ pass an existing FD to child process as std stream deriving (Eq, Ord, Show, Read, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) processStdStreamFlag :: ProcessStdStream -> CInt processStdStreamFlag ProcessIgnore = #const UV_IGNORE @@ -891,7 +892,7 @@ { tv_sec :: {-# UNPACK #-} !CLong , tv_usec :: {-# UNPACK #-} !CLong } deriving (Show, Read, Eq, Ord, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) -- | Data type for resource usage results. -- @@ -915,7 +916,7 @@ , ru_nvcsw :: {-# UNPACK #-} !Word64 -- ^ voluntary context switches (X) , ru_nivcsw :: {-# UNPACK #-} !Word64 -- ^ involuntary context switches (X) } deriving (Show, Read, Eq, Ord, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) sizeOfResUsage :: Int sizeOfResUsage = #size uv_rusage_t @@ -952,7 +953,7 @@ newtype PID = PID CInt deriving (Eq, Ord, Show, Read, Generic) deriving newtype (Storable, Prim, Unaligned, EncodeJSON, ToValue, FromValue) - deriving anyclass ShowT + deriving anyclass Print type Priority = CInt pattern PRIORITY_LOW :: Priority @@ -987,16 +988,16 @@ , os_version :: CBytes , os_machine :: CBytes } deriving (Eq, Ord, Show, Read, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) -getOSName :: IO OSName +getOSName :: HasCallStack => IO OSName getOSName = do (MutableByteArray mba##) <- newByteArray (#size uv_utsname_t) throwUVIfMinus_ (uv_os_uname mba##) - sn <- peekMBA mba## (#offset uv_utsname_t, sysname) - re <- peekMBA mba## (#offset uv_utsname_t, release) - ve <- peekMBA mba## (#offset uv_utsname_t, version) - ma <- peekMBA mba## (#offset uv_utsname_t, machine) + sn <- peekMBACBytes mba## (#offset uv_utsname_t, sysname) + re <- peekMBACBytes mba## (#offset uv_utsname_t, release) + ve <- peekMBACBytes mba## (#offset uv_utsname_t, version) + ma <- peekMBACBytes mba## (#offset uv_utsname_t, machine) return (OSName sn re ve ma) foreign import ccall unsafe uv_os_uname :: MBA## OSName -> IO CInt @@ -1012,7 +1013,7 @@ , passwd_shell :: CBytes , passwd_homedir :: CBytes } deriving (Eq, Ord, Show, Read, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) foreign import ccall unsafe uv_os_get_passwd :: MBA## PassWD -> IO CInt foreign import ccall unsafe uv_os_free_passwd :: MBA## PassWD -> IO () @@ -1022,7 +1023,7 @@ -- The populated data includes the username, euid, gid, shell, and home directory. -- On non-Windows systems, all data comes from getpwuid_r(3). -- On Windows, uid and gid are set to -1 and have no meaning, and shell is empty. -getPassWD :: IO PassWD +getPassWD :: HasCallStack => IO PassWD getPassWD = bracket (do mpa@(MutableByteArray mba##) <- newByteArray (#size uv_passwd_t) throwUVIfMinus_ (uv_os_get_passwd mba##) @@ -1054,10 +1055,10 @@ , cpu_times_idle :: Word64 -- ^ milliseconds , cpu_times_irq :: Word64 -- ^ milliseconds } deriving (Eq, Ord, Show, Read, Generic) - deriving anyclass (ShowT, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) -- | Gets information about the CPUs on the system. -getCPUInfo :: IO [CPUInfo] +getCPUInfo :: HasCallStack => IO [CPUInfo] getCPUInfo = bracket (do (p, (len, _)) <- allocPrimUnsafe $ \ pp -> allocPrimUnsafe $ \ plen -> @@ -1087,6 +1088,26 @@ return ( indexPrimArray arr 0 , indexPrimArray arr 1 , indexPrimArray arr 2) + +-- | Alternative data type for storing times. +-- typedef struct { int64_t tv_sec; int32_t tv_usec; } uv_timeval64_t; +data TimeVal64 = TimeVal64 + { tv64_sec :: {-# UNPACK #-} !Int64 + , tv64_usec :: {-# UNPACK #-} !Int32 + } deriving (Show, Read, Eq, Ord, Generic) + deriving anyclass (Print, EncodeJSON, ToValue, FromValue) + +foreign import ccall unsafe uv_gettimeofday :: MBA## TimeVal64 -> IO CInt + +-- | Cross-platform implementation of . +-- The timezone argument to gettimeofday() is not supported, as it is considered obsolete. +getTimeOfDay :: HasCallStack => IO TimeVal64 +getTimeOfDay = do + (MutableByteArray mba##) <- newByteArray (#size uv_timeval64_t) + throwUVIfMinus_ (uv_gettimeofday mba##) + s <- peekMBA mba## (#offset uv_timeval64_t, tv_sec) + us <- peekMBA mba## (#offset uv_timeval64_t, tv_usec) + return (TimeVal64 s us) -------------------------------------------------------------------------------- -- fs event diff --git a/Z/IO/UV/Manager.hs b/Z/IO/UV/Manager.hs --- a/Z/IO/UV/Manager.hs +++ b/Z/IO/UV/Manager.hs @@ -56,7 +56,7 @@ import System.IO.Unsafe import Z.Data.Array import Z.Data.PrimRef.PrimIORef -import qualified Z.Data.Text.ShowT as T +import qualified Z.Data.Text.Print as T import Z.IO.Exception import Z.IO.Resource import Z.IO.UV.FFI @@ -81,7 +81,7 @@ instance Show UVManager where show = T.toString -instance T.ShowT UVManager where +instance T.Print UVManager where toUTF8BuilderP p uvm = T.parenWhen (p > 10) $ "UVManager on capability " >> T.int (uvmCap uvm) diff --git a/Z/IO/UV/UVStream.hs b/Z/IO/UV/UVStream.hs --- a/Z/IO/UV/UVStream.hs +++ b/Z/IO/UV/UVStream.hs @@ -17,12 +17,13 @@ , UVStream(..) , getUVStreamFD , closeUVStream + , shutdownUVStream , helloWorld, echo ) where import Control.Concurrent import Control.Monad -import qualified Z.Data.Text.ShowT as T +import qualified Z.Data.Text.Print as T import Z.IO.UV.Errno import Z.IO.UV.FFI import Z.IO.UV.Manager @@ -49,7 +50,7 @@ instance Show UVStream where show = T.toString -instance T.ShowT UVStream where +instance T.Print UVStream where toUTF8BuilderP _ (UVStream hdl slot uvm _) = do "UVStream{uvsHandle=" >> T.toUTF8Builder hdl ",uvsSlot=" >> T.toUTF8Builder slot @@ -88,6 +89,20 @@ c <- readIORef closed -- hs_uv_handle_close won't return error unless c $ writeIORef closed True >> hs_uv_handle_close hdl + +-- | Shutdown the outgoing (write) side of a duplex stream. It waits for pending write requests to complete. +-- +-- Futher writing will throw 'ResourceVanished'(EPIPE). +shutdownUVStream :: HasCallStack => UVStream -> IO () +shutdownUVStream (UVStream hdl _ uvm closed) = do + c <- readIORef closed + when c throwECLOSED + m <- withUVManager' uvm $ do + reqSlot <- getUVSlot uvm (hs_uv_shutdown hdl) + m <- getBlockMVar uvm reqSlot + _ <- tryTakeMVar m + return m + throwUVIfMinus_ (uninterruptibleMask_ $ takeMVar m) -- | Get stream fd getUVStreamFD :: HasCallStack => UVStream -> IO FD diff --git a/cbits/hs_uv_stream.c b/cbits/hs_uv_stream.c --- a/cbits/hs_uv_stream.c +++ b/cbits/hs_uv_stream.c @@ -93,54 +93,35 @@ } else return slot; } -//////////////////////////////////////////////////////////////////////////////// -// -// tcp - -/* on windows uv_tcp_open doesn't work propery for sockets that are not - * connected or accepted by libuv because the lack of some state initialization, - * so we do it by manually set those flags - * - * referenes: https://github.com/libuv/libuv/issues/397 - * https://github.com/libuv/libuv/pull/1150 - */ -#if defined(_WIN32) -void hs_uv_connection_init(uv_stream_t* handle){ - handle->flags |= UV_HANDLE_CONNECTION; - handle->stream.conn.write_reqs_pending = 0; - (&handle->read_req)->type = UV_READ; \ - (&handle->read_req)->u.io.overlapped.Internal = 0; /* SET_REQ_SUCCESS() */ - handle->read_req.event_handle = NULL; - handle->read_req.wait_handle = INVALID_HANDLE_VALUE; - handle->read_req.data = handle; - handle->stream.conn.shutdown_req = NULL; +void hs_shutdown_cb(uv_shutdown_t* req, int status){ + HsInt slot = (HsInt)req->data; + uv_loop_t* loop = req->handle->loop; + hs_loop_data* loop_data = loop->data; + loop_data->buffer_size_table[slot] = (HsInt)status; // 0 in case of success, < 0 otherwise. + loop_data->event_queue[loop_data->event_counter] = slot; // push the slot to event queue + loop_data->event_counter += 1; + free_slot(loop_data, slot); // free the uv_req_t } -int hs_uv_tcp_open(uv_tcp_t* handle, int32_t sock) { - int r = uv_tcp_open(handle, (uv_os_sock_t)sock); - if (r == 0) { - hs_uv_connection_init((uv_stream_t*)handle); - handle->flags |= UV_HANDLE_BOUND | UV_HANDLE_READABLE | UV_HANDLE_WRITABLE; - } - return r; -} +HsInt hs_uv_shutdown(uv_stream_t* handle){ + uv_loop_t* loop = handle->loop; + hs_loop_data* loop_data = loop->data; + HsInt slot = alloc_slot(loop_data); + if (slot < 0) return UV_ENOMEM; + uv_shutdown_t* req = + (uv_shutdown_t*)fetch_uv_struct(loop_data, slot); + req->data = (void*)slot; -int hs_uv_pipe_open(uv_pipe_t* handle, int32_t file) { - int r = uv_pipe_open(handle, (uv_file)file); - if (r == 0) { - hs_uv_connection_init((uv_stream_t*)handle); - handle->flags |= UV_HANDLE_BOUND | UV_HANDLE_READABLE | UV_HANDLE_WRITABLE; - } - return r; -} -#else -int hs_uv_tcp_open(uv_tcp_t* handle, int32_t sock) { - return uv_tcp_open(handle, (uv_os_sock_t)sock); -} -int hs_uv_pipe_open(uv_pipe_t* handle, int32_t sock) { - return uv_pipe_open(handle, (uv_os_sock_t)sock); + int r = uv_shutdown(req, handle, hs_shutdown_cb); + if (r < 0) { + free_slot(loop_data, slot); // free the uv_req_t, the callback won't fired + return (HsInt)r; + } else return slot; } -#endif + +//////////////////////////////////////////////////////////////////////////////// +// +// tcp void hs_connect_cb(uv_connect_t* req, int status){ HsInt slot = (HsInt)req->data; diff --git a/include/hs_uv.h b/include/hs_uv.h --- a/include/hs_uv.h +++ b/include/hs_uv.h @@ -269,22 +269,15 @@ int hs_uv_read_start(uv_stream_t* handle); HsInt hs_uv_write(uv_stream_t* handle, char* buf, HsInt buf_size); int hs_uv_accept_check_start(uv_check_t* check); +HsInt hs_uv_shutdown(uv_stream_t* handle); //////////////////////////////////////////////////////////////////////////////// // tcp and pipe -int hs_uv_tcp_open(uv_tcp_t* handle, int32_t sock); -HsInt hs_uv_tcp_connect(uv_tcp_t* handle, const struct sockaddr* addr); -int hs_uv_pipe_open(uv_pipe_t* handle, int32_t sock); +HsInt hs_uv_tcp_connect(uv_tcp_t* handle, const struct sockaddr* addr); HsInt hs_uv_pipe_connect(uv_pipe_t* handle, const char* name); #if defined(_WIN32) -#define UV_HANDLE_READING 0x00000100 -#define UV_HANDLE_BOUND 0x00000200 -#define UV_HANDLE_LISTENING 0x00000800 -#define UV_HANDLE_CONNECTION 0x00001000 -#define UV_HANDLE_READABLE 0x00008000 -#define UV_HANDLE_WRITABLE 0x00010000 enum { UV__SIGNAL_ONE_SHOT = 0x80000, /* On signal reception remove sighandler */ UV__HANDLE_INTERNAL = 0x8000, diff --git a/test/Z/IO/FileSystem/ThreadedSpec.hs b/test/Z/IO/FileSystem/ThreadedSpec.hs --- a/test/Z/IO/FileSystem/ThreadedSpec.hs +++ b/test/Z/IO/FileSystem/ThreadedSpec.hs @@ -5,6 +5,7 @@ import Control.Concurrent.MVar (readMVar) import Control.Monad import Data.Bits +import Z.Data.ASCII import Z.Data.Vector as V import Z.Data.Vector.Base as V import Data.List as List @@ -69,13 +70,13 @@ withResource (initFile filename flags mode) $ \ file -> do i <- newBufferedInput' 4096 file Just firstLine <- readLine i - firstLine @=? fst (V.break (== V.c2w '\n') content2) + firstLine @=? fst (V.break (== c2w '\n') content2) fr <- newFilePtrT file (fromIntegral $ size2 `div` 2) i <- newBufferedInput' 4096 fr replicateM_ 512 $ do Just firstLine <- readLine i - firstLine @=? fst (V.break (== V.c2w '\n') content2) + firstLine @=? fst (V.break (== c2w '\n') content2) unlink filename diff --git a/test/Z/IO/FileSystemSpec.hs b/test/Z/IO/FileSystemSpec.hs --- a/test/Z/IO/FileSystemSpec.hs +++ b/test/Z/IO/FileSystemSpec.hs @@ -5,6 +5,7 @@ import Control.Concurrent.MVar (readMVar) import Control.Monad import Data.Bits +import Z.Data.ASCII import Z.Data.Vector as V import Z.Data.Vector.Base as V import Data.List as List @@ -71,13 +72,13 @@ withResource (initFile filename flags mode) $ \ file -> do i <- newBufferedInput' 4096 file Just firstLine <- readLine i - firstLine @?= fst (V.break (== V.c2w '\n') content2) + firstLine @?= fst (V.break (== c2w '\n') content2) fr <- newFilePtr file (fromIntegral $ size2 `div` 2) i <- newBufferedInput' 4096 fr replicateM_ 512 $ do Just firstLine <- readLine i - firstLine @=? fst (V.break (== V.c2w '\n') content2) + firstLine @=? fst (V.break (== c2w '\n') content2) unlink filename