packages feed

lazy-scope (empty) → 0.0.1

raw patch · 10 files changed

+752/−0 lines, 10 filesdep +basedep +bytestringdep +deepseq

Dependencies added: base, bytestring, deepseq, directory, filepath, lazy-scope, mtl, relude, tasty, tasty-discover, tasty-hunit, tasty-quickcheck, trace-embrace, transformers, unliftio

Files

+ changelog.md view
@@ -0,0 +1,5 @@+# lazy-scope changelog+++## Version 0.0.1 2025-07-12+  * init
+ lazy-scope.cabal view
@@ -0,0 +1,133 @@+cabal-version: 3.0+name:          lazy-scope+version:       0.0.1+synopsis:      Alternative lazy ByteString and ST-like IO Handle+description:+    lazy-scope library appeared as an attempt to improve lazy IO API from+    <https://hackage.haskell.org/package/bytestring bytestring> package:+    +    -   @hGetContents@ closes handle which was open by somebody else.+    -   @hGetContents@ closes handle only on EOF+    +    E.g. <https://hackage.haskell.org/package/git-phoenix git-phoenix> does+    GIT objects recovery. Recovered compressed file usually has trailing+    trash bytes after archive ends. In such circumstance bracket finalizer+    should check every handle before closing.+    +    lazy-scope library provides @hGetContents@ with alternative semantic -+    it never close the handle! Handle and values, derived from it, have a+    type parameter which prevents accidental thunk escape beyond open handle+    scope. Solution is based on+    <https://hackage.haskell.org/package/base/docs/Control-Monad-ST.html ST>+    monad.+    +    > import Lazy.Scope qualified as S+    > import Relude+    >+    > main = do+    >   r <- S.withBinaryFile "/etc/hosts" ReadMode S.hGetContents+    >   S.unsnoc r `seq` return ()+    +    Error:+    +    >   • Couldn't match type ‘s0’ with ‘s’+    >     Expected: S.Handle s -> S.LazyT s IO (S.Bs s0)+    >       Actual: S.Handle s -> S.LazyT s IO (S.Bs s)+    >       because type variable ‘s’ would escape its scope+    +    Correct version:+    +    > import Data.ByteString.Lazy qualified as LBS+    > import Lazy.Scope qualified as S+    > import Relude+    >+    > main = do+    >   r <- S.withBinaryFile "/etc/hosts" ReadMode (S.hGetContents >=> S.toLbs)+    >   LBS.unsnoc r `seq` return ()+    +    The package has scoped alternatives for majority of @Handle@ and+    @ByteString@ functions from @System.IO@ and @Data.ByteString.Lazy@+    modules correspondingly.+    +    == Development+    #development#+    +    Dev environment is provided by+    <https://nixos.org/guides/nix-pills/10-developing-with-nix-shell.html nix-shell>+    +    > $ nix-shell+    > $ cabal test++homepage:      http://github.com/yaitskov/scoped-handle+license:       BSD-3-Clause+author:        Daniil Iaitskov+maintainer:    dyaitskov@gmail.com+copyright:     Daniil Iaitkov 2025+category:      System+build-type:    Simple+bug-reports:   https://github.com/yaitskov/lazy-scope/issues+extra-doc-files:+  changelog.md+tested-with:+  GHC == { 9.10.1, 9.12.2 }++source-repository head+  type:+    git+  location:+    https://github.com/yaitskov/lazy-scope.git++common base+  default-language: GHC2024+  ghc-options: -Wall+  default-extensions:+    DefaultSignatures+    NoImplicitPrelude+    OverloadedLabels+    OverloadedStrings+    TemplateHaskell+  build-depends:+    , base >=4.7 && < 5+    , bytestring >= 0.12.1 && < 1+    , relude >= 1.2.2 && < 2+    , unliftio < 1++library+  import: base+  hs-source-dirs: src+  exposed-modules:+    Lazy.Scope+  other-modules:+    Lazy.Scope.GetContents+    Lazy.Scope.Io+    Lazy.Scope.Scoped+    Lazy.Scope.Type+    Paths_lazy_scope+  autogen-modules:+    Paths_lazy_scope+  build-depends:+    , deepseq                 < 2+    , directory               < 2+    , filepath                < 2+    , mtl                     < 3+    , trace-embrace           >= 1.2.0 && < 2+    , transformers            < 1++test-suite test+  import: base+  type: exitcode-stdio-1.0+  main-is: Driver.hs+  other-modules:+    Discovery+    Lazy.Scope.Test.HandleCloses+  hs-source-dirs:+    test+  ghc-options: -Wall -rtsopts -threaded -main-is Driver+  build-depends:+      directory+    , tasty+    , tasty-discover+    , tasty-hunit+    , tasty-quickcheck+    , lazy-scope+    , unliftio
+ src/Lazy/Scope.hs view
@@ -0,0 +1,16 @@+module Lazy.Scope+  ( LazyT+  , Handle+  , HandlePosn+  , Bs+  , Scoped+  , hGetContents+  , hGetNonBlocking+  , hPutNonBlocking+  , module X+  ) where++import Lazy.Scope.Type+import Lazy.Scope.Scoped as X+import Lazy.Scope.Io as X+import Lazy.Scope.GetContents
+ src/Lazy/Scope/GetContents.hs view
@@ -0,0 +1,58 @@+module Lazy.Scope.GetContents where++import Control.Exception (ioError)+import Data.ByteString qualified as S+import Data.ByteString.Lazy.Internal (ByteString(Chunk, Empty), defaultChunkSize)+import Lazy.Scope.Type (LazyT, Handle(..), Bs, Scoped(Scoped))+import Lazy.Scope.Scoped (toBs)+import Relude hiding (Handle)+import System.IO.Error (mkIOError, illegalOperationErrorType)+import System.IO.Unsafe (unsafeInterleaveIO)+import Text.Show (showsPrec)++hGetContentsOnlyN :: Int -> Handle s -> IO LByteString+hGetContentsOnlyN k (Handle h) = lazyRead+  where+    lazyRead = unsafeInterleaveIO loop++    loop = do+        c <- S.hGetSome h k+        if S.null c+          then return Empty+          else Chunk c <$> lazyRead++hGetContents :: MonadIO m => Handle s -> LazyT s m (Bs s)+hGetContents h = lift $ liftIO (Scoped <$> hGetContentsOnlyN defaultChunkSize h)++hGetNonBlockingN :: Int -> Handle s -> Int -> IO LByteString+hGetNonBlockingN k (Handle h) n | n > 0= readChunks n+  where+    readChunks !i = do+        c <- S.hGetNonBlocking h (min k i)+        case S.length c of+            0 -> return Empty+            m -> do cs <- readChunks (i - m)+                    return (Chunk c cs)++hGetNonBlockingN _ _ 0 = return Empty+hGetNonBlockingN _ h n = illegalBufferSize h "hGetNonBlocking" n++illegalBufferSize :: Handle s -> String -> Int -> IO a+illegalBufferSize (Handle handle) fn sz =+    ioError (mkIOError illegalOperationErrorType msg (Just handle) Nothing)+    --TODO: System.IO uses InvalidArgument here, but it's not exported :-(+    where+      msg = fn ++ ": illegal ByteString size " ++ showsPrec 9 sz []+++hGetNonBlocking :: MonadIO m => Handle s -> Int -> LazyT s m (Bs s)+hGetNonBlocking h n = lift (liftIO $ toBs <$> hGetNonBlockingN defaultChunkSize h n)++hPutNonBlocking :: MonadIO m => Handle s -> Bs s -> LazyT s m (Bs s)+hPutNonBlocking _ (Scoped Empty)           = pure (Scoped Empty)+hPutNonBlocking bh@(Handle h) (Scoped bs@(Chunk c cs)) = do+  c' <- lift (liftIO $ S.hPutNonBlocking h c)+  case S.length c' of+    l' | l' == S.length c -> hPutNonBlocking bh (Scoped cs)+    0                     -> return $ Scoped bs+    _                     -> return $ Scoped (Chunk c' cs)
+ src/Lazy/Scope/Io.hs view
@@ -0,0 +1,155 @@+module Lazy.Scope.Io where++import Control.DeepSeq (NFData)+import Control.Monad.Trans.Class (MonadTrans(lift))+import Data.ByteString qualified as S+import Data.ByteString.Lazy qualified as L+import Foreign.Ptr (Ptr)+import Lazy.Scope.Type (LazyT(..), HandlePosn(..), Handle(..), Bs, Scoped(Scoped))+import Relude+    ( ($), ($!), (<$>),+      Bool(..),+      ByteString,+      Char,+      Show,+      String,+      Maybe (..),+      Integer,+      Int,+      MonadIO(..),+      FilePath,+      IOMode )+import System.IO qualified as IO+import System.IO (SeekMode (..), BufferMode, TextEncoding, NewlineMode)+import UnliftIO (MonadUnliftIO (..))+import UnliftIO.IO qualified as U++class WithFile a where+  withFile       :: (NFData r, MonadUnliftIO m) =>+    a -> IOMode -> (forall s. Handle s -> LazyT s m r) -> m r+  withBinaryFile :: (NFData r, MonadUnliftIO m) =>+    a -> IOMode -> (forall s. Handle s -> LazyT s m r) -> m r++instance WithFile FilePath where+  {-# INLINE withFile #-}+  withFile fp mode cb =+    U.withFile fp mode (\h -> unLazy (cb (Handle h)))+  {-# INLINE withBinaryFile #-}+  withBinaryFile fp mode cb =+    U.withBinaryFile fp mode (\h -> unLazy (cb (Handle h)))++hSeek :: MonadIO m => Handle s -> SeekMode -> Integer -> LazyT s m ()+hSeek (Handle h) sm n = LazyT $! U.hSeek h sm n+{-# INLINE hSeek #-}++hTell :: MonadIO m => Handle s -> LazyT s m Integer+hTell (Handle h) = lift $! U.hTell h+{-# INLINE hTell #-}++hSetPosn :: MonadIO m => HandlePosn s -> LazyT s m ()+hSetPosn (HandlePosn hpn) = lift (liftIO $! IO.hSetPosn hpn)++hGetPosn :: MonadIO m => Handle s -> LazyT s m (HandlePosn s)+hGetPosn (Handle h) = lift (liftIO $! HandlePosn <$> IO.hGetPosn h)++hFlush :: MonadIO m => Handle s -> LazyT s m ()+hFlush (Handle h) = lift (U.hFlush h)++hGetBuffering :: MonadIO m => Handle s -> LazyT s m BufferMode+hGetBuffering (Handle h) = lift (U.hGetBuffering h)++hSetBuffering :: MonadIO m => Handle s -> BufferMode -> LazyT s m ()+hSetBuffering (Handle h) bm = lift (U.hSetBuffering h bm)++hIsEOF :: MonadIO m => Handle s -> LazyT s m Bool+hIsEOF (Handle h) = lift (U.hIsEOF h)++hSetFileSize :: MonadIO m => Handle s -> Integer -> LazyT s m ()+hSetFileSize (Handle h) n = lift (U.hSetFileSize h n)++hFileSize :: MonadIO m => Handle s -> LazyT s m Integer+hFileSize (Handle h) = lift (U.hFileSize h)++hSetEncoding :: MonadIO m => Handle s -> TextEncoding -> LazyT s m ()+hSetEncoding (Handle h) te = lift (liftIO $ IO.hSetEncoding h te)++hGetEncoding :: MonadIO m => Handle s -> LazyT s m (Maybe TextEncoding)+hGetEncoding (Handle h) = lift (liftIO $ IO.hGetEncoding h)++hSetBinaryMode :: MonadIO m => Handle s -> Bool -> LazyT s m ()+hSetBinaryMode (Handle h) b = lift (liftIO $ IO.hSetBinaryMode h b)++hPutBuf :: MonadIO m => Handle s -> Ptr a -> Int -> LazyT s m ()+hPutBuf (Handle h) p n = lift (liftIO $ IO.hPutBuf h p n)++hGetBuf :: MonadIO m => Handle s -> Ptr a -> Int -> LazyT s m Int+hGetBuf (Handle h) p n = lift (liftIO $ IO.hGetBuf h p n)++hGetBufSome :: MonadIO m => Handle s -> Ptr a -> Int -> LazyT s m Int+hGetBufSome (Handle h) p n = lift (liftIO $ IO.hGetBufSome h p n)++hPutBufNonBlocking :: MonadIO m => Handle s -> Ptr a -> Int -> LazyT s m Int+hPutBufNonBlocking (Handle h) p n = lift (liftIO $ IO.hPutBufNonBlocking h p n)++hGetBufNonBlocking :: MonadIO m => Handle s -> Ptr a -> Int -> LazyT s m Int+hGetBufNonBlocking (Handle h) p n = lift (liftIO $ IO.hGetBufNonBlocking h p n)++hSetNewlineMode :: MonadIO m => Handle s -> NewlineMode -> LazyT s m ()+hSetNewlineMode (Handle h) nlm = lift (liftIO $ IO.hSetNewlineMode h nlm)++hPrint :: (MonadIO m, Show a) => Handle s -> a -> LazyT s m ()+hPrint (Handle h) a = lift (liftIO $ IO.hPrint h a)++hGetChar :: MonadIO m => Handle s -> LazyT s m Char+hGetChar (Handle h) = lift (liftIO $ IO.hGetChar h)++hReady :: MonadIO m => Handle s -> LazyT s m Bool+hReady (Handle h) = lift (U.hReady h)++hWaitForInput :: MonadIO m => Handle s -> Int -> LazyT s m Bool+hWaitForInput (Handle h) n = lift (U.hWaitForInput h n)++hShow :: MonadIO m => Handle s -> LazyT s m String+hShow (Handle h) = lift $ (liftIO $ IO.hShow h)++hGetEcho :: MonadIO m => Handle s -> LazyT s m Bool+hGetEcho (Handle h) = lift (U.hGetEcho h)++hSetEcho :: MonadIO m => Handle s -> Bool -> LazyT s m ()+hSetEcho (Handle h) eb = lift (U.hSetEcho h eb)++hIsTerminalDevice :: MonadIO m => Handle s -> LazyT s m Bool+hIsTerminalDevice (Handle h) = lift (U.hIsTerminalDevice h)++hIsSeekable :: MonadIO m => (Handle s) -> LazyT s m Bool+hIsSeekable (Handle h) = lift (U.hIsSeekable h)++hIsWritable :: MonadIO m => Handle s -> LazyT s m Bool+hIsWritable (Handle h) = lift (U.hIsWritable h)++hIsReadable :: MonadIO m => Handle s -> LazyT s m Bool+hIsReadable (Handle h) = lift (U.hIsReadable h)++hPutStrLn :: MonadIO m => Handle s -> String -> LazyT s m ()+hPutStrLn (Handle h) s = lift (liftIO $ IO.hPutStrLn h s)++hPutStr :: MonadIO m => Handle s -> String -> LazyT s m ()+hPutStr (Handle h) s = lift (liftIO $ IO.hPutStr h s)++hPutBs :: MonadIO m => Handle s -> Bs s -> LazyT s m ()+hPutBs (Handle h) (Scoped lbs) = LazyT (liftIO $ L.hPut h lbs)++hPut :: MonadIO m => Handle s -> L.ByteString -> LazyT s m ()+hPut (Handle h) lbs = LazyT (liftIO $ L.hPut h lbs)++hPutChar :: MonadIO m => Handle s -> Char -> LazyT s m ()+hPutChar (Handle h) c = lift (liftIO $ IO.hPutChar h c)++hLookAhead :: MonadIO m => Handle s -> LazyT s m Char+hLookAhead (Handle h) = lift (liftIO $ IO.hLookAhead h)++hGetLine :: MonadIO m => Handle s -> LazyT s m String+hGetLine (Handle h) = lift (liftIO $ IO.hGetLine h)++hGet :: MonadIO m => Handle s -> Int -> LazyT s m ByteString+hGet (Handle h) n = lift (liftIO $ S.hGet h n)
+ src/Lazy/Scope/Scoped.hs view
@@ -0,0 +1,252 @@+module Lazy.Scope.Scoped where++import Data.ByteString.Lazy qualified as L+import Data.ByteString.Lazy.Char8 qualified as L8+import Lazy.Scope.Type+import Relude hiding (Handle)++unScope :: (NFData a, Monad m) => Scoped s a -> LazyT s m a+unScope (Scoped !a) =+  case rnf a of+    () -> pure a++bs2Scoped :: (LByteString -> a) -> Bs s -> Scoped s a+bs2Scoped f = fmap f++scoped2Bs :: (a -> LByteString) -> Scoped s a -> Bs s+scoped2Bs f = fmap f++toBs :: LByteString -> Bs s+toBs = Scoped+{-# INLINE toBs #-}++condM :: [(Scoped s Bool, m a)] -> m a -> m a+condM [] o = o+condM ((Scoped True, a):_) _ = a+condM ((Scoped False, _):t) o = condM t o++empty :: Bs s+empty = pure L.empty++singleton :: W8 s -> Bs s+singleton = pure . L.singleton . unScoped++pack :: [W8 s] -> Bs s+pack = pure . L.pack . fmap unScoped++cons :: W8 s -> Bs s -> Bs s+cons = liftA2 L.cons++snoc :: Bs s -> W8 s -> Bs s+snoc = liftA2 L.snoc++uncons :: Bs s -> Scoped s (Maybe (Word8, LByteString))+uncons = fmap L.uncons++unsnoc :: Bs s -> Scoped s (Maybe (LByteString, Word8))+unsnoc = fmap L.unsnoc++null :: Bs s -> B s+null = fmap L.null++reverse :: Bs s -> Bs s+reverse =  fmap L.reverse++intersperse :: W8 s -> Bs s -> Bs s+intersperse = liftA2 L.intersperse++intercalate :: Bs s -> [Bs s] -> Bs s+intercalate (Scoped bs) = pure . L.intercalate bs . fmap unScoped++transpose :: [Bs s] -> [Bs s]+transpose = fmap pure . L.transpose . fmap unScoped++foldl' :: (Scoped s a -> Word8 -> Scoped s a) -> Scoped s a -> Bs s -> Scoped s a+foldl' f (Scoped b) = fmap (L.foldl' (\a i -> unScoped $ f (pure a) i) b)++foldr' :: (Word8 -> Scoped s a -> Scoped s a) -> Scoped s a -> Bs s -> Scoped s a+foldr' f (Scoped b) = fmap (L.foldr' (\i a -> unScoped $ f i (pure a)) b)++concat :: [Bs s] -> Bs s+concat = pure . L.concat . fmap unScoped++concatMap :: (Word8 -> LByteString) -> Bs s -> Bs s+concatMap f = fmap (L.concatMap f)++any :: (Word8 -> Bool) -> Bs s -> B s+any p = fmap (L.any p)++all :: (Word8 -> Bool) -> Bs s -> B s+all p = fmap (L.all p)++maximum :: HasCallStack => Bs s -> W8 s+maximum = fmap L.maximum++minimum :: HasCallStack => Bs s -> W8 s+minimum = fmap L.minimum++compareLength :: Bs s -> I64 s -> Scoped s Ordering+compareLength = liftA2 L.compareLength++scanl :: (W8 s -> W8 s -> W8 s) -> W8 s -> Bs s -> Bs s+scanl f i = fmap (L.scanl (\a e -> unScoped $ f (pure a) (pure e)) $ unScoped i)++scanl1 :: (W8 s -> W8 s -> W8 s) -> Bs s -> Bs s+scanl1 f = fmap (L.scanl1 (\a e -> unScoped $ f (pure a) (pure e)))+scanr :: (W8 s -> W8 s -> W8 s) -> W8 s -> Bs s -> Bs s+scanr f i = fmap (L.scanr (\a e -> unScoped $ f (pure a) (pure e)) $ unScoped i)+scanr1 :: (W8 s -> W8 s -> W8 s) -> Bs s -> Bs s+scanr1 f = fmap (L.scanr1 (\a e -> unScoped $ f (pure a) (pure e)))++mapAccumL :: (acc -> W8 s -> (acc, W8 s)) -> acc -> Bs s -> (acc, Bs s)+mapAccumL f a (Scoped lbs) =+  case L.mapAccumL (\acc (b :: Word8) -> mapSnd unScoped $ f acc (pure b)) a lbs of+    (acc, lbs') -> (acc, toBs lbs')++mapAccumR :: (acc -> W8 s -> (acc, W8 s)) -> acc -> Bs s -> (acc, Bs s)+mapAccumR f a (Scoped lbs) =+  case L.mapAccumR (\acc b -> mapSnd unScoped $ f acc (pure b)) a lbs of+    (acc, lbs') -> (acc, toBs lbs')++repeat :: W8 s -> Bs s+repeat = fmap L.repeat+replicate :: I64 s -> W8 s -> Bs s+replicate = liftA2 L.replicate+cycle :: HasCallStack => Bs s -> Bs s+cycle = fmap L.cycle+iterate :: (W8 s -> W8 s) -> W8 s -> Bs s+iterate f (Scoped i) = toBs $ L.iterate (unScoped . f . pure) i++unfoldr :: (a -> Maybe (W8 s, a)) -> a -> Bs s+unfoldr f = toBs . L.unfoldr (\a -> fmap (mapFst unScoped) $ f a)++isPrefixOf :: Bs s -> Bs s -> B s+isPrefixOf = liftA2 L.isPrefixOf++isSuffixOf :: Bs s -> Bs s -> B s+isSuffixOf = liftA2 L.isSuffixOf++elem :: W8 s -> Bs s -> B s+elem = liftA2 L.elem++notElem :: W8 s -> Bs s -> B s+notElem = liftA2 L.notElem++find :: (Word8 -> Bool) -> Bs s -> Scoped s (Maybe Word8)+find f = fmap (L.find f)++filter :: (Word8 -> Bool) -> Bs s -> Bs s+filter f = fmap (L.filter f)+partition :: (Word8 -> Bool) -> Bs s -> (Bs s, Bs s)+partition f =  both toBs . L.partition f . unScoped+index :: HasCallStack => Bs s -> I64 s -> W8 s+index = liftA2 L.index+indexMaybe :: Bs s -> I64 s -> Scoped s (Maybe Word8)+indexMaybe = liftA2 L.indexMaybe++(!?) :: Bs s -> I64 s -> Scoped s (Maybe Word8)+(!?)= liftA2 (L.!?)++elemIndex :: W8 s -> Bs s -> Scoped s (Maybe Int64)+elemIndex = liftA2 L.elemIndex+elemIndexEnd :: W8 s -> Bs s -> Scoped s (Maybe Int64)+elemIndexEnd = liftA2 L.elemIndexEnd+elemIndices :: W8 s -> Bs s -> Scoped s [Int64]+elemIndices = liftA2 L.elemIndices+findIndex :: (Word8 -> Bool) -> Bs s -> Scoped s (Maybe Int64)+findIndex p = fmap (L.findIndex p)+findIndexEnd :: (Word8 -> Bool) -> Bs s -> Scoped s (Maybe Int64)+findIndexEnd p = fmap (L.findIndexEnd p)+findIndices :: (Word8 -> Bool) -> Bs s -> Scoped s [Int64]+findIndices p = fmap (L.findIndices p)+count :: W8 s -> Bs s -> I64 s+count = liftA2 L.count+zip :: Bs s -> Bs s -> Scoped s [(Word8, Word8)]+zip = liftA2 L.zip+zipWith :: (Word8 -> Word8 -> a) -> Bs s -> Bs s -> Scoped s [a]+zipWith f = liftA2 (L.zipWith f)+packZipWith :: (Word8 -> Word8 -> Word8) -> Bs s -> Bs s -> Bs s+packZipWith f = liftA2 (L.packZipWith f)+unzip :: Scoped s [(Word8, Word8)] -> (Bs s, Bs s)+unzip = both toBs . L.unzip . unScoped+copy :: Bs s -> Bs s+copy = fmap L.copy++take :: Int64 -> Bs s -> Bs s+take n = pure . L.take n . unScoped+{-# INLINE take #-}++length :: Bs s -> I64 s+length = fmap L.length+{-# INLINE length #-}++drop :: I64 s -> Bs s -> Bs s+drop (Scoped n) = pure . L.drop n . unScoped+{-# INLINE drop #-}++dropEnd :: I64 s -> Bs s -> Bs s+dropEnd (Scoped n) = pure . L.dropEnd n . unScoped+{-# INLINE dropEnd #-}++dropWhile :: (Word8 -> Bool) -> Bs s -> Bs s+dropWhile p = pure . L.dropWhile p . unScoped+{-# INLINE dropWhile #-}++dropWhileEnd :: (Word8 -> Bool) -> Bs s -> Bs s+dropWhileEnd p = pure . L.dropWhileEnd p . unScoped+{-# INLINE dropWhileEnd #-}++takeWhile :: (Word8 -> Bool) -> Bs s -> Bs s+takeWhile p = pure . L.takeWhile p . unScoped+{-# INLINE takeWhile #-}++takeWhileEnd :: (Word8 -> Bool) -> Bs s -> Bs s+takeWhileEnd p = pure . L.takeWhileEnd p . unScoped+{-# INLINE takeWhileEnd #-}++span :: (Word8 -> Bool) -> Bs s -> (Bs s, Bs s)+span p = both pure . L.span p . unScoped++spanEnd :: (Word8 -> Bool) -> Bs s -> (Bs s, Bs s)+spanEnd p = both pure . L.spanEnd p . unScoped++break :: (Word8 -> Bool) -> Bs s -> (Bs s, Bs s)+break p = both pure . L.break p . unScoped++breakEnd :: (Word8 -> Bool) -> Bs s -> (Bs s, Bs s)+breakEnd p = both pure . L.breakEnd p . unScoped++splitAt :: I64 s -> Bs s -> (Bs s, Bs s)+splitAt (Scoped n) = both pure . L.splitAt n . unScoped++mapLbs :: (LByteString -> LByteString) -> Bs s -> Bs s+mapLbs f = fmap f++unpack8 :: Monad m => Bs s -> LazyT s m String+unpack8 = pure . L8.unpack . unScoped++toLbs :: Monad m => Bs s -> LazyT s m LByteString+toLbs (Scoped a) =+  case rnf a of+    () -> pure a++group :: Bs s -> Scoped s [LByteString]+group = fmap L.group++groupBy :: (Word8 -> Word8 -> Bool) -> Bs s -> Scoped s [LByteString]+groupBy p = fmap (L.groupBy p)++inits :: Bs s -> Scoped s [LByteString]+inits = fmap L.inits+tails :: Bs s -> Scoped s [LByteString]+tails = fmap L.tails+initsNE :: Bs s -> Scoped s (NonEmpty LByteString)+initsNE = fmap L.initsNE+tailsNE :: Bs s -> Scoped s (NonEmpty LByteString)+tailsNE = fmap L.tailsNE+stripPrefix :: Bs s -> Bs s -> Scoped s (Maybe LByteString)+stripPrefix = liftA2 L.stripPrefix+stripSuffix :: Bs s -> Bs s -> Scoped s (Maybe LByteString)+stripSuffix = liftA2 L.stripSuffix+splitWith :: (Word8 -> Bool) -> Bs s -> Scoped s [LByteString]+splitWith p = fmap (L.splitWith p)
+ src/Lazy/Scope/Type.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE UndecidableInstances #-}+module Lazy.Scope.Type where++import Relude hiding (Handle)+import System.IO qualified as IO+import UnliftIO (MonadUnliftIO (..))++newtype Scoped s a = Scoped { unScoped :: a }+  deriving newtype (Show, Eq, Ord, NFData, Semigroup, IsString, Monoid, Num, Bounded)+  deriving (Functor)++instance Applicative (Scoped s) where+  pure = Scoped+  {-# INLINE pure #-}+  liftA2 f (Scoped a) (Scoped b) = Scoped $ f a b+  {-# INLINE liftA2 #-}++type Bs s = Scoped s LByteString+type I64 s = Scoped s Int64+type B s = Scoped s Bool+type W8 s = Scoped s Word8++both :: (a -> b) -> (a, a) -> (b, b)+both f ~(x,y) = (f x, f y)+{-# INLINE both #-}+mapFst :: (a -> b) -> (a, c) -> (b, c)+mapFst f (x,y) = (f x, y)+{-# INLINE mapFst #-}+mapSnd :: (a -> b) -> (c, a) -> (c, b)+mapSnd f (x,y) = (x, f y)+{-# INLINE mapSnd #-}++newtype Handle s = Handle IO.Handle deriving (Show, Eq)+newtype HandlePosn s = HandlePosn IO.HandlePosn deriving (Show, Eq)++newtype LazyT s m a = LazyT { unLazy :: m a }++instance Functor m => Functor (LazyT s m) where+  {-# INLINE fmap #-}+  fmap f (LazyT m) = LazyT (fmap f m)++instance Applicative m => Applicative (LazyT s m) where+  pure a = LazyT (pure a)+  {-# INLINE pure #-}+  liftA2 f (LazyT ma) (LazyT mb) = LazyT (liftA2 f ma mb)+  {-# INLINE liftA2 #-}++instance Monad m => Monad (LazyT s m) where+  (>>=) :: LazyT s m a -> (a -> LazyT s m b) -> LazyT s m b+  LazyT m1 >>= fm2 = LazyT (m1 >>= \a -> unLazy (fm2 a))+  {-# INLINE (>>=) #-}++instance MonadFail m => MonadFail (LazyT s m) where+  fail s = LazyT (fail s)+instance MonadTrans (LazyT s) where+  lift m = LazyT m++instance MonadReader r m => MonadReader r (LazyT s m) where+  ask = lift ask+  {-# INLINE ask #-}+  local f (LazyT m) = LazyT (local f m)++instance MonadState s' m => MonadState s' (LazyT s m) where+  get = lift get+  put s = lift (put s)++instance MonadIO m => MonadIO (LazyT s m) where+  {-# INLINE liftIO #-}+  liftIO io = LazyT (liftIO io)++instance MonadUnliftIO m => MonadUnliftIO (LazyT s m) where+  {-# INLINE withRunInIO #-}+  withRunInIO inner =+    LazyT $ withRunInIO $ \run -> inner (run . unLazy)
+ test/Discovery.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --generated-module=Discovery #-}
+ test/Driver.hs view
@@ -0,0 +1,13 @@+module Driver where++import qualified Discovery+import Relude+import Test.Tasty++main :: IO ()+main = defaultMain =<< testTree+  where+    testTree :: IO TestTree+    testTree = do+      tests <- Discovery.tests+      pure $ testGroup "bytestring-lazy" [ tests ]
+ test/Lazy/Scope/Test/HandleCloses.hs view
@@ -0,0 +1,45 @@+module Lazy.Scope.Test.HandleCloses where++import Data.List qualified as L+import Data.ByteString.Lazy qualified as LBS+import Foreign.C.String (withCString)+import Lazy.Scope qualified as S+import Relude+import System.IO (openTempFile, hClose, hPutStrLn)+import System.Posix.Internals (c_unlink)+import Test.Tasty (TestTree, testGroup, withResource)+import Test.Tasty.QuickCheck (testProperty, ioProperty)+++n :: Int+n = 1000++test_suite :: TestTree+test_suite = withResource+  (do (fn, h) <- openTempFile "." "lazy-hclose-test.tmp"; hPutStrLn h "xaoeuaoeuaoeuaoeuaoeuaoeuao\naoeuaoeuaoeu"; hClose h; pure fn)+  removeFile $ \fn' ->+    testGroup "LazyHClose"+    [ testProperty "Testing hGetLine" $ ioProperty $+        forM_ [1..n] $ const $ do+          fn <- fn'+          r <- S.withBinaryFile fn ReadMode $ \h -> S.hGetLine h+          L.last r `seq` return ()+          appendFile fn "" -- will fail, if fn has not been closed yet+    , testProperty "Testing With lazy hGetContents" $ ioProperty $+        forM_ [1..n] $ const $ do+          fn <- fn'+          S.withBinaryFile fn ReadMode $+            \h -> do+              r <- S.hGetContents h+              S.unsnoc r `seq` return ()+          appendFile fn "" -- will fail, if fn has not been closed yet+    , testProperty "Testing lazy withBinaryFile seq result" $ ioProperty $+        forM_ [1..n] $ const $ do+          fn <- fn'+          r <- S.withBinaryFile fn ReadMode (S.hGetContents >=> S.toLbs)+          LBS.unsnoc r `seq` return ()+          appendFile fn "" -- will fail, if fn has not been closed yet+    ]++removeFile :: String -> IO ()+removeFile fn = void $ withCString fn c_unlink