yaftee-conduit-bytestring (empty) → 0.1.0.0
raw patch · 17 files changed
+1124/−0 lines, 17 filesdep +arraydep +basedep +bitarray-bssetup-changed
Dependencies added: array, base, bitarray-bs, bytestring, higher-order-open-union, tools-yj, typelevel-tools-yj, yaftee, yaftee-basic-monads, yaftee-conduit, yaftee-conduit-bytestring
Files
- CHANGELOG.md +11/−0
- LICENSE +26/−0
- README.md +3/−0
- Setup.hs +2/−0
- src/Control/Monad/Yaftee/Pipe/Bits.hs +56/−0
- src/Control/Monad/Yaftee/Pipe/ByteString.hs +105/−0
- src/Control/Monad/Yaftee/Pipe/ByteString/Adler32.hs +55/−0
- src/Control/Monad/Yaftee/Pipe/ByteString/Adler32/Common.hs +44/−0
- src/Control/Monad/Yaftee/Pipe/ByteString/Crc.hs +101/−0
- src/Control/Monad/Yaftee/Pipe/ByteString/Crc/Common.hs +66/−0
- src/Control/Monad/Yaftee/Pipe/ByteString/Lazy.hs +95/−0
- src/Control/Monad/Yaftee/Pipe/ByteString/Lazy/Adler32.hs +55/−0
- src/Control/Monad/Yaftee/Pipe/ByteString/Lazy/Crc.hs +102/−0
- src/Control/Monad/Yaftee/Pipe/ByteString/Lazy/OnDemand.hs +154/−0
- src/Control/Monad/Yaftee/Pipe/ByteString/OnDemand.hs +163/−0
- test/Spec.hs +2/−0
- yaftee-conduit-bytestring.cabal +84/−0
+ CHANGELOG.md view
@@ -0,0 +1,11 @@+# Changelog for `yaftee-conduit-bytestring`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - YYYY-MM-DD
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright 2025 Yoshikuni Jujo++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,3 @@+# yaftee-conduit-bytestring++Yaftee Conduit tools for ByteString.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Control/Monad/Yaftee/Pipe/Bits.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe.Bits (++ toByteString, toByteString', Queue, empty++ ) where++import Control.Arrow+import Control.Monad.Fix+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.Pipe qualified as Pipe+import Control.Monad.Yaftee.State qualified as State+import Control.HigherOpenUnion qualified as U+import Data.Bool+import Data.ByteString qualified as BS+import Data.ByteString.Bit (pattern O)+import Data.ByteString.Bit qualified as Bit++toByteString :: forall nm -> (U.Member Pipe.P es, U.Member (State.Named nm Queue) es) =>+ Eff.E es [Bit.B] BS.ByteString r+toByteString nm = fix \go -> (>> go) do+ State.modifyN nm . flip append =<< Pipe.await+ Pipe.yield =<< uncurry (<$)+ . (BS.pack *** State.putN nm . Queue) . unfoldr' Bit.popByte =<< State.getsN nm unQueue++toByteString' :: forall nm -> (U.Member Pipe.P es, U.Member (State.Named nm Queue) es) =>+ Eff.E es [Bit.B] BS.ByteString ()+toByteString' nm = fix \go -> Pipe.isMore >>= bool+ do State.modifyN nm $ Queue . (`Bit.append` [O, O, O, O, O, O, O]) . unQueue+ Pipe.yield =<< uncurry (<$)+ . (BS.pack *** State.putN nm . Queue)+ . unfoldr' Bit.popByte =<< State.getsN nm unQueue+ do State.modifyN nm . flip append =<< Pipe.await+ Pipe.yield =<< uncurry (<$)+ . (BS.pack *** State.putN nm . Queue)+ . unfoldr' Bit.popByte =<< State.getsN nm unQueue+ go+ ++unfoldr' :: (b -> Maybe (a, b)) -> b -> ([a], b)+unfoldr' f = fix \go s -> maybe ([], s) (\(x, s') -> (x :) `first` go s') $ f s++newtype Queue = Queue { unQueue :: Bit.Queue } deriving Show++empty :: Queue+empty = Queue Bit.empty++append :: Queue -> [Bit.B] -> Queue+append (Queue q) bs = Queue $ q `Bit.append` bs
+ src/Control/Monad/Yaftee/Pipe/ByteString.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, OverloadedStrings #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe.ByteString (++ -- * PACKAGE NAME++ Pkg,++ -- * STANDARD INPUT/OUTPUT++ putStr, putStr',++ -- * HANDLE++ hGet, hGet', hPutStr, hPutStr',++ -- * LENGTH++ lengthRun, length, length',+ Length, lengthToByteString, byteStringToLength++ ) where++import Prelude hiding (putStr, length)+import Control.Monad.Fix+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.Pipe qualified as Pipe+import Control.Monad.Yaftee.State qualified as State+import Control.Monad.Yaftee.IO qualified as IO+import Control.HigherOpenUnion qualified as U+import Data.HigherFunctor qualified as HFunctor+import Data.Bits+import Data.Bool+import Data.ByteString qualified as BS+import System.IO hiding (putStr, hPutStr)++type Pkg = "try-yaftee-conduit-bytestring"++hGet :: (U.Member Pipe.P es, U.Base (U.FromFirst IO) es) =>+ Int -> Handle -> Eff.E es i BS.ByteString ()+hGet bfsz h = fix \go -> Eff.effBase (not <$> hIsEOF h) >>=+ bool (pure ()) (Eff.effBase (BS.hGetSome h bfsz) >>= Pipe.yield >> go)++hGet' :: (U.Member Pipe.P es, U.Base (U.FromFirst IO) es) =>+ Int -> Handle -> Eff.E es i (Maybe BS.ByteString) ()+hGet' bfsz h = fix \go -> Eff.effBase (not <$> hIsEOF h) >>= bool+ (Pipe.yield Nothing)+ (Eff.effBase (BS.hGetSome h bfsz) >>= Pipe.yield . Just >> go)++putStr :: (U.Member Pipe.P es, U.Base IO.I es) => Eff.E es BS.ByteString o r+putStr = fix \go -> Pipe.await >>= Eff.effBase . BS.putStr >> go++putStr' :: (U.Member Pipe.P es, U.Base IO.I es) => Eff.E es BS.ByteString o ()+putStr' = fix \go -> Pipe.isMore >>= bool (pure ())+ (Pipe.await >>= Eff.effBase . BS.putStr >> go)++hPutStr :: (U.Member Pipe.P es, U.Base IO.I es) =>+ Handle -> Eff.E es BS.ByteString o ()+hPutStr h = fix \go -> (>> go) $ Eff.effBase . BS.hPutStr h =<< Pipe.await++hPutStr' :: (U.Member Pipe.P es, U.Base IO.I es) =>+ Handle -> Eff.E es BS.ByteString o ()+hPutStr' h = fix \go -> Pipe.isMore >>= bool (pure ())+ ((>> go) $ Eff.effBase . BS.hPutStr h =<< Pipe.await)++lengthRun :: forall nm es i o a . HFunctor.Loose (U.U es) =>+ Eff.E (State.Named nm Length ': es) i o a -> Eff.E es i o (a, Length)+lengthRun = (`State.runN` (0 :: Length))++length :: forall nm -> (U.Member Pipe.P es, U.Member (State.Named nm Length) es) =>+ Eff.E es BS.ByteString BS.ByteString r+length nm = fix \go -> Pipe.await >>= \bs ->+ State.modifyN nm (+ Length (BS.length bs)) >> Pipe.yield bs >> go++length' :: forall nm -> (U.Member Pipe.P es, U.Member (State.Named nm Length) es) =>+ Eff.E es BS.ByteString BS.ByteString ()+length' nm = fix \go -> Pipe.isMore >>= bool (pure ())+ ((>> go) $ Pipe.await >>= \bs ->+ State.modifyN nm (+ Length (BS.length bs)) >> Pipe.yield bs)++newtype Length = Length { unLength :: Int }+ deriving (Show, Eq, Ord, Enum, Num, Real, Integral)++lengthToByteString :: Length -> BS.ByteString+lengthToByteString = BS.pack . go (4 :: Int) . unLength+ where+ go n _ | n < 1 = []+ go n ln = fromIntegral ln : go (n - 1) (ln `shiftR` 8)++byteStringToLength :: BS.ByteString -> Maybe Length+byteStringToLength = (Length <$>) . go (4 :: Int) . BS.unpack+ where+ go 0 [] = Just 0+ go n (w : ws)+ | n > 0 = (fromIntegral w .|.) . (`shiftL` 8) <$> go (n - 1) ws+ go _ _ = Nothing
+ src/Control/Monad/Yaftee/Pipe/ByteString/Adler32.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe.ByteString.Adler32 (++ run_, adler32, adler32',++ A, toWord32, adler32Step++ ) where++import Prelude hiding (uncurry)+import Control.Monad.Fix+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.Pipe qualified as Pipe+import Control.Monad.Yaftee.Pipe.ByteString.Adler32.Common+import Control.Monad.Yaftee.State qualified as State+import Control.HigherOpenUnion qualified as U+import Data.ByteString qualified as BS++adler32Step :: (Int, A) -> BS.ByteString -> (Int, A)+adler32Step = BS.foldl \(n, A a b) w -> case n of+ 0 -> (5551, A ((a + fromIntegral w) `mod` 65521) ((b + a + fromIntegral w) `mod` 65521))+ _ -> (n - 1, A (a + fromIntegral w) (b + a + fromIntegral w))++adler32 :: forall nm -> (+ U.Member Pipe.P es,+ U.Member (State.Named nm A) es ) =>+ Eff.E es BS.ByteString BS.ByteString r+adler32 nm = ($ 5551) $ fix \go n -> do+ bs <- Pipe.await+ a <- State.getN nm+ let !(!n', !a') = adler32Step (n, a) bs+ State.putN nm a'+ Pipe.yield bs+ go n'++adler32' :: forall nm -> (+ U.Member Pipe.P es,+ U.Member (State.Named nm A) es ) =>+ Eff.E es BS.ByteString BS.ByteString ()+adler32' nm = ($ 5551) $ fix \go n -> Pipe.awaitMaybe >>= \case+ Nothing -> pure ()+ Just bs -> do+ a <- State.getN nm+ let (n', a') = adler32Step (n, a) bs+ State.putN nm a'+ Pipe.yield bs+ go n'
+ src/Control/Monad/Yaftee/Pipe/ByteString/Adler32/Common.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe.ByteString.Adler32.Common (++ run_,++ A(..), toWord32,++ ) where++import Prelude hiding (uncurry)+import Control.Monad+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.State qualified as State+import Control.HigherOpenUnion qualified as U+import Data.HigherFunctor qualified as HFunctor+import Data.Bits+import Data.Word++run_ :: forall nm es i o r .+ HFunctor.Loose (U.U es) =>+ Eff.E (State.Named nm A ': es) i o r -> Eff.E es i o ()+run_ = void . (`State.runN` A 1 0)++data A = A !Word32 !Word32 deriving Show++toWord32 :: A -> Word32+toWord32 = uncurry (.|.) . first (`mod` 65521) . second ((`shiftL` 16) . (`mod` 65521))++first :: (Word32 -> Word32) -> A -> A+first f (A a b) = A (f a) b++second :: (Word32 -> Word32) -> A -> A+second f (A a b) = A a (f b)++uncurry :: (Word32 -> Word32 -> a) -> A -> a+uncurry f (A a b) = f a b
+ src/Control/Monad/Yaftee/Pipe/ByteString/Crc.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe.ByteString.Crc (++ -- * PIPE++ runCrc32, crc32, crc32', resetCrc32, compCrc32,++ -- * NO PIPE++ crc32StepBS, crc32StepBS', initialCrc32, complementCrc32,++ -- * TYPE++ Crc32(..),++ crc32ToByteString, byteStringToCrc32,+ crc32ToByteStringBE, byteStringToCrc32BE,++ ) where++import Control.Monad.Fix+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.Pipe qualified as Pipe+import Control.Monad.Yaftee.Pipe.ByteString.Crc.Common+import Control.Monad.Yaftee.State qualified as State+import Control.HigherOpenUnion qualified as U+import Data.Bits+import Data.Bool+import Data.Word+import Data.ByteString qualified as BS++crc32 :: forall nm -> (U.Member Pipe.P es, U.Member (State.Named nm Crc32) es) =>+ Eff.E es BS.ByteString BS.ByteString r+crc32 nm = do+ State.putN nm $ Crc32 0xffffffff+ crc32Body nm++crc32' :: forall nm -> (U.Member Pipe.P es, U.Member (State.Named nm Crc32) es) =>+ Eff.E es BS.ByteString BS.ByteString ()+crc32' nm = do+ State.putN nm $ Crc32 0xffffffff+ crc32Body' nm++crc32Body :: forall nm -> (U.Member Pipe.P es, U.Member (State.Named nm Crc32) es) =>+ Eff.E es BS.ByteString BS.ByteString r+crc32Body nm = fix \go -> Pipe.await >>= \bs -> do+ State.modifyN nm \(Crc32 c) -> Crc32 $ c `crc32StepBS` bs+ Pipe.yield bs+ go++crc32Body' :: forall es . forall nm -> (U.Member Pipe.P es, U.Member (State.Named nm Crc32) es) =>+ Eff.E es BS.ByteString BS.ByteString ()+crc32Body' nm = fix \go ->+ Pipe.isMore >>= bool (pure ()) (Pipe.await >>= \bs -> do+ State.modifyN nm \(Crc32 c) -> Crc32 $! c `crc32StepBS` bs+ Pipe.yield bs+ go)++crc32ToByteString :: Crc32 -> BS.ByteString+crc32ToByteString (Crc32 c) = bs `BS.append` BS.replicate (4 - BS.length bs) 0+ where+ bs = numToBs c+ numToBs 0 = ""+ numToBs n = fromIntegral (n .&. 0xff) `BS.cons` numToBs (n `shiftR` 8)++crc32ToByteStringBE :: Crc32 -> BS.ByteString+crc32ToByteStringBE (Crc32 c) = BS.replicate (4 - BS.length bs) 0 `BS.append` bs+ where+ bs = numToBs c ""+ numToBs 0 b = b+ numToBs n b = numToBs (n `shiftR` 8) (fromIntegral (n .&. 0xff) `BS.cons` b)++byteStringToCrc32 :: BS.ByteString -> Maybe Crc32+byteStringToCrc32 = (Crc32 <$>) . go (4 :: Int) . BS.unpack+ where+ go 0 [] = Just 0+ go n (w : ws)+ | n > 0 = (fromIntegral w .|.) . (`shiftL` 8) <$> go (n - 1) ws+ go _ _ = Nothing++byteStringToCrc32BE :: BS.ByteString -> Maybe Crc32+byteStringToCrc32BE = (Crc32 <$>) . go (4 :: Int) 0 . BS.unpack+ where+ go 0 s [] = Just s+ go n s (w : ws)+ | n > 0 = go (n - 1) (fromIntegral w .|. s `shiftL` 8) ws+ go _ _ _ = Nothing++crc32StepBS :: Word32 -> BS.ByteString -> Word32+crc32StepBS = BS.foldl' crc32Step++crc32StepBS' :: Crc32 -> BS.ByteString -> Crc32+crc32StepBS' = (Crc32 .) . BS.foldl' crc32Step . unCrc32
+ src/Control/Monad/Yaftee/Pipe/ByteString/Crc/Common.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe.ByteString.Crc.Common (++ -- * RUN STATE++ runCrc32, resetCrc32, compCrc32,+++ -- * TYPE++ Crc32(..), crc32Step, initialCrc32, complementCrc32++ ) where++import Control.Arrow+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.State qualified as State+import Control.HigherOpenUnion qualified as U+import Data.HigherFunctor qualified as HFunctor+import Data.Bits+import Data.Bits.ToolsYj+import Data.Array+import Data.Bool+import Data.Word++runCrc32 :: forall nm es i o r . HFunctor.Loose (U.U es) =>+ Eff.E (State.Named nm Crc32 ': es) i o r -> Eff.E es i o (r, Crc32)+runCrc32 = (`State.runN` Crc32 0)++resetCrc32 :: forall nm -> U.Member (State.Named nm Crc32) es =>+ Eff.E es i o ()+resetCrc32 nm = State.putN nm $ Crc32 0xffffffff++compCrc32 :: forall nm -> U.Member (State.Named nm Crc32) es => Eff.E es i o ()+compCrc32 nm = State.modifyN nm \(Crc32 c) -> Crc32 $ complement c++newtype Crc32 = Crc32 { unCrc32 :: Word32 } deriving (Show, Eq)++crc1 :: Word32 -> Word32+crc1 = uncurry (bool id (`xor` 0xedb88320)) . popBit++crc8 :: Word8 -> Word32+crc8 n = iterate crc1 (fromIntegral n) !! 8++table :: Array Word8 Word32+table = listArray (0, 255) $ map crc8 [0 .. 255]++popByte :: (Integral a, Bits a) => a -> (Word8, a)+popByte n = (fromIntegral n, n `shiftR` 8)++crc32Step :: Word32 -> Word8 -> Word32+crc32Step n b = uncurry xor . (first $ (table !) . (`xor` b)) $ popByte n++initialCrc32 :: Crc32+initialCrc32 = Crc32 0xffffffff++complementCrc32 :: Crc32 -> Crc32+complementCrc32 = Crc32 . complement . unCrc32
+ src/Control/Monad/Yaftee/Pipe/ByteString/Lazy.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE KindSignatures, TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe.ByteString.Lazy (++ -- * HANDLE++ hGet, hGet', hPutStr, hPutStr',++ -- * LENGTH++ lengthRun, length, length',+ Length, lengthToByteString, lengthFromByteString++ ) where++import Prelude hiding (length)+import Control.Monad+import Control.Monad.Fix+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.Pipe qualified as Pipe+import Control.Monad.Yaftee.State qualified as State+import Control.Monad.Yaftee.IO qualified as IO+import Control.HigherOpenUnion qualified as U+import Data.HigherFunctor qualified as HFunctor+import Data.Bits+import Data.Bool+import Data.Int+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as LBS+import System.IO (Handle, hIsEOF)++hGet :: (U.Member Pipe.P es, U.Base IO.I es) =>+ Int -> Handle -> Eff.E es i LBS.ByteString ()+hGet bfsz h = fix \go -> Eff.effBase (not <$> hIsEOF h) >>= bool (pure ())+ (Eff.effBase (BS.hGetSome h bfsz) >>= Pipe.yield . LBS.fromStrict >> go)++hGet' :: (U.Member Pipe.P es, U.Base IO.I es) =>+ Int -> Handle -> Eff.E es i (Maybe LBS.ByteString) ()+hGet' bfsz h = fix \go -> Eff.effBase (not <$> hIsEOF h) >>= bool+ (Pipe.yield Nothing)+ (Eff.effBase (BS.hGetSome h bfsz)+ >>= Pipe.yield . Just . LBS.fromStrict >> go)++hPutStr :: (U.Member Pipe.P es, U.Base IO.I es) =>+ Handle -> Eff.E es LBS.ByteString o r+hPutStr h = fix \go -> (>> go) $ Eff.effBase . LBS.hPut h =<< Pipe.await++hPutStr' :: (U.Member Pipe.P es, U.Base IO.I es) =>+ Handle -> Eff.E es LBS.ByteString o ()+hPutStr' h = fix \go -> Pipe.isMore >>= bool (pure ())+ ((>> go) $ Eff.effBase . LBS.hPut h =<< Pipe.await)++lengthRun :: forall nm es i o r . HFunctor.Loose (U.U es) =>+ Eff.E (State.Named nm Length ': es) i o r -> Eff.E es i o (r, Length)+lengthRun = (`State.runN` (0 :: Length))++length :: forall nm -> (+ U.Member Pipe.P es,+ U.Member (State.Named nm Length) es ) =>+ Eff.E es LBS.ByteString LBS.ByteString r+length nm = forever $ Pipe.await >>= \bs ->+ State.modifyN nm (+ Length (LBS.length bs)) >> Pipe.yield bs++length' :: forall nm -> (+ U.Member Pipe.P es,+ U.Member (State.Named nm Length) es ) =>+ Eff.E es LBS.ByteString LBS.ByteString ()+length' nm = fix \go -> Pipe.awaitMaybe >>= \case+ Nothing -> pure ()+ Just bs -> (>> go)+ $ State.modifyN nm (+ Length (LBS.length bs)) >> Pipe.yield bs++newtype Length = Length { unLength :: Int64 }+ deriving (Show, Eq, Ord, Enum, Num, Real, Integral)++lengthToByteString :: Int -> Length -> LBS.ByteString+lengthToByteString n0 = LBS.pack . go n0 . unLength+ where+ go n _ | n < 1 = []+ go n ln = fromIntegral ln : go (n - 1) (ln `shiftR` 8)++lengthFromByteString :: Int -> LBS.ByteString -> Maybe Length+lengthFromByteString n0 = (Length <$>) . go n0 . LBS.unpack+ where+ go 0 [] = Just 0+ go n (w : ws)+ | n > 0 = (fromIntegral w .|.) . (`shiftL` 8) <$> go (n - 1) ws+ go _ _ = Nothing
+ src/Control/Monad/Yaftee/Pipe/ByteString/Lazy/Adler32.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe.ByteString.Lazy.Adler32 (++ run_, adler32, adler32',++ A, toWord32, adler32Step++ ) where++import Prelude hiding (uncurry)+import Control.Monad.Fix+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.Pipe qualified as Pipe+import Control.Monad.Yaftee.Pipe.ByteString.Adler32.Common+import Control.Monad.Yaftee.State qualified as State+import Control.HigherOpenUnion qualified as U+import Data.ByteString.Lazy qualified as LBS++adler32Step :: (Int, A) -> LBS.ByteString -> (Int, A)+adler32Step = LBS.foldl \(n, A a b) w -> case n of+ 0 -> (5551, A ((a + fromIntegral w) `mod` 65521) ((b + a + fromIntegral w) `mod` 65521))+ _ -> (n - 1, A (a + fromIntegral w) (b + a + fromIntegral w))++adler32 :: forall nm -> (+ U.Member Pipe.P es,+ U.Member (State.Named nm A) es ) =>+ Eff.E es LBS.ByteString LBS.ByteString r+adler32 nm = ($ 5551) $ fix \go n -> do+ bs <- Pipe.await+ a <- State.getN nm+ let !(!n', !a') = adler32Step (n, a) bs+ State.putN nm a'+ Pipe.yield bs+ go n'++adler32' :: forall nm -> (+ U.Member Pipe.P es,+ U.Member (State.Named nm A) es ) =>+ Eff.E es LBS.ByteString LBS.ByteString ()+adler32' nm = ($ 5551) $ fix \go n -> Pipe.awaitMaybe >>= \case+ Nothing -> pure ()+ Just bs -> do+ a <- State.getN nm+ let (n', a') = adler32Step (n, a) bs+ State.putN nm a'+ Pipe.yield bs+ go n'
+ src/Control/Monad/Yaftee/Pipe/ByteString/Lazy/Crc.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe.ByteString.Lazy.Crc (++ -- * PIPE AND STATE++ runCrc32, crc32, crc32', resetCrc32, compCrc32,++ -- * NO PIPE++ crc32StepBS, crc32StepBS', initialCrc32, complementCrc32,++ -- * TYPE++ Crc32(..),++ crc32ToByteString, crc32ToByteStringBE,+ crc32FromByteString, crc32FromByteStringBE++) where++import Control.Monad.Fix+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.Pipe qualified as Pipe+import Control.Monad.Yaftee.Pipe.ByteString.Crc.Common+import Control.Monad.Yaftee.State qualified as State+import Control.HigherOpenUnion qualified as U+import Data.Bits+import Data.Word+import Data.ByteString.Lazy qualified as LBS++crc32 :: forall nm ->+ (U.Member Pipe.P es, U.Member (State.Named nm Crc32) es) =>+ Eff.E es LBS.ByteString LBS.ByteString r+crc32 nm = State.putN nm (Crc32 0xffffffff) >> crc32Body nm++crc32Body :: forall nm ->+ (U.Member Pipe.P es, U.Member (State.Named nm Crc32) es) =>+ Eff.E es LBS.ByteString LBS.ByteString r+crc32Body nm = fix \go -> Pipe.await >>= \bs -> do+ State.modifyN nm \(Crc32 c) -> Crc32 $ c `crc32StepBS` bs+ Pipe.yield bs+ go++crc32' :: forall nm ->+ (U.Member Pipe.P es, U.Member (State.Named nm Crc32) es) =>+ Eff.E es LBS.ByteString LBS.ByteString ()+crc32' nm = State.putN nm (Crc32 0xffffffff) >> crc32Body' nm++crc32Body' :: forall nm ->+ (U.Member Pipe.P es, U.Member (State.Named nm Crc32) es) =>+ Eff.E es LBS.ByteString LBS.ByteString ()+crc32Body' nm = fix \go -> Pipe.awaitMaybe >>= \case+ Nothing -> pure ()+ Just bs -> do+ State.modifyN nm \(Crc32 c) -> Crc32 $! c `crc32StepBS` bs+ Pipe.yield bs+ go++crc32StepBS :: Word32 -> LBS.ByteString -> Word32+crc32StepBS = LBS.foldl' crc32Step++crc32StepBS' :: Crc32 -> LBS.ByteString -> Crc32+crc32StepBS' = (Crc32 .) . LBS.foldl' crc32Step . unCrc32++crc32ToByteString :: Crc32 -> LBS.ByteString+crc32ToByteString (Crc32 c) =+ bs `LBS.append` LBS.replicate (4 - LBS.length bs) 0+ where+ bs = numToBs c+ numToBs 0 = ""+ numToBs n = fromIntegral (n .&. 0xff) `LBS.cons` numToBs (n `shiftR` 8)++crc32ToByteStringBE :: Crc32 -> LBS.ByteString+crc32ToByteStringBE (Crc32 c) =+ LBS.replicate (4 - LBS.length bs) 0 `LBS.append` bs+ where+ bs = numToBs c ""+ numToBs 0 b = b+ numToBs n b =+ numToBs (n `shiftR` 8) (fromIntegral (n .&. 0xff) `LBS.cons` b)++crc32FromByteString :: LBS.ByteString -> Maybe Crc32+crc32FromByteString = (Crc32 <$>) . go (4 :: Int) . LBS.unpack+ where+ go 0 [] = Just 0+ go n (w : ws)+ | n > 0 = (fromIntegral w .|.) . (`shiftL` 8) <$> go (n - 1) ws+ go _ _ = Nothing++crc32FromByteStringBE :: LBS.ByteString -> Maybe Crc32+crc32FromByteStringBE = (Crc32 <$>) . go (4 :: Int) 0 . LBS.unpack+ where+ go 0 s [] = Just s+ go n s (w : ws)+ | n > 0 = go (n - 1) (fromIntegral w .|. s `shiftL` 8) ws+ go _ _ _ = Nothing
+ src/Control/Monad/Yaftee/Pipe/ByteString/Lazy/OnDemand.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE DataKinds, ConstraintKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe.ByteString.Lazy.OnDemand (++ -- * RUN++ run_, States,++ -- * ON DEMAND++ onDemand, onDemandWithInitial, Members, Request(..), BitArray++ ) where++import Control.Monad+import Control.Monad.Fix+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.Pipe qualified as Pipe+import Control.Monad.Yaftee.State qualified as State+import Control.Monad.Yaftee.Except qualified as Except+import Control.HigherOpenUnion qualified as U+import Data.TypeLevel.List+import Data.HigherFunctor qualified as HFunctor+import Data.Bool+import Data.Int+import Data.ByteString.Lazy qualified as LBS+import Data.ByteString.Lazy.ToolsYj qualified as LBS+import Data.ByteString.Lazy.BitArray qualified as BitArray++run_ :: forall nm es i o a . HFunctor.Loose (U.U es) =>+ Eff.E (States nm `Append` es) i o a -> Eff.E es i o ()+run_ = void+ . (flip (State.runN @nm) $ BitArray BitArray.empty)+ . (flip (State.runN @nm) $ RequestBuffer 100)++type States nm = '[State.Named nm Request, State.Named nm BitArray]++onDemand :: forall es r . forall nm -> (+ U.Member Pipe.P es,+ Members nm es, U.Member (Except.E String) es ) =>+ Eff.E es LBS.ByteString (Either BitArray.B LBS.ByteString) r+onDemand nm = fix \go -> State.getN nm >>= \case+ RequestBits ln -> takeBits nm ln >>=+ maybe (Except.throw errne) ((>> go) . Pipe.yield)+ RequestBytes ln -> takeBytes nm ln >>=+ maybe (Except.throw errne) ((>> go) . Pipe.yield)+ RequestBuffer ln -> takeBuffer nm ln >>=+ maybe (Except.throw errne) ((>> go) . Pipe.yield)+ RequestString -> takeString nm >>=+ maybe (Except.throw errne) ((>> go) . Pipe.yield)+ RequestPushBack ba ->+ State.modifyN nm (BitArray . (ba `BitArray.append`) . unBitArray) >>+ Pipe.yield (Right "") >> go+ where+ errne :: String+ errne = "Not enough ByteString"++onDemandWithInitial :: forall es r . forall nm ->+ (U.Member Pipe.P es, Members nm es, U.Member (Except.E String) es) =>+ LBS.ByteString ->+ Eff.E es LBS.ByteString (Either BitArray.B LBS.ByteString) r+onDemandWithInitial nm ib = do+ State.putN nm . BitArray $ BitArray.fromByteString ib+ onDemand nm++type Members nm es = (+ U.Member (State.Named nm Request) es,+ U.Member (State.Named nm BitArray) es )++data Request+ = RequestBits Int64+ | RequestBytes Int64+ | RequestBuffer Int64+ | RequestString+ | RequestPushBack BitArray.B+ deriving Show++newtype BitArray = BitArray { unBitArray :: BitArray.B } deriving Show++takeBits :: forall es o . forall nm -> (+ U.Member Pipe.P es,+ U.Member (State.Named nm BitArray) es ) =>+ Int64 -> Eff.E es LBS.ByteString o+ (Maybe (Either BitArray.B LBS.ByteString))+takeBits nm ln = State.getsN nm unBitArray >>= \ba -> case BitArray.splitAt ln ba of+ Nothing -> readMore nm >>= bool (pure Nothing) (takeBits nm ln)+ Just (t, d) -> Just (BitArray.toByteString t) <$ State.putN nm (BitArray d)++takeBytes :: forall nm -> (+ U.Member Pipe.P es,+ U.Member (State.Named nm BitArray) es ) =>+ Int64 -> Eff.E es LBS.ByteString o+ (Maybe (Either BitArray.B LBS.ByteString))+takeBytes nm ln = State.getsN nm unBitArray >>= \ba -> case BitArray.byteBoundary ba of+ Left (t, d) -> Just (Left t) <$ State.putN nm (BitArray d)+ Right b -> case BitArray.toByteString b of+ Left _ -> error "bad"+ Right bs -> case LBS.splitAt' ln bs of+ Nothing -> readMore nm >>= bool (pure Nothing) (takeBytes nm ln)+ Just (t, d) -> Just (Right t)+ <$ State.putN nm (BitArray $ BitArray.fromByteString d)++takeBuffer :: forall nm -> (+ U.Member Pipe.P es,+ U.Member (State.Named nm BitArray) es ) =>+ Int64 -> Eff.E es LBS.ByteString o+ (Maybe (Either BitArray.B LBS.ByteString))+takeBuffer nm ln = State.getsN nm unBitArray >>= \ba -> case BitArray.byteBoundary ba of+ Left (t, d) -> Just (Left t) <$ State.putN nm (BitArray d)+ Right b -> case BitArray.toByteString b of+ Left _ -> error "bad"+ Right bs -> case LBS.splitAt' ln bs of+ Nothing -> readMore nm >>= bool+ (bool (Just (Right bs) <$ State.putN nm (BitArray BitArray.empty))+ (pure Nothing) (LBS.null bs))+ (takeBuffer nm ln)+ Just (t, d) -> Just (Right t)+ <$ State.putN nm (BitArray $ BitArray.fromByteString d)++takeString :: forall nm ->+ (U.Member Pipe.P es, U.Member (State.Named nm BitArray) es) =>+ Eff.E es LBS.ByteString o+ (Maybe (Either BitArray.B LBS.ByteString))+takeString nm = State.getsN nm unBitArray >>= \ba -> case BitArray.byteBoundary ba of+ Left (t, d) -> Just (Left t) <$ State.putN nm (BitArray d)+ Right b -> case BitArray.toByteString b of+ Left _ -> error "bad"+ Right bs -> case splitString bs of+ Nothing -> readMore nm >>= bool (pure Nothing) (takeString nm)+ Just (t, d) -> Just (Right t)+ <$ State.putN nm (BitArray $ BitArray.fromByteString d)++splitString :: LBS.ByteString -> Maybe (LBS.ByteString, LBS.ByteString)+splitString bs = case LBS.span (/= 0) bs of+ (_, "") -> Nothing+ (t, LBS.uncons -> Just (z, d)) -> Just (LBS.snoc t z, d)+ _ -> error "Never occur"++readMore :: forall nm -> (+ U.Member Pipe.P es,+ U.Member (State.Named nm BitArray) es ) =>+ Eff.E es LBS.ByteString o Bool+readMore nm = Pipe.awaitMaybe >>= \case+ Nothing -> pure False+ Just bs -> True <$ State.modifyN nm+ (BitArray . (`BitArray.appendByteString` bs) . unBitArray)
+ src/Control/Monad/Yaftee/Pipe/ByteString/OnDemand.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE DataKinds, ConstraintKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe.ByteString.OnDemand (++ -- * RUN++ run_, States,++ -- * ON DEMAND++ onDemand, onDemandWithInitial, Members, Request(..), BitArray++ ) where++import Control.Monad+import Control.Monad.Fix+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.Pipe qualified as Pipe+import Control.Monad.Yaftee.State qualified as State+import Control.Monad.Yaftee.Except qualified as Except+import Control.HigherOpenUnion qualified as Union+import Data.TypeLevel.List+import Data.HigherFunctor qualified as HFunctor+import Data.Bool+import Data.ByteString qualified as BS+import Data.ByteString.BitArray qualified as BitArray++run_ :: forall nm es i o a . HFunctor.Loose (Union.U es) =>+ Eff.E (States nm `Append` es) i o a -> Eff.E es i o ()+run_ = void . (flip (State.runN @nm) $ RequestBuffer 100)+ . (flip (State.runN @nm) $ BitArray BitArray.empty)++type States nm = '[State.Named nm BitArray, State.Named nm Request]++onDemand :: forall es r . forall nm -> (+ Union.Member Pipe.P es,+ Members nm es, Union.Member (Except.E String) es ) =>+ Eff.E es BS.ByteString (Either BitArray.B BS.ByteString) r+onDemand nm = fix \go -> State.getN nm >>= \case+ RequestBits ln -> takeBits nm ln >>=+ maybe (Except.throw errne) ((>> go) . Pipe.yield)+ RequestBytes ln -> takeBytes nm ln >>=+ maybe (Except.throw errne) ((>> go) . Pipe.yield)+ RequestBuffer ln -> takeBuffer nm ln >>=+ maybe (Except.throw errne) ((>> go) . Pipe.yield)+ RequestString -> takeString nm >>=+ maybe (Except.throw errne) ((>> go) . Pipe.yield)+ RequestPushBack ba ->+ State.modifyN nm (BitArray . (ba `BitArray.append`) . unBitArray) >>+ Pipe.yield (Right "") >> go+ where+ errne :: String+ errne = "Not enough ByteString"++onDemandWithInitial :: forall es r . forall nm -> (+ Union.Member Pipe.P es,+ Members nm es, Union.Member (Except.E String) es ) =>+ BS.ByteString ->+ Eff.E es BS.ByteString (Either BitArray.B BS.ByteString) r+onDemandWithInitial nm ib = do+ State.putN nm . BitArray $ BitArray.fromByteString ib+ onDemand nm++type Members nm es = (+ Union.Member (State.Named nm Request) es,+ Union.Member (State.Named nm BitArray) es )++data Request+ = RequestBits Int+ | RequestBytes Int+ | RequestBuffer Int+ | RequestString+ | RequestPushBack BitArray.B+ deriving Show++newtype BitArray = BitArray { unBitArray :: BitArray.B } deriving Show++takeBits :: forall es o . forall nm -> (+ Union.Member Pipe.P es,+ Union.Member (State.Named nm BitArray) es ) =>+ Int -> Eff.E es BS.ByteString o+ (Maybe (Either BitArray.B BS.ByteString))+takeBits nm ln = State.getsN nm unBitArray >>= \ba -> case BitArray.splitAt ln ba of+ Nothing -> readMore nm >>= bool (pure Nothing) (takeBits nm ln)+ Just (t, d) -> Just (BitArray.toByteString t) <$ State.putN nm (BitArray d)++takeBytes :: forall nm -> (+ Union.Member Pipe.P es,+ Union.Member (State.Named nm BitArray) es ) =>+ Int -> Eff.E es BS.ByteString o+ (Maybe (Either BitArray.B BS.ByteString))+takeBytes nm ln = State.getsN nm unBitArray >>= \ba -> case BitArray.byteBoundary ba of+ Left (t, d) -> Just (Left t) <$ State.putN nm (BitArray d)+ Right b -> case BitArray.toByteString b of+ Left _ -> error "bad"+ Right bs -> case splitAt' ln bs of+ Nothing -> readMore nm >>= bool (pure Nothing) (takeBytes nm ln)+ Just (t, d) -> Just (Right t)+ <$ State.putN nm (BitArray $ BitArray.fromByteString d)++takeBuffer :: forall nm -> (+ Union.Member Pipe.P effs,+ Union.Member (State.Named nm BitArray) effs ) =>+ Int -> Eff.E effs BS.ByteString o+ (Maybe (Either BitArray.B BS.ByteString))+takeBuffer nm ln = State.getsN nm unBitArray >>= \ba -> case BitArray.byteBoundary ba of+ Left (t, d) -> Just (Left t) <$ State.putN nm (BitArray d)+ Right b -> case BitArray.toByteString b of+ Left _ -> error "bad"+ Right bs -> case splitAt' ln bs of+ Nothing -> readMore nm >>= bool+ (bool (Just (Right bs) <$ State.putN nm (BitArray BitArray.empty))+ (pure Nothing) (BS.null bs))+ (takeBuffer nm ln)+ Just (t, d) -> Just (Right t)+ <$ State.putN nm (BitArray $ BitArray.fromByteString d)++takeString ::+ forall nm ->+ (Union.Member Pipe.P effs, Union.Member (State.Named nm BitArray) effs) =>+ Eff.E effs BS.ByteString o+ (Maybe (Either BitArray.B BS.ByteString))+takeString nm = State.getsN nm unBitArray >>= \ba -> case BitArray.byteBoundary ba of+ Left (t, d) -> Just (Left t) <$ State.putN nm (BitArray d)+ Right b -> case BitArray.toByteString b of+ Left _ -> error "bad"+ Right bs -> case splitString bs of+ Nothing -> readMore nm >>= bool (pure Nothing) (takeString nm)+ Just (t, d) -> Just (Right t)+ <$ State.putN nm (BitArray $ BitArray.fromByteString d)++ {- case splitString . fromRight $ BitArray.toByteString bs of+ Nothing -> readMore nm >>= bool (pure Nothing) takeString+ Just (t, d) -> Just (Right t)+ <$ State.put (BitArray.fromByteString d)+ -}++splitString :: BS.ByteString -> Maybe (BS.ByteString, BS.ByteString)+splitString bs = case BS.span (/= 0) bs of+ (_, "") -> Nothing+ (t, BS.uncons -> Just (z, d)) -> Just (BS.snoc t z, d)+ _ -> error "Never occur"++splitAt' :: Int -> BS.ByteString -> Maybe (BS.ByteString, BS.ByteString)+splitAt' ln bs = if BS.length bs < ln then Nothing else Just $ BS.splitAt ln bs++readMore :: forall nm -> (+ Union.Member Pipe.P es,+ Union.Member (State.Named nm BitArray) es+ ) =>+ Eff.E es BS.ByteString o Bool+readMore nm = Pipe.awaitMaybe >>= \case+ Nothing -> pure False+ Just bs -> True <$ State.modifyN nm+ (BitArray . (`BitArray.appendByteString` bs) . unBitArray)
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"
+ yaftee-conduit-bytestring.cabal view
@@ -0,0 +1,84 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.38.1.+--+-- see: https://github.com/sol/hpack++name: yaftee-conduit-bytestring+version: 0.1.0.0+synopsis: Yaftee Conduit tools for ByteString+description: Please see the README on GitHub at <https://github.com/YoshikuniJujo/yaftee-conduit-bytestring#readme>+category: Control+homepage: https://github.com/YoshikuniJujo/yaftee-conduit-bytestring#readme+bug-reports: https://github.com/YoshikuniJujo/yaftee-conduit-bytestring/issues+author: Yoshikuni Jujo+maintainer: yoshikuni.jujo@gmail.com+copyright: (c) 2025 Yoshikuni Jujo+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+extra-doc-files:+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/YoshikuniJujo/yaftee-conduit-bytestring++library+ exposed-modules:+ Control.Monad.Yaftee.Pipe.Bits+ Control.Monad.Yaftee.Pipe.ByteString+ Control.Monad.Yaftee.Pipe.ByteString.Adler32+ Control.Monad.Yaftee.Pipe.ByteString.Adler32.Common+ Control.Monad.Yaftee.Pipe.ByteString.Crc+ Control.Monad.Yaftee.Pipe.ByteString.Crc.Common+ Control.Monad.Yaftee.Pipe.ByteString.Lazy+ Control.Monad.Yaftee.Pipe.ByteString.Lazy.Adler32+ Control.Monad.Yaftee.Pipe.ByteString.Lazy.Crc+ Control.Monad.Yaftee.Pipe.ByteString.Lazy.OnDemand+ Control.Monad.Yaftee.Pipe.ByteString.OnDemand+ other-modules:+ Paths_yaftee_conduit_bytestring+ autogen-modules:+ Paths_yaftee_conduit_bytestring+ hs-source-dirs:+ src+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+ build-depends:+ array ==0.5.*+ , base >=4.7 && <5+ , bitarray-bs ==0.1.*+ , bytestring ==0.12.*+ , higher-order-open-union ==0.1.*+ , tools-yj ==0.1.*+ , typelevel-tools-yj ==0.1.*+ , yaftee ==0.1.*+ , yaftee-basic-monads ==0.1.*+ , yaftee-conduit ==0.1.*+ default-language: Haskell2010++test-suite yaftee-conduit-bytestring-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_yaftee_conduit_bytestring+ autogen-modules:+ Paths_yaftee_conduit_bytestring+ hs-source-dirs:+ test+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ array ==0.5.*+ , base >=4.7 && <5+ , bitarray-bs ==0.1.*+ , bytestring ==0.12.*+ , higher-order-open-union ==0.1.*+ , tools-yj ==0.1.*+ , typelevel-tools-yj ==0.1.*+ , yaftee ==0.1.*+ , yaftee-basic-monads ==0.1.*+ , yaftee-conduit ==0.1.*+ , yaftee-conduit-bytestring+ default-language: Haskell2010