    {-# LANGUAGE OverloadedStrings #-}

    -- | Convenience module for debugging streams. Provides stream transformers
    -- that wrap 'InputStream's and 'OutputStream's, sending a description of all
    -- data to an 'OutputStream' for debugging.

    module System.IO.Streams.Debug
     ( -- * Debuggers
       debugInput
     , debugOutput
     , debugInputBS
     , debugOutputBS
     ) where

    ------------------------------------------------------------------------------
    import           Data.ByteString.Char8      (ByteString)
    import qualified Data.ByteString.Char8      as S
    ------------------------------------------------------------------------------
    import           System.IO.Streams.Internal (InputStream (..), OutputStream)
    import qualified System.IO.Streams.Internal as Streams

    ------------------------------------------------------------------------------
    debugInput ::
         (a -> ByteString)         -- ^ function to convert stream elements to
                                   --   'ByteString'
      -> ByteString                -- ^ name of this debug stream, will be
                                   --   prepended to debug output
      -> OutputStream ByteString   -- ^ stream the debug info will be sent to
      -> InputStream a             -- ^ input stream
      -> IO (InputStream a)
    debugInput :: forall a.
    (a -> ByteString)
    -> ByteString
    -> OutputStream ByteString
    -> InputStream a
    -> IO (InputStream a)
    debugInput a -> ByteString
    toBS ByteString
    name OutputStream ByteString
    debugStream InputStream a
    inputStream = InputStream a -> IO (InputStream a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (InputStream a -> IO (InputStream a))
    -> InputStream a -> IO (InputStream a)
    forall a b. (a -> b) -> a -> b
    $ IO (Maybe a) -> (a -> IO ()) -> InputStream a
    forall a. IO (Maybe a) -> (a -> IO ()) -> InputStream a
    InputStream IO (Maybe a)
    produce a -> IO ()
    pb
      where
        produce :: IO (Maybe a)
    produce = do
            m <- InputStream a -> IO (Maybe a)
    forall a. InputStream a -> IO (Maybe a)
    Streams.read InputStream a
    inputStream
            Streams.write (Just $! describe m) debugStream
            return m

        pb :: a -> IO ()
    pb a
    c = do
            let s :: ByteString
    s = [ByteString] -> ByteString
    S.concat [ByteString
    name, ByteString
    ": pushback: ", a -> ByteString
    toBS a
    c, ByteString
    "\n"]
            Maybe ByteString -> OutputStream ByteString -> IO ()
    forall a. Maybe a -> OutputStream a -> IO ()
    Streams.write (ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    s) OutputStream ByteString
    debugStream
            a -> InputStream a -> IO ()
    forall a. a -> InputStream a -> IO ()
    Streams.unRead a
    c InputStream a
    inputStream

        describe :: Maybe a -> ByteString
    describe Maybe a
    m = [ByteString] -> ByteString
    S.concat [ByteString
    name, ByteString
    ": got ", Maybe a -> ByteString
    describeChunk Maybe a
    m, ByteString
    "\n"]

        describeChunk :: Maybe a -> ByteString
    describeChunk Maybe a
    Nothing = ByteString
    "EOF"
        describeChunk (Just a
    s) = [ByteString] -> ByteString
    S.concat [ ByteString
    "chunk: ", a -> ByteString
    toBS a
    s ]

    ------------------------------------------------------------------------------
    debugInputBS ::
         ByteString                -- ^ name of this debug stream, will be
                                   --   prepended to debug output
      -> OutputStream ByteString   -- ^ stream the debug info will be sent to
      -> InputStream ByteString    -- ^ input stream
      -> IO (InputStream ByteString)
    debugInputBS :: ByteString
    -> OutputStream ByteString
    -> InputStream ByteString
    -> IO (InputStream ByteString)
    debugInputBS = (ByteString -> ByteString)
    -> ByteString
    -> OutputStream ByteString
    -> InputStream ByteString
    -> IO (InputStream ByteString)
    forall a.
    (a -> ByteString)
    -> ByteString
    -> OutputStream ByteString
    -> InputStream a
    -> IO (InputStream a)
    debugInput ByteString -> ByteString
    condense

    ------------------------------------------------------------------------------
    debugOutput :: (a -> ByteString)        -- ^ function to convert stream
                                            --   elements to 'ByteString'
                -> ByteString               -- ^ name of this debug stream, will be
                                            --   prepended to debug output
                -> OutputStream ByteString  -- ^ debug stream
                -> OutputStream a           -- ^ output stream
                -> IO (OutputStream a)
    debugOutput :: forall a.
    (a -> ByteString)
    -> ByteString
    -> OutputStream ByteString
    -> OutputStream a
    -> IO (OutputStream a)
    debugOutput a -> ByteString
    toBS ByteString
    name OutputStream ByteString
    debugStream OutputStream a
    outputStream =
        (Maybe a -> IO ()) -> IO (OutputStream a)
    forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
    Streams.makeOutputStream Maybe a -> IO ()
    f
      where
        f :: Maybe a -> IO ()
    f Maybe a
    m = do
            Maybe ByteString -> OutputStream ByteString -> IO ()
    forall a. Maybe a -> OutputStream a -> IO ()
    Streams.write (ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Maybe a -> ByteString
    describe Maybe a
    m) OutputStream ByteString
    debugStream
            Maybe a -> OutputStream a -> IO ()
    forall a. Maybe a -> OutputStream a -> IO ()
    Streams.write Maybe a
    m OutputStream a
    outputStream

        describe :: Maybe a -> ByteString
    describe Maybe a
    m = [ByteString] -> ByteString
    S.concat [ByteString
    name, ByteString
    ": got ", Maybe a -> ByteString
    describeChunk Maybe a
    m, ByteString
    "\n"]

        describeChunk :: Maybe a -> ByteString
    describeChunk Maybe a
    Nothing = ByteString
    "EOF"
        describeChunk (Just a
    s) = [ByteString] -> ByteString
    S.concat [ ByteString
    "chunk: ", a -> ByteString
    toBS a
    s]

    ------------------------------------------------------------------------------
    debugOutputBS ::
         ByteString                -- ^ name of this debug stream, will be
                                   --   prepended to debug output
      -> OutputStream ByteString   -- ^ stream the debug info will be sent to
      -> OutputStream ByteString    -- ^ output stream
      -> IO (OutputStream ByteString)
    debugOutputBS :: ByteString
    -> OutputStream ByteString
    -> OutputStream ByteString
    -> IO (OutputStream ByteString)
    debugOutputBS = (ByteString -> ByteString)
    -> ByteString
    -> OutputStream ByteString
    -> OutputStream ByteString
    -> IO (OutputStream ByteString)
    forall a.
    (a -> ByteString)
    -> ByteString
    -> OutputStream ByteString
    -> OutputStream a
    -> IO (OutputStream a)
    debugOutput ByteString -> ByteString
    condense

    ------------------------------------------------------------------------------
    condense :: ByteString -> ByteString
    condense :: ByteString -> ByteString
    condense ByteString
    s | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    32 = [ByteString] -> ByteString
    S.concat [ ByteString
    "\"", ByteString
    s, ByteString
    "\"" ]
               | Bool
    otherwise = [ByteString] -> ByteString
    S.concat [
                               ByteString
    "\""
                             , Int -> ByteString -> ByteString
    S.take Int
    k ByteString
    s
                             , ByteString
    " ... "
                             , Int -> ByteString -> ByteString
    S.drop (Int
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    k) ByteString
    s
                             , ByteString
    "\" ("
                             , String -> ByteString
    S.pack (Int -> String
    forall a. Show a => a -> String
    show Int
    l)
                             , ByteString
    " bytes)"
                             ]
      where
        k :: Int
    k = Int
    14
        l :: Int
    l = ByteString -> Int
    S.length ByteString
    s