Lazy dekodowanie listy z Data.Binary

Question

ja leniwie kodowania list przy użyciu tego kodu (wzięte z tego SO question):

import Data.Binary 

newtype Stream a = Stream { unstream :: [a] } 

instance Binary a => Binary (Stream a) where 

    put (Stream [])  = putWord8 0 
    put (Stream (x:xs)) = putWord8 1 >> put x >> put (Stream xs) 

Problem polega na tym, że realizacja dekodowanie nie jest leniwy:

get = do 
     t <- getWord8 
     case t of 
      0 -> return (Stream []) 
      1 -> do x   <- get 
        Stream xs <- get 
        return (Stream (x:xs)) 

to wygląda mi się, że powinna być leniwy, ale jeśli chcemy uruchomić ten kod testowy:

head $ unstream (decode $ encode $ Stream [1..10000000::Integer] :: Stream Integer) 

pamięć użycie eksploduje. Z jakiegoś powodu chce odszyfrować całą listę, zanim pozwolę sobie spojrzeć na pierwszy element.

Dlaczego to nie jest leniwy i jak mogę sprawić, że będzie leniwy?

Answer 1

To nie jest leniwy, bo Get monada jest ścisła monada stan (w binary-0.5.0.2 to 0.5.1.1; był to leniwy monada stan przed i po binary-0.6.* stało się monada kontynuacja, nie analizowano skutki surowości tej zmiany):

-- | The parse state 
data S = S {-# UNPACK #-} !B.ByteString -- current chunk 
      L.ByteString     -- the rest of the input 
      {-# UNPACK #-} !Int64   -- bytes read 

-- | The Get monad is just a State monad carrying around the input ByteString 
-- We treat it as a strict state monad. 
newtype Get a = Get { unGet :: S -> (# a, S #) } 

-- Definition directly from Control.Monad.State.Strict 
instance Monad Get where 
    return a = Get $ \s -> (# a, s #) 
    {-# INLINE return #-} 

    m >>= k = Get $ \s -> case unGet m s of 
          (# a, s' #) -> unGet (k a) s' 
    {-# INLINE (>>=) #-} 

zatem ostateczna rekurencyjne

get >>= \x -> 
get >>= \(Stream xs) -> 
return (Stream (x:xs)) 

zmusza całą Stream należy czytać, zanim będzie mógł zostać zwrócony.

Nie sądzę, że możliwe jest lazily dekodowanie Stream w monadzie Get (więc a fortiori nie z instancją Binary). Ale można napisać leniwe funkcję dekodowania przy użyciu runGetState:

-- | Run the Get monad applies a 'get'-based parser on the input 
-- ByteString. Additional to the result of get it returns the number of 
-- consumed bytes and the rest of the input. 
runGetState :: Get a -> L.ByteString -> Int64 -> (a, L.ByteString, Int64) 
runGetState m str off = 
    case unGet m (mkState str off) of 
     (# a, ~(S s ss newOff) #) -> (a, s `join` ss, newOff) 

Pisać Get parsera, która zwraca Maybe a,

getMaybe :: Binary a => Get (Maybe a) 
getMaybe = do 
    t <- getWord8 
    case t of 
     0 -> return Nothing 
     _ -> fmap Just get 

następnie używać, aby utworzyć funkcję typu (ByteString,Int64) -> Maybe (a,(ByteString,Int64)):

step :: Binary a => (ByteString,Int64) -> Maybe (a,(ByteString,Int64)) 
step (xs,offset) = case runGetState getMaybe xs offset of 
        (Just v, ys, newOffset) -> Just (v,(ys,newOffset)) 
        _      -> Nothing 

, a następnie można użyć Data.List.unfoldr do lazily dekodowania listy,

lazyDecodeList :: Binary a => ByteString -> [a] 
lazyDecodeList xs = unfoldr step (xs,0) 

i owinąć że w Stream

lazyDecodeStream :: Binary a => ByteString -> Stream a 
lazyDecodeStream = Stream . lazyDecodeList