module Data.Bitstream
(
Bitstream
, Left
, Right
, empty
, (∅)
, singleton
, pack
, unpack
, fromPackets
, toPackets
, fromByteString
, toByteString
, stream
, unstream
, directionLToR
, directionRToL
, cons
, snoc
, append
, (⧺)
, head
, last
, tail
, init
, null
, length
, map
, reverse
, foldl
, foldl'
, foldl1
, foldl1'
, foldr
, foldr1
, concat
, concatMap
, and
, or
, any
, all
, scanl
, scanl1
, scanr
, scanr1
, replicate
, unfoldr
, unfoldrN
, take
, drop
, takeWhile
, dropWhile
, span
, break
, elem
, (∈)
, (∋)
, notElem
, (∉)
, (∌)
, find
, filter
, partition
, (!!)
, elemIndex
, elemIndices
, findIndex
, findIndices
, zip
, zip3
, zip4
, zip5
, zip6
, zipWith
, zipWith3
, zipWith4
, zipWith5
, zipWith6
, unzip
, unzip3
, unzip4
, unzip5
, unzip6
, getContents
, putBits
, interact
, readFile
, writeFile
, appendFile
, hGetContents
, hGet
, hGetSome
, hGetNonBlocking
, hPut
)
where
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 as BS
import qualified Data.List as L
import Data.Monoid
import qualified Data.Vector.Generic as GV
import qualified Data.Vector.Storable as SV
import qualified Data.Vector.Fusion.Stream as S
import Data.Vector.Fusion.Stream.Monadic (Stream(..), Step(..))
import Data.Vector.Fusion.Stream.Size
import Data.Vector.Fusion.Util
import Prelude ( Bool(..), Eq(..), Int, Integral, Maybe(..), Monad(..), Num(..)
, Ord(..), Show(..), ($), div, error, fmap
, fromIntegral, fst, mod, otherwise
)
import Prelude.Unicode hiding ((⧺), (∈), (∉))
import System.IO (FilePath, Handle, IO)
newtype Bitstream d
= Bitstream (SV.Vector (Packet d))
instance Show (Packet d) ⇒ Show (Bitstream d) where
show (Bitstream v0)
= L.concat
[ "(S"
, L.concat (L.unfoldr go v0)
, ")"
]
where
go v | SV.null v = Nothing
| otherwise = Just (show (SV.head v), SV.tail v)
instance G.Bitstream (Packet d) ⇒ Eq (Bitstream d) where
x == y = stream x ≡ stream y
instance G.Bitstream (Packet d) ⇒ Ord (Bitstream d) where
x `compare` y = stream x `compare` stream y
instance G.Bitstream (Packet d) ⇒ Monoid (Bitstream d) where
mempty = (∅)
mappend = (⧺)
mconcat = concat
instance G.Bitstream (Packet d) ⇒ G.Bitstream (Bitstream d) where
stream (Bitstream v)
=
S.concatMap stream (GV.stream v)
`S.sized`
Exact (length (Bitstream v))
unstream
=
Bitstream ∘ GV.unstream ∘ packPackets
cons b (Bitstream v)
| SV.null v = Bitstream (SV.singleton (singleton b))
| otherwise = case SV.head v of
p | length p < (8 ∷ Int)
→ Bitstream ((b `cons` p) `SV.cons` SV.tail v)
| otherwise
→ Bitstream (singleton b `SV.cons` v)
snoc (Bitstream v) b
| SV.null v = Bitstream (SV.singleton (singleton b))
| otherwise = case SV.last v of
p | length p < (8 ∷ Int)
→ Bitstream (SV.init v `SV.snoc` (p `snoc` b))
| otherwise
→ Bitstream (v `SV.snoc` singleton b)
append (Bitstream x) (Bitstream y)
= Bitstream (x SV.++ y)
tail (Bitstream v)
| SV.null v = emptyStream
| otherwise = case tail (SV.head v) of
p' | null p' → Bitstream (SV.tail v)
| otherwise → Bitstream (p' `SV.cons` SV.tail v)
init (Bitstream v)
| SV.null v = emptyStream
| otherwise = case init (SV.last v) of
p' | null p' → Bitstream (SV.init v)
| otherwise → Bitstream (SV.init v `SV.snoc` p')
map f (Bitstream v)
= Bitstream (SV.map (map f) v)
reverse (Bitstream v)
= Bitstream (SV.reverse (SV.map reverse v))
scanl f b
= unstream ∘ S.scanl f b ∘ stream
concat = Bitstream ∘ SV.concat ∘ L.map toPackets
replicate n0 b
| n0 ≤ 0 = (∅)
| n0 `mod` 8 ≡ 0 = Bitstream anterior
| otherwise = Bitstream (anterior `SV.snoc` posterior)
where
anterior = SV.replicate n p
where
n ∷ Int
n = fromIntegral (n0 `div` 8)
p = replicate (8 ∷ Int) b
posterior = replicate n b
where
n ∷ Int
n = fromIntegral (n0 `mod` 8)
take n0 (Bitstream v0)
| n0 ≤ 0 = (∅)
| otherwise = Bitstream (SV.unfoldrN nOctets go (n0, v0))
where
nOctets ∷ Int
nOctets = fromIntegral (min n0 (fromIntegral (SV.length v0)))
go (0, _) = Nothing
go (n, v)
| SV.null v = Nothing
| otherwise = let p = SV.head v
v' = SV.tail v
p' = take n p
n' = n length p'
in
return (p', (n', v'))
drop n0 (Bitstream v0)
| n0 ≤ 0 = Bitstream v0
| otherwise = Bitstream (go n0 v0)
where
go 0 v = v
go n v
| SV.null v = v
| otherwise = case SV.head v of
p | n ≥ length p → go (n length p) (SV.tail v)
| otherwise → drop n p `SV.cons` (SV.tail v)
takeWhile f (Bitstream v0)
= Bitstream (GV.unstream (takeWhilePS (GV.stream v0)))
where
takeWhilePS (Stream step s0 sz) = Stream step' (Just s0) (toMax sz)
where
step' Nothing = return Done
step' (Just s)
= do r ← step s
case r of
Yield p s'
→ case takeWhile f p of
p' | p ≡ p' → return $ Yield p' (Just s')
| otherwise → return $ Yield p' Nothing
Skip s'
→ return $ Skip (Just s')
Done
→ return Done
dropWhile f (Bitstream v0) = Bitstream (go v0)
where
go v | SV.null v = v
| otherwise = case dropWhile f (SV.head v) of
p' | null p' → go (SV.tail v)
| otherwise → p' `SV.cons` SV.tail v
filter f (Bitstream v0)
= Bitstream (GV.unstream (filterPS (GV.stream v0)))
where
filterPS (Stream step s0 sz) = Stream step' s0 (toMax sz)
where
step' s
= do r ← step s
case r of
Yield p s' → case filter f p of
p' | null p' → return $ Skip s'
| otherwise → return $ Yield p' s'
Skip s' → return $ Skip s'
Done → return Done
strictHead ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bool
strictHead (Bitstream v) = head (SV.head v)
strictLast ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bool
strictLast (Bitstream v) = last (SV.last v)
strictNull ∷ Bitstream d → Bool
strictNull (Bitstream v) = SV.null v
strictLength ∷ (G.Bitstream (Packet d), Num n) ⇒ Bitstream d → n
strictLength (Bitstream v)
= SV.foldl' (\n p → n + length p) 0 v
strictAnd ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bool
strictAnd (Bitstream v)
= SV.all and v
strictOr ∷ G.Bitstream (Packet d) ⇒ Bitstream d → Bool
strictOr (Bitstream v)
= SV.any or v
strictIndex ∷ (G.Bitstream (Packet d), Integral n) ⇒ Bitstream d → n → Bool
strictIndex (Bitstream v0) i0
| i0 < 0 = indexOutOfRange i0
| otherwise = go v0 i0
where
go v i
| SV.null v = indexOutOfRange i
| otherwise = case SV.head v of
p | i < length p → p !! i
| otherwise → go (SV.tail v) (i length p)
emptyStream ∷ α
emptyStream
= error "Data.Bitstream: empty stream"
indexOutOfRange ∷ Integral n ⇒ n → α
indexOutOfRange n = error ("Data.Bitstream: index out of range: " L.++ show n)
fromByteString ∷ BS.ByteString → Bitstream d
fromByteString bs0 = Bitstream (SV.unfoldrN nOctets go bs0)
where
nOctets ∷ Int
nOctets = BS.length bs0
go bs = do (o, bs') ← BS.uncons bs
return (fromOctet o, bs')
toByteString ∷ ∀d. G.Bitstream (Packet d) ⇒ Bitstream d → BS.ByteString
toByteString = unstreamBS
∘ (packPackets ∷ Stream Id Bool → Stream Id (Packet d))
∘ stream
unstreamBS ∷ Stream Id (Packet d) → BS.ByteString
unstreamBS (Stream step s0 sz)
= case upperBound sz of
Just n → fst $ BS.unfoldrN n (unId ∘ go) s0
Nothing → BS.unfoldr (unId ∘ go) s0
where
go s = do r ← step s
case r of
Yield p s' → return $ Just (toOctet p, s')
Skip s' → go s'
Done → return Nothing
fromPackets ∷ SV.Vector (Packet d) → Bitstream d
fromPackets = Bitstream
toPackets ∷ Bitstream d → SV.Vector (Packet d)
toPackets (Bitstream d) = d
directionLToR ∷ Bitstream Left → Bitstream Right
directionLToR (Bitstream v) = Bitstream (SV.map packetLToR v)
directionRToL ∷ Bitstream Right → Bitstream Left
directionRToL (Bitstream v) = Bitstream (SV.map packetRToL v)
getContents ∷ G.Bitstream (Packet d) ⇒ IO (Bitstream d)
getContents = fmap fromByteString BS.getContents
putBits ∷ G.Bitstream (Packet d) ⇒ Bitstream d → IO ()
putBits = BS.putStr ∘ toByteString
interact ∷ G.Bitstream (Packet d) ⇒ (Bitstream d → Bitstream d) → IO ()
interact = BS.interact ∘ lift'
where
lift' f = toByteString ∘ f ∘ fromByteString
readFile ∷ G.Bitstream (Packet d) ⇒ FilePath → IO (Bitstream d)
readFile = fmap fromByteString ∘ BS.readFile
writeFile ∷ G.Bitstream (Packet d) ⇒ FilePath → Bitstream d → IO ()
writeFile = (∘ toByteString) ∘ BS.writeFile
appendFile ∷ G.Bitstream (Packet d) ⇒ FilePath → Bitstream d → IO ()
appendFile = (∘ toByteString) ∘ BS.appendFile
hGetContents ∷ G.Bitstream (Packet d) ⇒ Handle → IO (Bitstream d)
hGetContents = fmap fromByteString ∘ BS.hGetContents
hGet ∷ G.Bitstream (Packet d) ⇒ Handle → Int → IO (Bitstream d)
hGet = (fmap fromByteString ∘) ∘ BS.hGet
hGetSome ∷ G.Bitstream (Packet d) ⇒ Handle → Int → IO (Bitstream d)
hGetSome = (fmap fromByteString ∘) ∘ BS.hGetSome
hGetNonBlocking ∷ G.Bitstream (Packet d) ⇒ Handle → Int → IO (Bitstream d)
hGetNonBlocking = (fmap fromByteString ∘) ∘ BS.hGetNonBlocking
hPut ∷ G.Bitstream (Packet d) ⇒ Handle → Bitstream d → IO ()
hPut = (∘ toByteString) ∘ BS.hPut