pigro decodifica di una lista con Data.Binary

Question

sto pigramente codifica liste usando questo codice (tratto da questo 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) 

Il problema è che l'implementazione di decodifica non è pigro:

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

questo mi sembra che dovrebbe essere pigro, ma se corriamo il codice di prova:

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

memoria l'uso esplode. Per qualche ragione vuole decodificare l'intera lista prima di lasciarmi guardare il primo elemento.

Perché questa non è pigro, e come posso farlo pigro?

Answer 1

Non è pigro, perché la monade Get è una rigorosa monade stato (in binary-0.5.0.2 to 0.5.1.1, era una monade stato pigro prima, e in binary-0.6.* è diventato una monade di continuazione, non ho analizzato le implicazioni severità di quel cambiamento):

-- | 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 (>>=) #-} 

così la finale ricorsiva

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

costringe l'intero Stream da leggere prima che possa essere restituito.

Non penso sia possibile decodificare pigramente uno Stream nella monade Get (quindi a fortiori non con l'istanza Binary). Ma si può scrivere una funzione di decodifica pigro utilizzando 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) 

Scrivi un parser Get che restituisce un Maybe a,

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

quindi utilizzare che per fare una funzione di tipo (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 

e quindi è possibile utilizzare per decodificare Data.List.unfoldr pigramente un elenco,

012.351.

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

e avvolgere che in un Stream

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