Steaming resumable coordinate parsing with pipes-parse.

gistfile1.txt

import Control.Proxy                                                             
import Control.Proxy.Trans.State                                                 
import Control.Proxy.Parse                                                       
                                                                                 
import Control.Monad                                                             
                                                                                                                                                             
                                                                                 
coordinate = liftP . pull --  Could be more complex with needing its own buffer  
                          -- type and failure mechanisms                         
                                                                                 
pair () = loop                                                                   
  where                                                                          
    loop = do                                                                    
        mes <- drawN 2 () -- unDraw on fail handled by drawN                     
        case mes of                                                              
            Nothing -> return ()                                                 
            Just [a, b] -> do                                                    
                respond (a, b)                                                   
                eof <- isEndOfInput                                              
                loop                                                             
                                                                                 
pullReturn = runIdentityK loop                                                   
  where                                                                          
    loop x = do                                                                  
        a <- request x                                                           
        return a                                                                 
                                                                                 
coordinatePair () = loop                                                         
  where                                                                          
    loop = do                                                                    
        as <- zoom _fst . coordinate >-> zoom _snd . wrap .pair >-> pullReturn $ ()
        respond as                                                               
        loop
                                                                     
processPair () = loop                                                            
  where                                                                          
    loop = do                                                                    
        p <- coordinatePair >-> pullReturn $ ()                                  
        case p of                                                                
            Nothing -> return () --  push back on failure handled by             
                                      -- corrdinatePair                          
            Just (a, b) -> do                                                    
                respond (2 * a, b + 3)                                           
                loop                                                             
                                                                                 
{- |                                                                             
 - > runProxy $ runStateK mempty $  wrap . (fromListS [1..9]) >-> processPair >-> printD
 - (2,5)                                                                         
 - (6,7)                                                                         
 - (10,9)                                                                        
 - (14,11)                                                                       
 - ((),((),[9]))                                                                 
 - ghci> runProxy $ runStateK ((),[9]) $  wrap . (fromListS [10,11,12]) >-> processPair >-> printD
 - (18,13)                                                                       
 - (22,15)                                                                       
 - ((),((),[]))                                                                  
 -}                                                                              
                                                                                 
example = do                                                                     
    (_, buffers) <- runProxy $ runStateK mempty $  wrap . (fromListS [1..9]) >-> processPair >-> printD
    runProxy $ runStateK ((),[9]) $  wrap . (fromListS [10,11,12]) >-> processPair >-> printD                                 

                                                                                 
----- code already introduced                                                    
                                                                                 
drawN n0 () = loop n0 []                                                         
  where                                                                          
    loop 0 as = return $ Just (reverse as)                                       
    loop n as = do                                                               
        ma <- draw                                                               
        case ma of                                                               
            Nothing -> unDraws as >> return Nothing                              
            Just a  -> loop (n - 1) (a:as)                                       
                                                                                 
unDraws = mapM_  unDraw

{- |                                                                             
 - > runProxy $ runStateK mempty $  wrap . (fromListS [1..9]) >-> processPair >-> printD
 - (2,5)                                                                         
 - (6,7)                                                                         
 - (10,9)                                                                        
 - (14,11)                                                                       
 - ((),((),[9]))                                                                 
 - ghci> runProxy $ runStateK ((),[9]) $  wrap . (fromListS [10,11,12]) >-> processPair >-> printD
 - (18,13)                                                                       
 - (22,15)                                                                       
 - ((),((),[]))                                                                  
 -}                                                                              
example = do                                                                     
    (_, buffers) <- runProxy $ runStateK mempty $  wrap . (fromListS [1..9]) >-> processPair >-> printD
    putStrLn $ "The buffers before restarting: " ++ show buffers                 
    runProxy $ runStateK ([],[9]) $  wrap . (fromListS [10,11,12]) >-> processPair >-> printD
                                                                                 
                                                                                 
                                                                                 
----- code already introduced                                                    
                                                                                 
drawN n0 () = loop n0 []                                                         
  where                                                                          
    loop 0 as = return $ Just (reverse as)                                       
    loop n as = do                                                               
        ma <- draw                                                               
        case ma of                                                               
            Nothing -> unDraws as >> return Nothing                              
            Just a  -> loop (n - 1) (a:as)                                       
                                                                                 
unDraws = mapM_  unDraw