bitstream-0.3.0.0: Data/Bitstream/Lazy.hs
{-# LANGUAGE
BangPatterns
, CPP
, FlexibleContexts
, FlexibleInstances
, ScopedTypeVariables
, UndecidableInstances
, UnicodeSyntax
#-}
-- | Fast, packed, lazy bit streams (i.e. list of 'Bool's) with
-- semi-automatic stream fusion.
--
-- This module is intended to be imported @qualified@, to avoid name
-- clashes with "Prelude" functions. e.g.
--
-- > import qualified Data.Bitstream.Lazy as LS
--
-- Lazy 'Bitstream's are made of possibly infinite list of strict
-- 'SB.Bitstream's as chunks, and each chunks have at least 1 bit.
module Data.Bitstream.Lazy
( -- * Data types
Bitstream
, Left
, Right
-- * Introducing and eliminating 'Bitstream's
, empty
, (∅)
, singleton
, pack
, unpack
, fromChunks
, toChunks
-- ** Converting from\/to lazy 'LS.ByteString's
, fromByteString
, toByteString
-- ** Converting from\/to 'Bits''
, fromBits
, fromNBits
, toBits
-- ** Converting from\/to 'S.Stream's
, stream
, unstream
-- * Changing bit order in octets
, directionLToR
, directionRToL
-- * Basic interface
, cons
, cons'
, snoc
, append
, (⧺)
, head
, last
, tail
, init
, null
, length
-- * Transforming 'Bitstream's
, map
, reverse
-- * Reducing 'Bitstream's
, foldl
, foldl'
, foldl1
, foldl1'
, foldr
, foldr1
-- ** Special folds
, concat
, concatMap
, and
, or
, any
, all
-- * Building 'Bitstream's
-- ** Scans
, scanl
, scanl1
, scanr
, scanr1
-- ** Replications
, iterate
, repeat
, replicate
, cycle
-- ** Unfolding
, unfoldr
, unfoldrN
-- * Substreams
, take
, drop
, takeWhile
, dropWhile
, span
, break
-- * Searching streams
-- ** Searching by equality
, elem
, (∈)
, (∋)
, notElem
, (∉)
, (∌)
-- ** Searching with a predicate
, find
, filter
, partition
-- ** Indexing streams
, (!!)
, elemIndex
, elemIndices
, findIndex
, findIndices
-- * Zipping and unzipping streams
, zip
, zip3
, zip4
, zip5
, zip6
, zipWith
, zipWith3
, zipWith4
, zipWith5
, zipWith6
, unzip
, unzip3
, unzip4
, unzip5
, unzip6
-- * I/O with 'Bitstream's
-- ** Standard input and output
, getContents
, putBits
, interact
-- ** Files
, readFile
, writeFile
, appendFile
-- ** I/O with 'Handle's
, hGetContents
, hGet
, hGetNonBlocking
, hPut
)
where
import qualified Data.Bitstream as SB
import Data.Bitstream.Generic hiding (Bitstream)
import qualified Data.Bitstream.Generic as G
import Data.Bitstream.Internal
import Data.Bitstream.Packet
import qualified Data.ByteString.Lazy as LS
import qualified Data.List as L
import Data.Monoid
#if MIN_VERSION_vector(0,11,0)
import qualified Data.Vector.Fusion.Bundle as S
import qualified Data.Vector.Fusion.Bundle.Monadic as B
import Data.Vector.Fusion.Bundle (Bundle)
import Data.Vector.Fusion.Bundle.Size
#else
import qualified Data.Vector.Fusion.Stream as S
import Data.Vector.Fusion.Stream.Size
#endif
#if MIN_VERSION_base(4,9,0)
import Prelude (Semigroup(..))
#endif
import Prelude (seq)
import Data.Vector.Fusion.Stream.Monadic (Stream(..), Step(..))
import Data.Vector.Fusion.Util
import qualified Data.Vector.Generic as GV
import qualified Data.Vector.Generic.New as New
import qualified Data.Vector.Generic.Mutable as MVector
import qualified Data.Vector.Storable as SV
import Prelude ( Bool(..), Eq(..), Int, Integral, Maybe(..)
, Monad(..), Num(..), Ord(..), Show(..)
, ($), div, error, fmap, otherwise
)
import Prelude.Unicode hiding ((⧺), (∈), (∉))
import System.IO (FilePath, Handle, IO)
-- 32 KiB * sizeOf (Packet d) == 64 KiB
chunkSize ∷ Num α ⇒ α
chunkSize = fromInteger (32 ⋅ 1024)
{-# INLINE chunkSize #-}
chunkBits ∷ Num α ⇒ α
chunkBits = chunkSize ⋅ 8
-- | A space-efficient representation of a 'Bool' vector, supporting
-- many efficient operations. 'Bitstream's have an idea of
-- /directions/ controlling how octets are interpreted as bits. There
-- are two types of concrete 'Bitstream's: @'Bitstream' 'Left'@ and
-- @'Bitstream' 'Right'@.
data Bitstream d
= Empty
| Chunk {-# UNPACK #-} !(SB.Bitstream d) (Bitstream d)
instance Show (Packet d) ⇒ Show (Bitstream d) where
{-# INLINEABLE show #-}
show ch
= L.concat
[ "[L: "
, L.concat (L.intersperse " " (L.map show (toChunks ch)))
, " ]"
]
instance G.Bitstream (Bitstream d) ⇒ Eq (Bitstream d) where
{-# INLINE (==) #-}
x == y = stream x ≡ stream y
-- | 'Bitstream's are lexicographically ordered.
--
-- @
-- let x = 'pack' ['True' , 'False', 'False']
-- y = 'pack' ['False', 'True' , 'False']
-- z = 'pack' ['False']
-- in
-- [ 'compare' x y -- 'GT'
-- , 'compare' z y -- 'LT'
-- ]
-- @
instance G.Bitstream (Bitstream d) ⇒ Ord (Bitstream d) where
{-# INLINE compare #-}
x `compare` y = stream x `compare` stream y
#if MIN_VERSION_base(4,9,0)
-- | 'Bitstream' forms 'Semigroup' in the same way as ordinary lists:
--
-- @
-- '(<>)' = 'append'
-- @
instance G.Bitstream (Bitstream d) ⇒ Semigroup (Bitstream d) where
(<>) = (⧺)
#endif
-- | 'Bitstream' forms 'Monoid' in the same way as ordinary lists:
--
-- @
-- 'mempty' = 'empty'
-- 'mappend' = 'append'
-- 'mconcat' = 'concat'
-- @
instance G.Bitstream (Bitstream d) ⇒ Monoid (Bitstream d) where
mempty = (∅)
mappend = (⧺)
mconcat = concat
instance G.Bitstream (Bitstream Left) where
{-# INLINE basicStream #-}
basicStream = lazyStream
{-# INLINE basicUnstream #-}
basicUnstream = lazyUnstream
{-# INLINE basicCons #-}
basicCons = lazyCons
{-# INLINE basicCons' #-}
basicCons' = lazyCons'
{-# INLINE basicSnoc #-}
basicSnoc = lazySnoc
{-# INLINE basicAppend #-}
basicAppend = lazyAppend
{-# INLINE basicTail #-}
basicTail = lazyTail
{-# INLINE basicInit #-}
basicInit = lazyInit
{-# INLINE basicMap #-}
basicMap = lazyMap
{-# INLINE basicReverse #-}
basicReverse = lazyReverse
{-# INLINE basicConcat #-}
basicConcat = lazyConcat
{-# INLINE basicScanl #-}
basicScanl = lazyScanl
{-# INLINE basicTake #-}
basicTake = lazyTake
{-# INLINE basicDrop #-}
basicDrop = lazyDrop
{-# INLINE basicTakeWhile #-}
basicTakeWhile = lazyTakeWhile
{-# INLINE basicDropWhile #-}
basicDropWhile = lazyDropWhile
{-# INLINE basicFilter #-}
basicFilter = lazyFilter
{-# INLINE basicFromNBits #-}
basicFromNBits
= ((unId ∘ unstreamChunks ∘ packChunks) ∘) ∘ lePacketsFromNBits
{-# INLINE basicToBits #-}
basicToBits = unId ∘ lePacketsToBits ∘ unpackChunks ∘ streamChunks
instance G.Bitstream (Bitstream Right) where
{-# INLINE basicStream #-}
basicStream = lazyStream
{-# INLINE basicUnstream #-}
basicUnstream = lazyUnstream
{-# INLINE basicCons #-}
basicCons = lazyCons
{-# INLINE basicCons' #-}
basicCons' = lazyCons'
{-# INLINE basicSnoc #-}
basicSnoc = lazySnoc
{-# INLINE basicAppend #-}
basicAppend = lazyAppend
{-# INLINE basicTail #-}
basicTail = lazyTail
{-# INLINE basicInit #-}
basicInit = lazyInit
{-# INLINE basicMap #-}
basicMap = lazyMap
{-# INLINE basicReverse #-}
basicReverse = lazyReverse
{-# INLINE basicConcat #-}
basicConcat = lazyConcat
{-# INLINE basicScanl #-}
basicScanl = lazyScanl
{-# INLINE basicTake #-}
basicTake = lazyTake
{-# INLINE basicDrop #-}
basicDrop = lazyDrop
{-# INLINE basicTakeWhile #-}
basicTakeWhile = lazyTakeWhile
{-# INLINE basicDropWhile #-}
basicDropWhile = lazyDropWhile
{-# INLINE basicFilter #-}
basicFilter = lazyFilter
{-# INLINE basicFromNBits #-}
basicFromNBits
= ((unId ∘ unstreamChunks ∘ packChunks) ∘) ∘ bePacketsFromNBits
{-# INLINE basicToBits #-}
basicToBits = unId ∘ bePacketsToBits ∘ unpackChunks ∘ streamChunks
{-# INLINE lazyStream #-}
#if MIN_VERSION_vector(0,11,0)
lazyStream ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → Bundle SV.Vector Bool
#else
lazyStream ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → S.Stream Bool
#endif
lazyStream
= {-# CORE "Lazy Bitstream stream" #-}
S.concatMap stream ∘ streamChunks
{-# INLINE lazyUnstream #-}
#if MIN_VERSION_vector(0,11,0)
lazyUnstream ∷ ( G.Bitstream (SB.Bitstream d)
, G.Bitstream (Packet d)
)
⇒ Bundle v Bool
→ Bitstream d
#else
lazyUnstream ∷ ( G.Bitstream (SB.Bitstream d)
, G.Bitstream (Packet d)
)
⇒ S.Stream Bool
→ Bitstream d
#endif
lazyUnstream
= {-# CORE "Lazy Bitstream unstream" #-}
unId ∘ unstreamChunks ∘ packChunks ∘ packPackets
lazyCons ∷ G.Bitstream (SB.Bitstream d) ⇒ Bool → Bitstream d → Bitstream d
{-# INLINE lazyCons #-}
lazyCons = Chunk ∘ singleton
lazyCons' ∷ G.Bitstream (SB.Bitstream d) ⇒ Bool → Bitstream d → Bitstream d
{-# INLINEABLE lazyCons' #-}
lazyCons' b Empty
= Chunk (SB.singleton b) Empty
lazyCons' b (Chunk x xs)
| length x < (chunkBits ∷ Int)
= Chunk (b `cons` x) xs
| otherwise
= Chunk (singleton b) (Chunk x xs)
lazySnoc ∷ ( G.Bitstream (SB.Bitstream d)
, G.Bitstream (Bitstream d)
)
⇒ Bitstream d
→ Bool
→ Bitstream d
{-# INLINEABLE lazySnoc #-}
lazySnoc Empty b
= Chunk (SB.singleton b) Empty
lazySnoc (Chunk x Empty) b
| length x < (chunkBits ∷ Int)
= Chunk (x `snoc` b) Empty
| otherwise
= Chunk x (Chunk (singleton b) Empty)
lazySnoc (Chunk x xs) b
= Chunk x (xs `snoc` b)
lazyAppend ∷ G.Bitstream (Bitstream d) ⇒ Bitstream d → Bitstream d → Bitstream d
{-# INLINE lazyAppend #-}
lazyAppend Empty ch = ch
lazyAppend (Chunk x xs) ch = Chunk x (append xs ch)
lazyTail ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → Bitstream d
{-# INLINEABLE lazyTail #-}
lazyTail Empty = emptyStream
lazyTail (Chunk x xs) = case tail x of
x' | null x' → xs
| otherwise → Chunk x' xs
lazyInit ∷ ( G.Bitstream (SB.Bitstream d)
, G.Bitstream (Bitstream d)
)
⇒ Bitstream d
→ Bitstream d
{-# INLINEABLE lazyInit #-}
lazyInit Empty = emptyStream
lazyInit (Chunk x Empty) = case init x of
x' | null x' → Empty
| otherwise → Chunk x' Empty
lazyInit (Chunk x xs ) = Chunk x (init xs)
lazyMap ∷ ( G.Bitstream (SB.Bitstream d)
, G.Bitstream (Bitstream d)
)
⇒ (Bool → Bool)
→ Bitstream d
→ Bitstream d
{-# INLINE lazyMap #-}
lazyMap _ Empty = Empty
lazyMap f (Chunk x xs) = Chunk (map f x) (map f xs)
lazyReverse ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → Bitstream d
{-# INLINEABLE lazyReverse #-}
lazyReverse ch0 = go ch0 Empty
where
{-# INLINE go #-}
go Empty ch = ch
go (Chunk x xs) ch = go xs (Chunk (reverse x) ch)
lazyConcat ∷ G.Bitstream (SB.Bitstream d) ⇒ [Bitstream d] → Bitstream d
{-# INLINE lazyConcat #-}
lazyConcat = fromChunks ∘ L.concatMap toChunks
lazyScanl ∷ ( G.Bitstream (SB.Bitstream d)
, G.Bitstream (Bitstream d)
)
⇒ (Bool → Bool → Bool)
→ Bool
→ Bitstream d
→ Bitstream d
{-# INLINEABLE lazyScanl #-}
lazyScanl f b ch
= Chunk (singleton b)
(case ch of
Empty → Empty
Chunk x xs → let h = head x
x' = scanl f (f b h) (tail x)
l = last x'
x'' = init x'
xs' = scanl f l xs
in
if null x''
then xs'
else Chunk x'' xs')
lazyTake ∷ ( Integral n
, G.Bitstream (SB.Bitstream d)
, G.Bitstream (Bitstream d)
)
⇒ n
→ Bitstream d
→ Bitstream d
{-# INLINEABLE lazyTake #-}
lazyTake _ Empty = Empty
lazyTake n (Chunk x xs)
| n ≤ 0 = Empty
| n ≥ length x = Chunk x (take (n - length x) xs)
| otherwise = Chunk (take n x) Empty
lazyDrop ∷ ( Integral n
, G.Bitstream (SB.Bitstream d)
, G.Bitstream (Bitstream d)
)
⇒ n
→ Bitstream d
→ Bitstream d
{-# INLINEABLE lazyDrop #-}
lazyDrop _ Empty = Empty
lazyDrop n (Chunk x xs)
| n ≤ 0 = Chunk x xs
| n ≥ length x = drop (n - length x) xs
| otherwise = Chunk (drop n x) xs
lazyTakeWhile ∷ ( G.Bitstream (SB.Bitstream d)
, G.Bitstream (Bitstream d)
)
⇒ (Bool → Bool)
→ Bitstream d
→ Bitstream d
{-# INLINEABLE lazyTakeWhile #-}
lazyTakeWhile _ Empty = Empty
lazyTakeWhile f (Chunk x xs) = case takeWhile f x of
x' | x ≡ x' → Chunk x' (takeWhile f xs)
| otherwise → Chunk x' Empty
lazyDropWhile ∷ ( G.Bitstream (SB.Bitstream d)
, G.Bitstream (Bitstream d)
)
⇒ (Bool → Bool)
→ Bitstream d
→ Bitstream d
{-# INLINEABLE lazyDropWhile #-}
lazyDropWhile _ Empty = Empty
lazyDropWhile f (Chunk x xs) = case dropWhile f x of
x' | null x' → dropWhile f xs
| otherwise → Chunk x' xs
lazyFilter ∷ ( G.Bitstream (SB.Bitstream d)
, G.Bitstream (Bitstream d)
)
⇒ (Bool → Bool)
→ Bitstream d
→ Bitstream d
{-# INLINEABLE lazyFilter #-}
lazyFilter _ Empty = Empty
lazyFilter f (Chunk x xs) = case filter f x of
x' | null x' → filter f xs
| otherwise → Chunk x' (filter f xs)
lazyHead ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → Bool
{-# RULES "head → lazyHead" [1]
∀(v ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d).
head v = lazyHead v #-}
{-# INLINE lazyHead #-}
lazyHead Empty = emptyStream
lazyHead (Chunk x _) = head x
lazyLast ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → Bool
{-# RULES "last → lazyLast" [1]
∀(v ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d).
last v = lazyLast v #-}
{-# INLINE lazyLast #-}
lazyLast Empty = emptyStream
lazyLast (Chunk x Empty) = last x
lazyLast (Chunk _ xs ) = lazyLast xs
lazyNull ∷ Bitstream d → Bool
{-# RULES "null → lazyNull" [1] null = lazyNull #-}
{-# INLINE lazyNull #-}
lazyNull Empty = True
lazyNull _ = False
lazyLength ∷ (G.Bitstream (SB.Bitstream d), Num n) ⇒ Bitstream d → n
{-# RULES "length → lazyLength" [1]
∀(v ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d).
length v = lazyLength v #-}
{-# INLINE lazyLength #-}
lazyLength = go 0
where
{-# INLINE go #-}
go !soFar Empty = soFar
go !soFar (Chunk x xs) = go (soFar + length x) xs
lazyAnd ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → Bool
{-# RULES "and → lazyAnd" [1]
∀(v ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d).
and v = lazyAnd v #-}
{-# INLINEABLE lazyAnd #-}
lazyAnd Empty = False
lazyAnd (Chunk x xs)
| and x = lazyAnd xs
| otherwise = False
lazyOr ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d → Bool
{-# RULES "or → lazyOr" [1]
∀(v ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d).
or v = lazyOr v #-}
{-# INLINEABLE lazyOr #-}
lazyOr Empty = True
lazyOr (Chunk x xs)
| or x = True
| otherwise = lazyOr xs
lazyIndex ∷ ( G.Bitstream (SB.Bitstream d)
, Integral n
, Show n
)
⇒ Bitstream d
→ n
→ Bool
{-# RULES "(!!) → lazyIndex" [1]
∀(v ∷ G.Bitstream (SB.Bitstream d) ⇒ Bitstream d) n.
v !! n = lazyIndex v n #-}
{-# INLINEABLE lazyIndex #-}
lazyIndex ch0 i0
| i0 < 0 = indexOutOfRange i0
| otherwise = go ch0 i0
where
{-# INLINE go #-}
go Empty _ = indexOutOfRange i0
go (Chunk x xs) i
| i < length x = x !! i
| otherwise = go xs (i - length x)
emptyStream ∷ α
emptyStream
= error "Data.Bitstream.Lazy: empty stream"
{-# INLINE indexOutOfRange #-}
indexOutOfRange ∷ (Integral n, Show n) ⇒ n → α
indexOutOfRange n = error ("Data.Bitstream.Lazy: index out of range: " L.++ show n)
-- | /O(n)/ Convert a list of chunks, strict 'SB.Bitstream's, into a
-- lazy 'Bitstream'.
fromChunks ∷ G.Bitstream (SB.Bitstream d) ⇒ [SB.Bitstream d] → Bitstream d
{-# INLINE fromChunks #-}
fromChunks [] = Empty
fromChunks (x:xs)
| null x = fromChunks xs
| otherwise = Chunk x (fromChunks xs)
-- | /O(n)/ Convert a lazy 'Bitstream' into a list of chunks, strict
-- 'SB.Bitstream's.
toChunks ∷ Bitstream d → [SB.Bitstream d]
{-# INLINE toChunks #-}
toChunks Empty = []
toChunks (Chunk x xs) = x : toChunks xs
-- | /O(n)/ Convert a lazy 'LS.ByteString' into a lazy 'Bitstream'.
fromByteString ∷ G.Bitstream (SB.Bitstream d) ⇒ LS.ByteString → Bitstream d
{-# INLINE fromByteString #-}
fromByteString = fromChunks ∘ L.map SB.fromByteString ∘ LS.toChunks
-- | /O(n)/ @'toByteString' bits@ converts a lazy 'Bitstream' @bits@
-- into a lazy 'LS.ByteString'. The resulting octets will be padded
-- with zeroes if @bs@ is finite and its 'length' is not multiple of
-- 8.
toByteString ∷ ( G.Bitstream (SB.Bitstream d)
, G.Bitstream (Packet d)
)
⇒ Bitstream d
→ LS.ByteString
{-# INLINE toByteString #-}
toByteString = LS.fromChunks ∘ L.map SB.toByteString ∘ toChunks
{-# NOINLINE streamChunks #-}
#if MIN_VERSION_vector(0,11,0)
streamChunks ∷ ( G.Bitstream (SB.Bitstream d)
, Monad m
)
⇒ Bitstream d
→ B.Bundle m v (SB.Bitstream d)
streamChunks ch0 = B.fromStream (Stream step ch0) Unknown
#else
streamChunks ∷ ( G.Bitstream (SB.Bitstream d)
, Monad m
)
⇒ Bitstream d
→ Stream m (SB.Bitstream d)
streamChunks ch0 = Stream step ch0 Unknown
#endif
where
{-# INLINE step #-}
step Empty = return Done
step (Chunk x xs) = return $ Yield x xs
{-# NOINLINE unstreamChunks #-}
#if MIN_VERSION_vector(0,11,0)
unstreamChunks ∷ ( G.Bitstream (SB.Bitstream d)
, Monad m
)
⇒ B.Bundle m v (SB.Bitstream d)
→ m (Bitstream d)
unstreamChunks (B.Bundle (Stream step s0) _ _ _) = go s0
#else
unstreamChunks ∷ ( G.Bitstream (SB.Bitstream d)
, Monad m
)
⇒ Stream m (SB.Bitstream d)
→ m (Bitstream d)
unstreamChunks (Stream step s0 _) = go s0
#endif
where
{-# INLINE go #-}
go s = do r ← step s
case r of
Yield x s' → do xs ← go s'
if null x
then return xs
else return $ Chunk x xs
Skip s' → go s'
Done → return Empty
{-# RULES
"Lazy Bitstream streamChunks/unstreamChunks fusion"
∀s. streamChunks (unId (unstreamChunks s)) = s
#if MIN_VERSION_base(4,9,0)
#else
"Lazy Bitstream unstreamChunks/streamChunks fusion"
∀v. unId (unstreamChunks (streamChunks v)) = v
#endif
#-}
#if MIN_VERSION_vector(0,11,0)
inplace :: Monad m => (Stream m a -> Stream m b)
-> (Size -> Size) -> B.Bundle m v a -> B.Bundle m v b
inplace f g b = b `seq` B.fromStream (f (B.elements b)) (g (B.size b))
#endif
-- Awful implementation to gain speed...
{-# INLINEABLE packChunks #-}
#if MIN_VERSION_vector(0,11,0)
packChunks ∷ ∀d m v . (G.Bitstream (Packet d), Monad m)
⇒ B.Bundle m v (Packet d)
→ B.Bundle m v (SB.Bitstream d)
packChunks = inplace (\(Stream st s0)
-> Stream (step' st) (emptyChunk, 0, 0, Just s0)) sz'
#else
packChunks ∷ ∀d m. (G.Bitstream (Packet d), Monad m)
⇒ Stream m (Packet d)
→ Stream m (SB.Bitstream d)
packChunks (Stream st s0 sz)
= Stream (step' st) (emptyChunk, 0, 0, Just s0) (sz' sz)
#endif
where
emptyChunk ∷ New.New SV.Vector (Packet d)
{-# INLINE emptyChunk #-}
emptyChunk
= New.create (MVector.unsafeNew chunkSize)
singletonChunk ∷ Packet d → New.New SV.Vector (Packet d)
{-# INLINE singletonChunk #-}
singletonChunk = writePacket emptyChunk 0
writePacket ∷ New.New SV.Vector (Packet d)
→ Int
→ Packet d
→ New.New SV.Vector (Packet d)
{-# INLINE writePacket #-}
writePacket ch len p
= New.modify (\mv → MVector.write mv len p) ch
newChunk ∷ G.Bitstream (Packet d)
⇒ New.New SV.Vector (Packet d)
→ Int
→ Int
→ SB.Bitstream d
{-# INLINE newChunk #-}
newChunk ch cLen bLen
= SB.unsafeFromPackets bLen
$ GV.new
$ New.apply (MVector.take cLen) ch
sz' ∷ Size -> Size
{-# INLINE sz' #-}
sz' v = case v of
Exact n → Exact ((n + chunkSize - 1) `div` chunkSize)
Max n → Max ((n + chunkSize - 1) `div` chunkSize)
Unknown → Unknown
{-# INLINE step' #-}
step' step (ch, cLen, bLen, Just s)
= do r ← step s
case r of
Yield p s'
| cLen ≡ chunkSize
→ return $ Yield (newChunk ch cLen bLen)
(singletonChunk p, 1, length p, Just s')
| otherwise
→ return $ Skip (writePacket ch cLen p, cLen+1, bLen + length p, Just s')
Skip s' → return $ Skip (ch , cLen , bLen , Just s')
Done
| cLen ≡ 0
→ return Done
| otherwise
→ return $ Yield (newChunk ch cLen bLen)
((⊥), (⊥), (⊥), Nothing)
step' _ (_, _, _, Nothing)
= return Done
{-# INLINE unpackChunks #-}
#if MIN_VERSION_vector(0,11,0)
unpackChunks ∷ Bundle SV.Vector (SB.Bitstream d) → Bundle SV.Vector (Packet d)
#else
unpackChunks ∷ S.Stream (SB.Bitstream d) → S.Stream (Packet d)
#endif
unpackChunks = S.concatMap SB.streamPackets
-- | /O(n)/ Convert a @'Bitstream' 'Left'@ into a @'Bitstream'
-- 'Right'@. Bit directions only affect octet-based operations such as
-- 'toByteString'.
directionLToR ∷ Bitstream Left → Bitstream Right
{-# INLINE directionLToR #-}
directionLToR Empty = Empty
directionLToR (Chunk x xs) = Chunk (SB.directionLToR x) (directionLToR xs)
-- | /O(n)/ Convert a @'Bitstream' 'Right'@ into a @'Bitstream'
-- 'Left'@. Bit directions only affect octet-based operations such as
-- 'toByteString'.
directionRToL ∷ Bitstream Right → Bitstream Left
{-# INLINE directionRToL #-}
directionRToL Empty = Empty
directionRToL (Chunk x xs) = Chunk (SB.directionRToL x) (directionRToL xs)
{- There are only 4 functions of the type Bool → Bool.
* iterate id b == [b , b , b , b , ...]
* iterate (const True ) _ == [True , True , True , True , ...]
* iterate (const False) _ == [False, False, False, False, ...]
* iterate not True == [True , False, True , False, ...]
* iterate not False == [False, True , False, True , ...]
As seen above, all of them are cyclic so we just replicate the
first 8 bits i.e. a single Packet. Dunno when the given function
involves unsafeInlineIO and produces random bits.
-}
-- | /O(n)/ 'iterate' @f x@ returns an infinite 'Bitstream' of
-- repeated applications of @f@ to @x@:
--
-- @
-- 'iterate' f x == [x, f x, f (f x), ...]
-- @
iterate ∷ G.Bitstream (Packet d) ⇒ (Bool → Bool) → Bool → Bitstream d
{-# INLINE iterate #-}
iterate f b = xs
where
xs = Chunk x xs
x = SB.fromPackets (SV.replicate chunkSize p)
p = pack (L.take 8 (L.iterate f b))
-- | /O(n)/ 'repeat' @x@ is an infinite 'Bitstream', with @x@ the
-- value of every bits.
repeat ∷ G.Bitstream (Packet d) ⇒ Bool → Bitstream d
{-# INLINE repeat #-}
repeat b = xs
where
xs = Chunk x xs
x = SB.fromPackets (SV.replicate chunkSize p)
p = pack (L.replicate 8 b)
-- | /O(n)/ 'cycle' ties a finite 'Bitstream' into a circular one, or
-- equivalently, the infinite repetition of the original 'Bitstream'.
-- It is the identity on infinite 'Bitstream's.
cycle ∷ G.Bitstream (Bitstream d) ⇒ Bitstream d → Bitstream d
{-# INLINE cycle #-}
cycle Empty = emptyStream
cycle ch = ch ⧺ cycle ch
-- | /O(n)/ 'getContents' is equivalent to 'hGetContents'
-- @stdin@. Will read /lazily/.
getContents ∷ G.Bitstream (SB.Bitstream d) ⇒ IO (Bitstream d)
{-# INLINE getContents #-}
getContents = fmap fromByteString LS.getContents
-- | /O(n)/ Write a 'Bitstream' to @stdout@, equivalent to 'hPut'
-- @stdout@.
putBits ∷ ( G.Bitstream (SB.Bitstream d)
, G.Bitstream (Packet d)
)
⇒ Bitstream d
→ IO ()
{-# INLINE putBits #-}
putBits = LS.putStr ∘ toByteString
-- | The 'interact' function takes a function of type @'Bitstream' d
-- -> 'Bitstream' d@ as its argument. The entire input from the stdin
-- is lazily passed to this function as its argument, and the
-- resulting 'Bitstream' is output on the stdout.
interact ∷ ( G.Bitstream (SB.Bitstream d)
, G.Bitstream (Packet d)
)
⇒ (Bitstream d → Bitstream d)
→ IO ()
{-# INLINE interact #-}
interact = LS.interact ∘ lift'
where
{-# INLINE lift' #-}
lift' f = toByteString ∘ f ∘ fromByteString
-- | /O(n)/ Read an entire file lazily into a 'Bitstream'.
readFile ∷ G.Bitstream (SB.Bitstream d) ⇒ FilePath → IO (Bitstream d)
{-# INLINE readFile #-}
readFile = fmap fromByteString ∘ LS.readFile
-- | /O(n)/ Write a 'Bitstream' to a file.
writeFile ∷ ( G.Bitstream (SB.Bitstream d)
, G.Bitstream (Packet d)
)
⇒ FilePath
→ Bitstream d
→ IO ()
{-# INLINE writeFile #-}
writeFile = (∘ toByteString) ∘ LS.writeFile
-- | /O(n)/ Append a 'Bitstream' to a file.
appendFile ∷ ( G.Bitstream (SB.Bitstream d)
, G.Bitstream (Packet d)
)
⇒ FilePath
→ Bitstream d
→ IO ()
{-# INLINE appendFile #-}
appendFile = (∘ toByteString) ∘ LS.appendFile
-- | /O(n)/ Read entire handle contents /lazily/ into a
-- 'Bitstream'. Chunks are read on demand, using the default chunk
-- size.
--
-- Once EOF is encountered, the 'Handle' is closed.
hGetContents ∷ G.Bitstream (SB.Bitstream d) ⇒ Handle → IO (Bitstream d)
{-# INLINE hGetContents #-}
hGetContents = fmap fromByteString ∘ LS.hGetContents
-- |@'hGet' h n@ reads a 'Bitstream' directly from the specified
-- 'Handle' @h@. First argument @h@ is the 'Handle' to read from, and
-- the second @n@ is the number of /octets/ to read, not /bits/. It
-- returns the octets read, up to @n@, or null if EOF has been
-- reached.
--
-- If the handle is a pipe or socket, and the writing end is closed,
-- 'hGet' will behave as if EOF was reached.
--
{-# INLINE hGet #-}
hGet ∷ G.Bitstream (SB.Bitstream d) ⇒ Handle → Int → IO (Bitstream d)
hGet = (fmap fromByteString ∘) ∘ LS.hGet
-- | /O(n)/ 'hGetNonBlocking' is similar to 'hGet', except that it
-- will never block waiting for data to become available, instead it
-- returns only whatever data is available.
{-# INLINE hGetNonBlocking #-}
hGetNonBlocking ∷ ( G.Bitstream (SB.Bitstream d)
, G.Bitstream (Packet d)
)
⇒ Handle
→ Int
→ IO (Bitstream d)
hGetNonBlocking = (fmap fromByteString ∘) ∘ LS.hGetNonBlocking
-- | /O(n)/ Write a 'Bitstream' to the given 'Handle'.
hPut ∷ ( G.Bitstream (SB.Bitstream d)
, G.Bitstream (Packet d)
)
⇒ Handle
→ Bitstream d
→ IO ()
{-# INLINE hPut #-}
hPut = (∘ toByteString) ∘ LS.hPut