diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -4,7 +4,7 @@ * Add `getSystemTime'` to `Z.IO.Time`. * Add `shutdownUVStream` to `Z.IO.UV.UVStream`. -* Rename `sourceFrom/sinkToFile` to `initSourceFrom/initSinkToFile`. +* Change `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.3.0.0 +version: 0.4.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! @@ -120,13 +120,13 @@ -- Z.Compression.Zlib - build-depends: base >= 4.12 && < 5.0 + build-depends: base >= 4.12 && <5.0 , exceptions == 0.10.* , primitive >= 0.7.1 && < 0.7.2 , stm == 2.5.* , unordered-containers == 0.2.* , containers == 0.6.* - , Z-Data == 0.3.* + , Z-Data == 0.4.* , time >= 1.9 && <= 2.0 , unix-time >= 0.4.7 && <= 0.5 @@ -364,7 +364,6 @@ , HUnit , QuickCheck >= 2.10 , quickcheck-instances - , word8 , scientific , primitive , zlib diff --git a/Z/IO/BIO.hs b/Z/IO/BIO.hs --- a/Z/IO/BIO.hs +++ b/Z/IO/BIO.hs @@ -47,7 +47,6 @@ module Z.IO.BIO ( -- * The BIO type BIO(..), Source, Sink - , BIOException(..), BIOParseException(..), JSONConvertException(..) -- ** Basic combinators , (>|>), (>~>), (>!>), appendSource , concatSource, zipSource, zipBIO @@ -91,7 +90,6 @@ import qualified Data.List as List import Data.Sequence (Seq (..)) import qualified Data.Sequence as Seq -import Data.Typeable (cast) import Data.Void import Data.Word import System.IO.Unsafe (unsafePerformIO) @@ -99,7 +97,6 @@ import qualified Z.Data.Builder as B import Z.Data.CBytes (CBytes) import qualified Z.Data.JSON as JSON -import qualified Z.Data.JSON.Value as JSON import qualified Z.Data.Parser as P import Z.Data.PrimRef import qualified Z.Data.Text as T @@ -144,10 +141,10 @@ -- in multiple threads, check "Z.IO.BIO.Concurrent" module. -- data BIO inp out = BIO - { push :: HasCallStack => inp -> IO (Maybe out) + { push :: inp -> IO (Maybe out) -- ^ Push a block of input, perform some effect, and return output, -- if input is not enough to produce any output yet, return 'Nothing'. - , pull :: HasCallStack => IO (Maybe out) + , pull :: IO (Maybe out) -- ^ When input reaches EOF, there may be a finalize stage to output -- trailing output blocks. return 'Nothing' to indicate current node -- reaches EOF too. @@ -175,44 +172,6 @@ r <- pull return $! fmap f r --- | Exception when run BIO failed. --- --- Note this exception is a sub-type of 'SomeIOException'. -data BIOException = forall e. Exception e => BIOException e - -instance Show BIOException where - show (BIOException e) = show e - -instance Exception BIOException where - toException = ioExceptionToException - fromException = ioExceptionFromException - -bioExceptionToException :: Exception e => e -> SomeException -bioExceptionToException = toException . BIOException - -bioExceptionFromException :: Exception e => SomeException -> Maybe e -bioExceptionFromException x = do - BIOException a <- fromException x - cast a - --- | Exception when BIO parse failed, this exception is one of a particular --- 'BIOException'. -data BIOParseException = BIOParseException P.ParseError CallStack - deriving Show - -instance Exception BIOParseException where - toException = bioExceptionToException - fromException = bioExceptionFromException - --- | Exception when BIO convert to json failed, this exception is one of a --- particular 'BIOException'. -data JSONConvertException = JSONConvertException JSON.ConvertError CallStack - deriving Show - -instance Exception JSONConvertException where - toException = bioExceptionToException - fromException = bioExceptionFromException - infixl 3 >|> infixl 3 >~> @@ -354,12 +313,12 @@ -- Run BIO -- | Run a 'BIO' loop (source >|> ... >|> sink). -runBIO :: BIO Void Void -> IO () +runBIO :: HasCallStack => BIO Void Void -> IO () {-# INLINABLE runBIO #-} runBIO BIO{..} = pull >> return () -- | Drain a 'BIO' source into a List in memory. -runSource :: Source x -> IO [x] +runSource :: HasCallStack => Source x -> IO [x] {-# INLINABLE runSource #-} runSource BIO{..} = loop pull [] where @@ -369,7 +328,7 @@ _ -> return (List.reverse acc) -- | Drain a source without collecting result. -runSource_ :: Source x -> IO () +runSource_ :: HasCallStack => Source x -> IO () {-# INLINABLE runSource_ #-} runSource_ BIO{..} = loop pull where @@ -476,7 +435,7 @@ -- | Turn a 'BufferedInput' into 'BIO' source, map EOF to Nothing. -- -sourceFromBuffered :: BufferedInput -> Source V.Bytes +sourceFromBuffered :: HasCallStack => BufferedInput -> Source V.Bytes {-# INLINABLE sourceFromBuffered #-} sourceFromBuffered i = BIO{ pull = do readBuffer i >>= \ x -> if V.null x then return Nothing @@ -484,7 +443,7 @@ -- | Turn a UTF8 encoded 'BufferedInput' into 'BIO' source, map EOF to Nothing. -- -sourceTextFromBuffered :: BufferedInput -> Source T.Text +sourceTextFromBuffered :: HasCallStack => BufferedInput -> Source T.Text {-# INLINABLE sourceTextFromBuffered #-} sourceTextFromBuffered i = BIO{ pull = do readBufferText i >>= \ x -> if T.null x then return Nothing @@ -492,18 +451,21 @@ -- | Turn a 'JSON' encoded 'BufferedInput' into 'BIO' source, ignoring any -- whitespaces bewteen JSON objects. If EOF reached, then return Nothing. -sourceJSONFromBuffered :: forall a. JSON.FromValue a => BufferedInput -> Source a +-- Throw 'OtherError' with name "EJSON" if JSON value is not parsed or converted. +sourceJSONFromBuffered :: forall a. (JSON.JSON a, HasCallStack) => BufferedInput -> Source a {-# INLINABLE sourceJSONFromBuffered #-} -sourceJSONFromBuffered i = sourceParsedBufferInput JSON.value i >!> convert - where - convert :: JSON.Value -> IO a - convert jval = - case JSON.convert' jval of - Left e -> throwIO $ JSONConvertException e callStack - Right r -> return r +sourceJSONFromBuffered bi = BIO{ pull = do + bs <- readBuffer bi + if V.null bs + then return Nothing + else do + (rest, r) <- JSON.decodeChunks (readBuffer bi) bs + unReadBuffer rest bi + case r of Right v -> return (Just v) + Left e -> throwOtherError "EJSON" (T.toText e) } --- | Turn buffered input device into a packet source. -sourceParsedBufferInput :: P.Parser a -> BufferedInput -> Source a +-- | Turn buffered input device into a packet source, throw 'OtherError' with name @EPARSE@ if parsing fail. +sourceParsedBufferInput :: HasCallStack => P.Parser a -> BufferedInput -> Source a {-# INLINABLE sourceParsedBufferInput #-} sourceParsedBufferInput p bi = BIO{ pull = do bs <- readBuffer bi @@ -513,32 +475,34 @@ (rest, r) <- P.parseChunks p (readBuffer bi) bs unReadBuffer rest bi case r of Right v -> return (Just v) - Left e -> throwIO (BIOParseException e callStack)} + Left e -> throwOtherError "EPARSE" (T.toText e) } -- | Turn an input device into a 'V.Bytes' source. -sourceFromInput :: Input i => i -> IO (Source V.Bytes) +sourceFromInput :: (HasCallStack, Input i) => i -> IO (Source V.Bytes) {-# INLINABLE sourceFromInput #-} sourceFromInput i = sourceFromBuffered <$> newBufferedInput i -- | Turn an input device into a 'T.Text' source. -sourceTextFromInput :: Input i => i -> IO (Source T.Text) +sourceTextFromInput :: (HasCallStack, Input i) => i -> IO (Source T.Text) {-# INLINABLE sourceTextFromInput #-} sourceTextFromInput i = sourceTextFromBuffered <$> newBufferedInput i -- | Turn an input device into a 'JSON' source. -sourceJSONFromInput :: (Input i, JSON.FromValue a) => i -> IO (Source a) +-- +-- Throw 'OtherError' with name "EJSON" if JSON value is not parsed or converted. +sourceJSONFromInput :: (HasCallStack, Input i, JSON.JSON a) => i -> IO (Source a) sourceJSONFromInput i = sourceJSONFromBuffered <$> newBufferedInput i {-# INLINABLE sourceJSONFromInput #-} -- | Turn a file into a 'V.Bytes' source. -initSourceFromFile :: CBytes -> Resource (Source V.Bytes) +initSourceFromFile :: HasCallStack => CBytes -> Resource (Source V.Bytes) {-# INLINABLE initSourceFromFile #-} initSourceFromFile p = do f <- FS.initFile p FS.O_RDONLY FS.DEFAULT_MODE liftIO (sourceFromInput f) -- | Turn input device into a packet source. -sourceParsedInput :: Input i => P.Parser a -> i -> IO (Source a) +sourceParsedInput :: (Input i, HasCallStack) => P.Parser a -> i -> IO (Source a) {-# INLINABLE sourceParsedInput #-} sourceParsedInput p i = sourceParsedBufferInput p <$> newBufferedInput i @@ -546,7 +510,7 @@ -- Sink -- | Turn a 'BufferedOutput' into a 'V.Bytes' sink. -sinkToBuffered :: BufferedOutput -> Sink V.Bytes +sinkToBuffered :: HasCallStack => BufferedOutput -> Sink V.Bytes {-# INLINABLE sinkToBuffered #-} sinkToBuffered bo = BIO push_ pull_ where @@ -555,7 +519,7 @@ -- | Turn a 'BufferedOutput' into a 'B.Builder' sink. -- -sinkBuilderToBuffered :: BufferedOutput -> Sink (B.Builder a) +sinkBuilderToBuffered :: HasCallStack => BufferedOutput -> Sink (B.Builder a) {-# INLINABLE sinkBuilderToBuffered #-} sinkBuilderToBuffered bo = BIO push_ pull_ where @@ -586,7 +550,7 @@ -- | Turn an 'Output' into 'B.Builder' sink. -- -- 'push' will write input to buffer, and 'pull'_ will flush buffer. -sinkBuilderToOutput :: Output o => o -> IO (Sink (B.Builder ())) +sinkBuilderToOutput :: (Output o, HasCallStack) => o -> IO (Sink (B.Builder ())) {-# INLINABLE sinkBuilderToOutput #-} sinkBuilderToOutput o = newBufferedOutput o >>= \ bo -> return (BIO (push_ bo) (pull_ bo)) @@ -597,7 +561,7 @@ -- | Turn an 'Output' into 'BIO' sink. -- -- 'push' will write input to buffer then perform flush, tend to degrade performance. -sinkToIO :: (a -> IO ()) -> Sink a +sinkToIO :: HasCallStack => (a -> IO ()) -> Sink a {-# INLINABLE sinkToIO #-} sinkToIO f = BIO push_ pull_ where @@ -669,9 +633,8 @@ -- 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 'BIOParseException' if --- parsing fail. -newParserNode :: P.Parser a -> IO (BIO V.Bytes a) +-- Return 'Nothing' if reach EOF before parsing, throw 'OtherError' with name @EPARSE@ if parsing fail. +newParserNode :: HasCallStack => P.Parser a -> IO (BIO V.Bytes a) {-# INLINABLE newParserNode #-} newParserNode p = do -- type LastParseState = Either V.Bytes (V.Bytes -> P.Result) @@ -688,7 +651,7 @@ writeIORef resultRef (Left trailing') return (Just a) P.Failure e _ -> - throwIO (BIOParseException e callStack) + throwOtherError "EPARSE" (T.toText e) P.Partial f' -> do writeIORef resultRef (Right f') return Nothing @@ -708,19 +671,21 @@ writeIORef resultRef (Left trailing') return (Just a) P.Failure e _ -> - throwIO (BIOParseException e callStack) + throwOtherError "EPARSE" (T.toText e) P.Partial _ -> - throwIO (BIOParseException ["last chunk partial parse"] callStack) + throwOtherError "EPARSE" "last chunk partial parse" -- | Make a new UTF8 decoder, which decode bytes streams into text streams. -- --- Note this node is supposed to be used with preprocess node such as compressor, decoder, etc. where bytes --- boundary cannot be controlled, UTF8 decoder will concat trailing bytes from last block to next one. --- Use this node directly with 'sourceFromBuffered' \/ 'sourceFromInput' will not be as efficient as directly use --- 'sourceTextFromBuffered' \/ 'sourceTextFromInput', because 'BufferedInput' provides push back capability, --- trailing bytes can be pushde back to reading buffer and returned with next block input together. +-- If there're invalid UTF8 bytes, an 'OtherError' with name 'EINVALIDUTF8' will be thrown.` -- -newUTF8Decoder :: IO (BIO V.Bytes T.Text) +-- Note this node is supposed to be used with preprocess node such as compressor, decoder, etc. where bytes +-- boundary cannot be controlled, UTF8 decoder will concat trailing bytes from last block to next one. +-- Use this node directly with 'sourceFromBuffered' \/ 'sourceFromInput' will not be as efficient as directly use +-- 'sourceTextFromBuffered' \/ 'sourceTextFromInput', because 'BufferedInput' provides push back capability, +-- trailing bytes can be pushde back to reading buffer and returned with next block input together. +-- +newUTF8Decoder :: HasCallStack => IO (BIO V.Bytes T.Text) {-# INLINABLE newUTF8Decoder #-} newUTF8Decoder = do trailingRef <- newIORef V.empty @@ -734,7 +699,7 @@ then do let (i, _) = V.findR (\ w -> w >= 0b11000000 || w <= 0b01111111) chunk if (i == -1) - then throwIO (T.InvalidUTF8Exception callStack) + then throwOtherError "EINVALIDUTF8" "invalid UTF8 bytes" else do if T.decodeCharLen arr (s + i) > l - i then do @@ -751,7 +716,7 @@ trailing <- readIORef trailingRef if V.null trailing then return Nothing - else throwIO (T.InvalidUTF8Exception callStack) + else throwOtherError "EINVALIDUTF8" "invalid UTF8 bytes" -- | Make a new stream splitter based on magic byte. -- 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 @@ -54,7 +54,7 @@ import GHC.Generics import Z.Data.Array as A import Z.Data.CBytes as CBytes -import Z.Data.JSON (EncodeJSON, FromValue, ToValue) +import Z.Data.JSON (JSON) import Z.Data.Text.Print (Print) import Z.Data.Vector.Base as V import Z.Foreign @@ -110,7 +110,7 @@ , compressStrategy :: Strategy , compressBufferSize :: Int } deriving (Show, Eq, Ord, Generic) - deriving anyclass (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) defaultCompressConfig :: CompressConfig defaultCompressConfig = @@ -204,7 +204,7 @@ , decompressDictionary :: V.Bytes , decompressBufferSize :: Int } deriving (Show, Eq, Ord, Generic) - deriving anyclass (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) defaultDecompressConfig :: DecompressConfig defaultDecompressConfig = DecompressConfig defaultWindowBits V.empty V.defaultChunkSize diff --git a/Z/IO/Buffered.hs b/Z/IO/Buffered.hs --- a/Z/IO/Buffered.hs +++ b/Z/IO/Buffered.hs @@ -33,8 +33,6 @@ , writeBuffer , writeBuilder , flushBuffer - -- * Exceptions - , IncompleteInput(..) -- * common buffer size , V.defaultChunkSize , V.smallChunkSize @@ -63,7 +61,7 @@ -- 'readInput' should return 0 on EOF. -- class Input i where - readInput :: HasCallStack => i -> Ptr Word8 -> Int -> IO Int + readInput :: i -> Ptr Word8 -> Int -> IO Int -- | Output device -- @@ -71,7 +69,7 @@ -- necessarily flushed to hardware, that should be done in device specific way). -- class Output o where - writeOutput :: HasCallStack => o -> Ptr Word8 -> Int -> IO () + writeOutput :: o -> Ptr Word8 -> Int -> IO () -- | Input device with buffer, NOT THREAD SAFE! -- @@ -82,7 +80,7 @@ -- are opened on a same 'Input' device, the behaviour is undefined. -- data BufferedInput = BufferedInput - { bufInput :: HasCallStack => Ptr Word8 -> Int -> IO Int + { bufInput :: Ptr Word8 -> Int -> IO Int , bufPushBack :: {-# UNPACK #-} !(IORef V.Bytes) , inputBuffer :: {-# UNPACK #-} !(IORef (MutablePrimArray RealWorld Word8)) } @@ -96,7 +94,7 @@ -- are opened on a same 'BufferedOutput' device, the output will be interleaved. -- data BufferedOutput = BufferedOutput - { bufOutput :: HasCallStack => Ptr Word8 -> Int -> IO () + { bufOutput :: Ptr Word8 -> Int -> IO () , bufIndex :: {-# UNPACK #-} !Counter , outputBuffer :: {-# UNPACK #-} !(MutablePrimArray RealWorld Word8) } @@ -167,7 +165,8 @@ -- | Request UTF8 'T.Text' chunk from 'BufferedInput'. -- -- The buffer size must be larger than 4 bytes to guarantee decoding progress. If there're --- trailing bytes before EOF, 'IncompleteInput' are thrown. +-- trailing bytes before EOF, an 'OtherError' with name 'EINCOMPLETE' will be thrown, if there're +-- invalid UTF8 bytes, an 'OtherError' with name 'EINVALIDUTF8' will be thrown.` readBufferText :: HasCallStack => BufferedInput -> IO T.Text readBufferText BufferedInput{..} = do pb <- readIORef bufPushBack @@ -190,7 +189,7 @@ copyPrimArray rbuf 0 arr s delta l <- bufInput (mutablePrimArrayContents rbuf `plusPtr` delta) (bufSiz - delta) -- if EOF is reached, no further progress is possible - when (l == 0) (throwIO (IncompleteInput callStack)) + when (l == 0) (throwOtherError "EINCOMPLETE" "input is incomplete") handleBuf (l + delta) where handleBuf l = do @@ -215,7 +214,7 @@ | otherwise = do let (i, _) = V.findR (\ w -> w >= 0b11000000 || w <= 0b01111111) bs if (i == -1) - then throwIO (T.InvalidUTF8Exception callStack) + then throwOtherError "EINVALIDUTF8" "invalid UTF8 bytes" else do if T.decodeCharLen arr (s + i) > l - i then do @@ -225,7 +224,7 @@ -- | Read exactly N bytes. -- --- If EOF reached before N bytes read, a 'IncompleteInput' will be thrown +-- If EOF reached before N bytes read, an 'OtherError' with name 'EINCOMPLETE' will be thrown. readExactly :: HasCallStack => Int -> BufferedInput -> IO V.Bytes readExactly n0 h0 = V.concat `fmap` (go h0 n0) where @@ -240,7 +239,7 @@ else if l == n then return [chunk] else if l == 0 - then throwIO (IncompleteInput callStack) + then throwOtherError "EINCOMPLETE" "input is incomplete" else do chunks <- go h (n - l) return (chunk : chunks) @@ -264,14 +263,6 @@ -- Useful for reading small file into memory. readAll' :: HasCallStack => BufferedInput -> IO V.Bytes readAll' i = V.concat <$> readAll i - --- | Exceptions when read not enough input. --- --- Note this exception is a sub-type of 'SomeIOException'. -data IncompleteInput = IncompleteInput CallStack deriving Show -instance Exception IncompleteInput where - toException = ioExceptionToException - fromException = ioExceptionFromException -- | Push bytes back into buffer(if not empty). -- diff --git a/Z/IO/Exception.hs b/Z/IO/Exception.hs --- a/Z/IO/Exception.hs +++ b/Z/IO/Exception.hs @@ -64,6 +64,11 @@ , throwECLOSED , throwECLOSEDSTM , throwUVError + , throwOtherError + -- * Unwrapping Either/ / Maybe result + , UnwrapException(..) + , unwrap + , unwrapJust -- * Re-exports , module Control.Exception , HasCallStack @@ -75,7 +80,7 @@ import Control.Concurrent.STM import Control.Exception hiding (IOException) import Control.Monad -import Data.Typeable (cast) +import Data.Typeable (Typeable, cast) import Foreign.C.Types import Foreign.Ptr import GHC.Stack @@ -169,15 +174,45 @@ desc <- uvStdError errno' throwUVError errno' (IOEInfo name desc callStack) --- | Throw 'E.ResourceVanished' with name 'ECLOSED' and description 'resource is closed'. +-- | Throw 'ResourceVanished' with name 'ECLOSED' and description 'resource is closed'. -- throwECLOSED :: HasCallStack => IO a +{-# INLINABLE throwECLOSED #-} throwECLOSED = throwIO (ResourceVanished (IOEInfo "ECLOSED" "resource is closed" callStack)) +-- | STM version of 'throwECLOSED'. throwECLOSEDSTM :: HasCallStack => STM a +{-# INLINABLE throwECLOSEDSTM #-} throwECLOSEDSTM = throwSTM (ResourceVanished (IOEInfo "ECLOSED" "resource is closed" callStack)) + +-- | Throw 'OtherError' with custom name and description. +throwOtherError :: HasCallStack => T.Text -> T.Text -> IO a +{-# INLINABLE throwOtherError #-} +throwOtherError name desc = throwIO (OtherError (IOEInfo name desc callStack)) + +-------------------------------------------------------------------------------- + +-- | Exception for 'unwrap' \/ 'unwrapJust'. +data UnwrapException e + = UnwrapEitherException CallStack e + | UnwrapMaybeException CallStack + deriving Show + +instance (Typeable e, Show e) => Exception (UnwrapException e) + +-- | Try to unwrap a value from 'Right', throw @UnwrapException e@ if 'Left e'. +unwrap :: (HasCallStack, Show e, Typeable e) => Either e a -> IO a +{-# INLINABLE unwrap #-} +unwrap (Right x) = return x +unwrap (Left e) = throwIO (UnwrapEitherException callStack e) + +-- | Try to unwrap a value from 'Just', throw @UnwrapException ()@ if 'Nothing'. +unwrapJust :: HasCallStack => Maybe a -> IO a +{-# INLINABLE unwrapJust #-} +unwrapJust (Just x) = return x +unwrapJust Nothing = throwIO (UnwrapMaybeException callStack :: UnwrapException ()) -------------------------------------------------------------------------------- diff --git a/Z/IO/FileSystem.hs b/Z/IO/FileSystem.hs --- a/Z/IO/FileSystem.hs +++ b/Z/IO/FileSystem.hs @@ -13,8 +13,9 @@ module Z.IO.FileSystem ( -- * regular file devices - File, initFile, readFile, writeFile, getFileFD, seek - , quickReadFile, quickReadTextFile, quickWriteFile, quickWriteTextFile + File, initFile, readFileP, writeFileP, getFileFD, seek + , readFile, readTextFile, writeFile, writeTextFile + , readJSONFile, writeJSONFile -- * file offset bundle , FilePtr, newFilePtr, getFilePtrOffset, setFilePtrOffset -- * filesystem operations @@ -115,6 +116,7 @@ import qualified Z.Data.Text as T import qualified Z.Data.Text.Print as T import qualified Z.Data.Vector as V +import qualified Z.Data.JSON as JSON import Z.Foreign import Z.IO.Buffered import Z.IO.Exception @@ -130,7 +132,7 @@ -- -- libuv implements read and write method with both implict and explict offset capable. -- Implict offset interface is provided by 'Input' \/ 'Output' instances. --- Explict offset interface is provided by 'readFile' \/ 'writeFile'. +-- Explict offset interface is provided by 'readFileP' \/ 'writeFileP'. -- data File = File {-# UNPACK #-} !FD -- ^ the file {-# UNPACK #-} !(IORef Bool) -- ^ closed flag @@ -161,22 +163,22 @@ instance Input File where -- readInput :: HasCallStack => File -> Ptr Word8 -> Int -> IO Int -- use -1 offset to use fd's default offset - readInput f buf bufSiz = readFile f buf bufSiz (-1) + readInput f buf bufSiz = readFileP f buf bufSiz (-1) -- | Read file with given offset -- -- Read length may be smaller than buffer size. -readFile :: HasCallStack +readFileP :: HasCallStack => File -> Ptr Word8 -- ^ buffer -> Int -- ^ buffer size -> Int64 -- ^ file offset, pass -1 to use default(system) offset -> IO Int -- ^ read length -readFile uvf buf bufSiz off = +readFileP uvf buf bufSiz off = checkFileClosed uvf $ \ fd -> throwUVIfMinus $ hs_uv_fs_read fd buf bufSiz off instance Output File where - writeOutput f buf bufSiz = writeFile f buf bufSiz (-1) + writeOutput f buf bufSiz = writeFileP f buf bufSiz (-1) -- | Write buffer to file -- @@ -190,13 +192,13 @@ -- if a file is opened with O_APPEND, pwrite() appends data to the end of the file, -- regardless of the value of offset. -- @ -writeFile :: HasCallStack +writeFileP :: HasCallStack => File -> Ptr Word8 -- ^ buffer -> Int -- ^ buffer size -> Int64 -- ^ file offset, pass -1 to use default(system) offset -> IO () -writeFile uvf buf0 bufSiz0 off0 = +writeFileP uvf buf0 bufSiz0 off0 = checkFileClosed uvf $ \fd -> if off0 == -1 then go fd buf0 bufSiz0 else go' fd buf0 bufSiz0 off0 where @@ -217,7 +219,7 @@ -- Reading or writing using 'Input' \/ 'Output' instance will automatically increase offset. -- 'FilePtr' and its operations are NOT thread safe, use 'MVar' 'FilePtr' in multiple threads. -- --- The notes on linux 'writeFile' applied to 'FilePtr' too. +-- The notes on linux 'writeFileP' applied to 'FilePtr' too. data FilePtr = FilePtr {-# UNPACK #-} !File {-# UNPACK #-} !(PrimIORef Int64) @@ -239,14 +241,14 @@ instance Input FilePtr where readInput (FilePtr file offsetRef) buf bufSiz = readPrimIORef offsetRef >>= \ off -> do - l <- readFile file buf bufSiz off + l <- readFileP file buf bufSiz off writePrimIORef offsetRef (off + fromIntegral l) return l instance Output FilePtr where writeOutput (FilePtr file offsetRef) buf bufSiz = readPrimIORef offsetRef >>= \ off -> do - writeFile file buf bufSiz off + writeFileP file buf bufSiz off writePrimIORef offsetRef (off + fromIntegral bufSiz) -------------------------------------------------------------------------------- @@ -255,7 +257,8 @@ -- -- Resource closing is thread safe, on some versions of OSX, repeatly open and close same file 'Resource' may -- result in shared memory object error, use 'O_CREAT' to avoid that. -initFile :: CBytes +initFile :: HasCallStack + => CBytes -> FileFlag -- ^ Opening flags, e.g. 'O_CREAT' @.|.@ 'O_RDWR' -> FileMode -- ^ Sets the file mode (permission and sticky bits), -- but only if the file was created, see 'DEFAULT_MODE'. @@ -272,24 +275,33 @@ writeIORef closedRef True) -- | Quickly open a file and read its content. -quickReadFile :: HasCallStack => CBytes -> IO V.Bytes -quickReadFile filename = do +readFile :: HasCallStack => CBytes -> IO V.Bytes +readFile filename = do withResource (initFile filename O_RDONLY DEFAULT_MODE) $ \ file -> do readAll' =<< newBufferedInput file -- | Quickly open a file and read its content as UTF8 text. -quickReadTextFile :: HasCallStack => CBytes -> IO T.Text -quickReadTextFile filename = T.validate <$> quickReadFile filename +readTextFile :: HasCallStack => CBytes -> IO T.Text +readTextFile filename = T.validate <$> readFile filename -- | Quickly open a file and write some content. -quickWriteFile :: HasCallStack => CBytes -> V.Bytes -> IO () -quickWriteFile filename content = do +writeFile :: HasCallStack => CBytes -> V.Bytes -> IO () +writeFile filename content = do withResource (initFile filename (O_WRONLY .|. O_CREAT) DEFAULT_MODE) $ \ file -> do withPrimVectorSafe content (writeOutput file) -- | Quickly open a file and write some content as UTF8 text. -quickWriteTextFile :: HasCallStack => CBytes -> T.Text -> IO () -quickWriteTextFile filename content = quickWriteFile filename (T.getUTF8Bytes content) +writeTextFile :: HasCallStack => CBytes -> T.Text -> IO () +writeTextFile filename content = writeFile filename (T.getUTF8Bytes content) + +-- | Quickly open a file and read its content as a JSON value. +-- Throw 'OtherError' with name @EJSON@ if JSON value is not parsed or converted. +readJSONFile :: (HasCallStack, JSON.JSON a) => CBytes -> IO a +readJSONFile filename = unwrap . JSON.decode' =<< readFile filename + +-- | Quickly open a file and write a JSON Value. +writeJSONFile :: (HasCallStack, JSON.JSON a) => CBytes -> a -> IO () +writeJSONFile filename x = writeFile filename (JSON.encode x) -------------------------------------------------------------------------------- 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 @@ -43,7 +43,7 @@ import GHC.Generics import qualified Z.Data.CBytes as CB import Z.Data.CBytes (CBytes(CB), allocCBytesUnsafe, withCBytesUnsafe, withCBytesListUnsafe) -import Z.Data.JSON (FromValue, ToValue, EncodeJSON) +import Z.Data.JSON (JSON) import qualified Z.Data.Text as T import qualified Z.Data.Vector.Base as V import qualified Z.Data.Vector as V @@ -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.Print, FromValue, ToValue, EncodeJSON) + deriving anyclass (T.Print, JSON) 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 @@ -21,8 +21,9 @@ module Z.IO.FileSystem.Threaded ( -- * regular file devices - File, initFile, readFile, writeFile, getFileFD, seek - , quickReadFile, quickReadTextFile, quickWriteFile, quickWriteTextFile + File, initFile, readFileP, writeFileP, getFileFD, seek + , readFile, readTextFile, writeFile, writeTextFile + , readJSONFile, writeJSONFile -- * file offset bundle , FilePtrT, newFilePtrT, getFilePtrOffset, setFilePtrOffset -- * filesystem operations @@ -118,6 +119,7 @@ import qualified Z.Data.Text as T import qualified Z.Data.Text.Print as T import qualified Z.Data.Vector as V +import qualified Z.Data.JSON as JSON import Z.Foreign import Z.IO.Buffered import Z.IO.Exception @@ -137,7 +139,7 @@ -- -- libuv implements read and write method with both implict and explict offset capable. -- Implict offset interface is provided by 'Input' \/ 'Output' instances. --- Explict offset interface is provided by 'readFile' \/ 'writeFile'. +-- Explict offset interface is provided by 'readFileP' \/ 'writeFileP'. -- data File = File {-# UNPACK #-} !FD -- ^ the file {-# UNPACK #-} !(IORef Bool) -- ^ closed flag @@ -166,24 +168,24 @@ seek uvf off w = checkFileClosed uvf $ \ fd -> throwUVIfMinus $ hs_seek fd off w instance Input File where - readInput f buf bufSiz = readFile f buf bufSiz (-1) + readInput f buf bufSiz = readFileP f buf bufSiz (-1) -- | Read file with given offset -- -- Read length may be smaller than buffer size. -readFile :: HasCallStack +readFileP :: HasCallStack => File -> Ptr Word8 -- ^ buffer -> Int -- ^ buffer size -> Int64 -- ^ file offset, pass -1 to use default(system) offset -> IO Int -- ^ read length -readFile uvf buf bufSiz off = +readFileP uvf buf bufSiz off = checkFileClosed uvf $ \ fd -> do uvm <- getUVManager withUVRequest uvm (hs_uv_fs_read_threaded fd buf bufSiz off) instance Output File where - writeOutput f buf bufSiz = writeFile f buf bufSiz (-1) + writeOutput f buf bufSiz = writeFileP f buf bufSiz (-1) -- | Write buffer to file -- @@ -197,13 +199,13 @@ -- if a file is opened with O_APPEND, pwrite() appends data to the end of the file, -- regardless of the value of offset. -- @ -writeFile :: HasCallStack +writeFileP :: HasCallStack => File -> Ptr Word8 -- ^ buffer -> Int -- ^ buffer size -> Int64 -- ^ file offset, pass -1 to use default(system) offset -> IO () -writeFile uvf buf0 bufSiz0 off0 = +writeFileP uvf buf0 bufSiz0 off0 = checkFileClosed uvf $ \ fd -> do (if off0 == -1 then go fd buf0 bufSiz0 else go' fd buf0 bufSiz0 off0) @@ -230,7 +232,7 @@ -- Reading or writing using 'Input' \/ 'Output' instance will automatically increase offset. -- 'FilePtrT' and its operations are NOT thread safe, use 'MVar' 'FilePtrT' in multiple threads. -- --- The notes on linux 'writeFile' applied to 'FilePtr' too. +-- The notes on linux 'writeFileP' applied to 'FilePtr' too. data FilePtrT = FilePtrT {-# UNPACK #-} !File {-# UNPACK #-} !(PrimIORef Int64) @@ -252,14 +254,14 @@ instance Input FilePtrT where readInput (FilePtrT file offsetRef) buf bufSiz = readPrimIORef offsetRef >>= \ off -> do - l <- readFile file buf bufSiz off + l <- readFileP file buf bufSiz off writePrimIORef offsetRef (off + fromIntegral l) return l instance Output FilePtrT where writeOutput (FilePtrT file offsetRef) buf bufSiz = readPrimIORef offsetRef >>= \ off -> do - writeFile file buf bufSiz off + writeFileP file buf bufSiz off writePrimIORef offsetRef (off + fromIntegral bufSiz) -------------------------------------------------------------------------------- @@ -289,24 +291,33 @@ writeIORef closedRef True) -- | Quickly open a file and read its content. -quickReadFile :: HasCallStack => CBytes -> IO V.Bytes -quickReadFile filename = do +readFile :: HasCallStack => CBytes -> IO V.Bytes +readFile filename = do withResource (initFile filename O_RDONLY DEFAULT_MODE) $ \ file -> do readAll' =<< newBufferedInput file -- | Quickly open a file and read its content as UTF8 text. -quickReadTextFile :: HasCallStack => CBytes -> IO T.Text -quickReadTextFile filename = T.validate <$> quickReadFile filename +readTextFile :: HasCallStack => CBytes -> IO T.Text +readTextFile filename = T.validate <$> readFile filename -- | Quickly open a file and write some content. -quickWriteFile :: HasCallStack => CBytes -> V.Bytes -> IO () -quickWriteFile filename content = do +writeFile :: HasCallStack => CBytes -> V.Bytes -> IO () +writeFile filename content = do withResource (initFile filename (O_WRONLY .|. O_CREAT) DEFAULT_MODE) $ \ file -> do withPrimVectorSafe content (writeOutput file) -- | Quickly open a file and write some content as UTF8 text. -quickWriteTextFile :: HasCallStack => CBytes -> T.Text -> IO () -quickWriteTextFile filename content = quickWriteFile filename (T.getUTF8Bytes content) +writeTextFile :: HasCallStack => CBytes -> T.Text -> IO () +writeTextFile filename content = writeFile filename (T.getUTF8Bytes content) + +-- | Quickly open a file and read its content as a JSON value. +-- Throw 'OtherError' with name @EJSON@ if JSON value is not parsed or converted. +readJSONFile :: (HasCallStack, JSON.JSON a) => CBytes -> IO a +readJSONFile filename = unwrap . JSON.decode' =<< readFile filename + +-- | Quickly open a file and write a JSON Value. +writeJSONFile :: (HasCallStack, JSON.JSON a) => CBytes -> a -> IO () +writeJSONFile filename x = writeFile filename (JSON.encode x) -------------------------------------------------------------------------------- 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 @@ -39,7 +39,7 @@ import Z.Data.Array.Unaligned import Z.Data.CBytes (CBytes) import qualified Z.Data.CBytes as CBytes -import Z.Data.JSON (EncodeJSON, FromValue, ToValue) +import Z.Data.JSON (JSON) import Z.Data.Text.Print (Print) import Z.Data.Vector (defaultChunkSize) import Z.Foreign @@ -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 (Print, FromValue, ToValue, EncodeJSON) + deriving anyclass (Print, JSON) -- | Start watching a list of given directories. diff --git a/Z/IO/LowResTimer.hs b/Z/IO/LowResTimer.hs --- a/Z/IO/LowResTimer.hs +++ b/Z/IO/LowResTimer.hs @@ -234,6 +234,7 @@ where timeoutAThread tid = void . forkIO $ throwTo tid (TimeOutException tid callStack) +-- | see 'timeoutLowResEx' on 'TimeOutException', this exception is not a sub-exception type of 'SomeIOException'. data TimeOutException = TimeOutException ThreadId CallStack deriving Show instance Exception TimeOutException @@ -257,7 +258,7 @@ c <- readPrimIORef regCounter -- unless something terribly wrong happened, e.g., stackoverflow if c > 0 then do - t <- uv_hrtime + t <- uv_hrtime -- we can't use 100000 as maximum, because that will produce a 0us thread delay -- and GHC's registerTimeout will run next startLowResTimerManager directly(on current thread) -- but we're still holding runningLock, which cause an deadlock. 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 @@ -32,7 +32,7 @@ import GHC.Generics import Z.Data.CBytes as CBytes import Z.Data.Text.Print (Print(..)) -import Z.Data.JSON (EncodeJSON, ToValue, FromValue) +import Z.Data.JSON (JSON) import Z.Foreign import Z.IO.Exception import Z.IO.Network.SocketAddr @@ -86,7 +86,7 @@ -- returned. (Only some platforms support this.) | AI_V4MAPPED deriving (Eq, Ord, Read, Show, Generic) - deriving anyclass (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) addrInfoFlagMapping :: [(AddrInfoFlag, CInt)] addrInfoFlagMapping = @@ -129,7 +129,7 @@ , addrAddress :: SocketAddr , addrCanonName :: CBytes } deriving (Eq, Ord, Show, Generic) - deriving anyclass (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) 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 @@ -40,7 +40,7 @@ import GHC.Generics import Z.Data.CBytes import Z.Data.Text.Print (Print) -import Z.Data.JSON (EncodeJSON, ToValue, FromValue) +import Z.Data.JSON (JSON) import Z.IO.Exception import Z.IO.Resource import Z.IO.UV.FFI @@ -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 (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) -- | 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 (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) -- | A default hello world server on @.\/ipc@ -- 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 @@ -82,7 +82,7 @@ import Z.Data.CBytes import Z.Data.Text.Print (Print(..)) import qualified Z.Data.Text.Print as T -import Z.Data.JSON (EncodeJSON(..), ToValue(..), FromValue(..), (.:)) +import Z.Data.JSON (JSON(..), (.:)) import qualified Z.Data.JSON as JSON import qualified Z.Data.JSON.Builder as B import qualified Z.Data.Vector as V @@ -129,7 +129,8 @@ {-# UNPACK #-} !ScopeID -- sin6_scope_id (ditto) deriving (Eq, Ord, Generic) -instance EncodeJSON SocketAddr where +instance JSON SocketAddr where + {-# INLINE encodeJSON #-} encodeJSON (SocketAddrIPv4 addr port) = T.curly $ do "addr" `B.kv` encodeJSON addr T.char7 ',' @@ -143,7 +144,7 @@ T.char7 ',' "scope" `B.kv` encodeJSON scope -instance ToValue SocketAddr where + {-# INLINE toValue #-} toValue (SocketAddrIPv4 addr port) = JSON.Object . V.pack $ [ ("addr", toValue addr) , ("number", toValue port) @@ -155,7 +156,7 @@ , ("scope", toValue scope) ] -instance FromValue SocketAddr where + {-# INLINE fromValue #-} fromValue = JSON.withFlatMapR "Z.IO.Network.SocketAddr" $ \ fm -> do (addrV :: V.PrimVector Word) <- fm .: "addr" case V.length addrV of @@ -222,13 +223,11 @@ newtype IPv4 = IPv4 { getIPv4Addr :: Word32 } deriving (Eq, Ord, Generic) -instance EncodeJSON IPv4 where +instance JSON IPv4 where {-# INLINE encodeJSON #-} encodeJSON = encodeJSON . ipv4AddrToTuple -instance ToValue IPv4 where {-# INLINE toValue #-} toValue = toValue . ipv4AddrToTuple -instance FromValue IPv4 where {-# INLINE fromValue #-} fromValue v = tupleToIPv4Addr <$> fromValue v @@ -311,15 +310,13 @@ {-# UNPACK #-}!Word32 deriving (Eq, Ord, Generic) -instance EncodeJSON IPv6 where +instance JSON IPv6 where {-# INLINE encodeJSON #-} encodeJSON addr = encodeJSON [a,b,c,d,e,f,g,h] where (a,b,c,d,e,f,g,h) = ipv6AddrToTuple addr -instance ToValue IPv6 where {-# INLINE toValue #-} toValue addr = toValue [a,b,c,d,e,f,g,h] where (a,b,c,d,e,f,g,h) = ipv6AddrToTuple addr -instance FromValue IPv6 where {-# INLINE fromValue #-} fromValue v = do [a,b,c,d,e,f,g,h] <- fromValue v @@ -598,7 +595,7 @@ -- 60000 newtype PortNumber = PortNumber Word16 deriving (Eq, Ord, Enum, Generic) - deriving newtype (Show, Print, Read, Num, Bounded, Real, Integral, EncodeJSON, ToValue, FromValue) + deriving newtype (Show, Print, Read, Num, Bounded, Real, Integral, JSON) -- | @:0@ portAny :: PortNumber 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 @@ -39,7 +39,7 @@ import Foreign.Ptr import GHC.Generics import Z.Data.Text.Print (Print) -import Z.Data.JSON (EncodeJSON, ToValue, FromValue) +import Z.Data.JSON (JSON) import Z.IO.Exception import Z.IO.Network.SocketAddr import Z.IO.Resource @@ -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 (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) -- | 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 (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) -- | A default hello world server on 0.0.0.0:8888 -- 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 @@ -73,7 +73,7 @@ import Z.Data.Vector.Extra as V import Z.Data.CBytes as CBytes import qualified Z.Data.Text.Print as T -import Z.Data.JSON (EncodeJSON, ToValue, FromValue) +import Z.Data.JSON (JSON) import Z.IO.Network.SocketAddr import Z.Foreign import Z.IO.UV.FFI @@ -113,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 (T.Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (T.Print, JSON) -- | @UDPConfig 512 Nothing@ defaultUDPConfig :: UDPConfig @@ -312,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 (T.Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (T.Print, JSON) -- | @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 @@ -68,7 +68,7 @@ import System.Exit import Z.Data.CBytes import Z.Data.CBytes as CBytes -import Z.Data.JSON (EncodeJSON, ToValue, FromValue) +import Z.Data.JSON (JSON) import Z.Data.Vector as V import qualified Z.Data.Text as T import qualified Data.List as List @@ -100,7 +100,7 @@ -- | Process state data ProcessState = ProcessRunning PID | ProcessExited ExitCode deriving (Show, Eq, Ord, Generic) - deriving anyclass (T.Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (T.Print, JSON) -- | 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 @@ -68,7 +68,7 @@ -- -- Library authors providing 'initXXX' are also encouraged to provide these guarantees. -- -newtype Resource a = Resource { acquire :: HasCallStack => IO (a, IO ()) } +newtype Resource a = Resource { acquire :: IO (a, IO ()) } -- | Create 'Resource' from create and release action. -- 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 @@ -24,7 +24,7 @@ import Foreign.Storable import Z.Data.Array.Unaligned import Z.Data.Text.Print (Print(..)) -import Z.Data.JSON (EncodeJSON, ToValue, FromValue) +import Z.Data.JSON (JSON) import Z.Data.CBytes as CBytes import Z.Foreign import Z.IO.Exception (throwUVIfMinus_, bracket, HasCallStack) @@ -495,7 +495,7 @@ | DirEntChar | DirEntBlock deriving (Read, Show, Eq, Ord, Enum, Generic) - deriving anyclass (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) fromUVDirEntType :: UVDirEntType -> DirEntType fromUVDirEntType t @@ -528,7 +528,7 @@ { uvtSecond :: {-# UNPACK #-} !CLong , uvtNanoSecond :: {-# UNPACK #-} !CLong } deriving (Show, Read, Eq, Ord, Generic) - deriving anyclass (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) instance Storable UVTimeSpec where sizeOf _ = #{size uv_timespec_t} @@ -557,7 +557,7 @@ , stCtim :: {-# UNPACK #-} !UVTimeSpec , stBirthtim :: {-# UNPACK #-} !UVTimeSpec } deriving (Show, Read, Eq, Ord, Generic) - deriving anyclass (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) uvStatSize :: Int uvStatSize = #{size uv_stat_t} @@ -640,7 +640,7 @@ data AccessResult = NoExistence | NoPermission | AccessOK deriving (Show, Eq, Ord, Enum, Generic) - deriving anyclass (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) foreign import ccall unsafe hs_uv_fs_access :: BA## Word8 -> AccessMode -> IO Int foreign import ccall unsafe hs_uv_fs_access_threaded @@ -723,7 +723,7 @@ Word32 #endif deriving (Eq, Ord, Show, Read, Generic) - deriving newtype (Storable, Prim, Unaligned, Num, EncodeJSON, ToValue, FromValue) + deriving newtype (Storable, Prim, Unaligned, Num, JSON) deriving anyclass Print newtype GID = GID @@ -733,7 +733,7 @@ Word32 #endif deriving (Eq, Ord, Show, Read, Generic) - deriving newtype (Storable, Prim, Unaligned, Num, EncodeJSON, ToValue, FromValue) + deriving newtype (Storable, Prim, Unaligned, Num, JSON) deriving anyclass Print type ProcessFlag = CUInt @@ -805,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 (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) 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 (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) processStdStreamFlag :: ProcessStdStream -> CInt processStdStreamFlag ProcessIgnore = #const UV_IGNORE @@ -892,7 +892,7 @@ { tv_sec :: {-# UNPACK #-} !CLong , tv_usec :: {-# UNPACK #-} !CLong } deriving (Show, Read, Eq, Ord, Generic) - deriving anyclass (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) -- | Data type for resource usage results. -- @@ -916,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 (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) sizeOfResUsage :: Int sizeOfResUsage = #size uv_rusage_t @@ -952,7 +952,7 @@ newtype PID = PID CInt deriving (Eq, Ord, Show, Read, Generic) - deriving newtype (Storable, Prim, Unaligned, EncodeJSON, ToValue, FromValue) + deriving newtype (Storable, Prim, Unaligned, JSON) deriving anyclass Print type Priority = CInt @@ -988,7 +988,7 @@ , os_version :: CBytes , os_machine :: CBytes } deriving (Eq, Ord, Show, Read, Generic) - deriving anyclass (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) getOSName :: HasCallStack => IO OSName getOSName = do @@ -1013,7 +1013,7 @@ , passwd_shell :: CBytes , passwd_homedir :: CBytes } deriving (Eq, Ord, Show, Read, Generic) - deriving anyclass (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) foreign import ccall unsafe uv_os_get_passwd :: MBA## PassWD -> IO CInt foreign import ccall unsafe uv_os_free_passwd :: MBA## PassWD -> IO () @@ -1055,7 +1055,7 @@ , cpu_times_idle :: Word64 -- ^ milliseconds , cpu_times_irq :: Word64 -- ^ milliseconds } deriving (Eq, Ord, Show, Read, Generic) - deriving anyclass (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) -- | Gets information about the CPUs on the system. getCPUInfo :: HasCallStack => IO [CPUInfo] @@ -1095,7 +1095,7 @@ { tv64_sec :: {-# UNPACK #-} !Int64 , tv64_usec :: {-# UNPACK #-} !Int32 } deriving (Show, Read, Eq, Ord, Generic) - deriving anyclass (Print, EncodeJSON, ToValue, FromValue) + deriving anyclass (Print, JSON) foreign import ccall unsafe uv_gettimeofday :: MBA## TimeVal64 -> IO CInt