Playing with pipes-bytestring, pipes-attoparsec, and aeson

gistfile1.hs

{-# LANGUAGE NoMonomorphismRestriction #-}

module Main where

import Control.Applicative
import Control.Proxy
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy as BLI
import qualified Control.Proxy.Attoparsec as PA
import qualified Control.Proxy.ByteString as PBS
import qualified Data.Aeson
import qualified Data.Aeson.Parser



main = runProxy $ PBS.stdinS
              >-> PA.parserInputD
              >-> PA.parserD Data.Aeson.Parser.json'
              >-> takeB 1

           -- each of these alternatives receives Data.Aeson.ToJSON values
           -- upstream and send downstream chunks of JSON as Strict ByteString.
           -- >-> alternative1
           -- >-> alternative2
           -- >-> alternative3
              >-> alternative4
           -- >-> alternative5

              >-> PBS.stdoutD
  where
    alternative1 = encodeD
    alternative2 = encodeUtilD
    alternative3 = mapD Data.Aeson.encode >-> fromLazyD
    alternative4 = forD $ sendLazyChunks . Data.Aeson.encode
    alternative5 = mapD Data.Aeson.encode >-> foreverK (request >=> mapM_ respond . BL.toChunks)



-- | Tie together JSON encoding and streaming Strict ByteString chunks by hand. Boring.
encodeD
 :: (Monad m, Proxy p)
 => () -> Pipe p Data.Aeson.Value BS.ByteString m r
encodeD () = runIdentityP . forever $ do
  json <- Data.Aeson.encode <$> request ()
  BLI.foldrChunks (\e a -> respond e >> a) (return ()) $ json
  -- or the cleaner: mapM_ respond $ BL.toChunks json


-- | Tie together JSON encoding and streaming Strict ByteString chunks by
-- reusing a practical, misnamed, 'sendLazyChunks' function.
encodeUtilD
 :: (Monad m, Proxy p)
 => () -> Pipe p Data.Aeson.Value BS.ByteString m r
encodeUtilD () = runIdentityP . forever $ do
  json <- Data.Aeson.encode <$> request ()
  sendLazyChunks json


-- | Given a Lazy ByteString, sends its Strict ByteString chunks downstream.
sendLazyChunks
 :: (Monad m, Proxy p)
 => BL.ByteString -> p a' a b' BS.ByteString m ()
sendLazyChunks lbs = runIdentityP $
  BLI.foldrChunks (\e a -> respond e >> a) (return ()) lbs
-- sendLazyChunks = runIdentityP . mapM_ respond . BL.toChunks


-- | For each Lazy ByteString received from upstream, individually send
-- downstream each of its Strict ByteString chunks.
fromLazyD
 :: (Monad m, Proxy p)
 => () -> Pipe p BL.ByteString BS.ByteString m r
fromLazyD () = runIdentityP . forever $ go where
  go = request () >>= BLI.foldrChunks (\e a -> respond e >> a) (return ())


-- | Execute the monadic function @f@ for each value received upstream.
forD
 :: (Monad (p a b1 b' b2 m), Monad m, Proxy p)
 => (b1 -> p a b1 b' b2 m a) -> a -> p a b1 b' b2 m b
forD f = foreverK $ request >=> f