Search code examples
haskellconduithaskell-pipes

Using pipes-parse to preserve leftovers with a map


I'm trying to understand how pipes-parse 3.0 works for cases besides span and splitAt, and can't quite figure out how to get things working. The basic idea is that I have an isomorphism, and I'd like to map all input values to convert from type A to type B. Then, I'd like all leftovers to be converted back from B to A. How would I accomplish this in pipes-parse?

For comparison, the code would look like the following in conduit:

import           Control.Applicative ((<$>), (<*>))
import           Data.Conduit        (yield, ($$), (=$=))
import           Data.Conduit.Extra  (fuseLeftovers)
import qualified Data.Conduit.List   as CL

newtype A = A Int
    deriving Show
newtype B = B Int
    deriving Show

atob (A i) = (B i)
btoa (B i) = (A i)

main :: IO ()
main = do
    let src = mapM_ (yield . A) [1..10]
    res <- src $$ (,,,)
        <$> fuseLeftovers (map btoa) (CL.map atob) CL.peek
        <*> CL.take 3
        <*> (CL.map atob =$= CL.take 3)
        <*> CL.consume
    print res

EDIT: To clarify, here's the output of my above code:

(Just (B 1),[A 1,A 2,A 3],[B 4,B 5,B 6],[A 7,A 8,A 9,A 10])

Note that the original stream is of type A. We're converting to B and peeking at the first element, then taking the next 3 elements as type A, then taking the following three as B, and finally taking the remainder as A.


Solution

  • I did it by introducing an auxiliary lens combinator, piso :: Iso' a b -> Iso' (Producer a m r) (Producer b m r)

    import           Control.Applicative
    import           Control.Lens               (view, from, zoom, iso, Iso')
    import           Control.Monad.State.Strict (evalState)
    import           Pipes
    import           Pipes.Core                 as Pc
    import qualified Pipes.Parse                as Pp
    import qualified Pipes.Prelude              as P
    
    newtype A = A Int
        deriving Show
    newtype B = B Int
        deriving Show
    
    atob (A i) = B i
    btoa (B i) = A i
    
    ab :: Iso' A B
    ab = iso atob btoa
    
    piso :: Monad m => Iso' a b -> Iso' (Producer a m r) (Producer b m r)
    piso i = iso (P.map (view i) <-<) (>-> P.map (view $ from i))
    
    main :: IO ()
    main = do
      let src = P.map atob <-< P.map A <-< each [1..10]
      let parser = (,,) <$> zoom (Pp.splitAt 1) Pp.peek
                        <*> zoom (Pp.splitAt 3 . piso (from ab)) Pp.drawAll
                        <*> Pp.drawAll
      let res = evalState parser src
      print res
    

    Here src is a Producer B m r and parser a Parser B m (Maybe B, [A], [B]). I think the heart of this is that leftovers are just what happens in the Parser-State bound Producer after some prior parsing actions. You can thus use zoom just like normal to modify that Producer however you like.

    Note that we could flip the order of the lenses and do zoom (piso (from ab) . Pp.splitAt 3) Pp.drawAll but since lenses descend from left to right that means that we're modifying the entire Producer prior to focusing on the next three elements. Using the order in my primary example reduces the number of mappings between A and B.

    view (Pp.splitAt 3 . piso (from ab))
      :: Monad m => Producer B m x -> (Producer A m (Producer B m x))
      -- note that only the outer, first Producer has been mapped over, the protected,
      -- inner producer in the return type is isolated from `piso`'s effect
    
    view (piso (from ab) . Pp.splitAt 3)
      :: Monad m => Producer B m x -> (Producer A m (Producer A m x))