{-# 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 :: (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 (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
        Maybe a
m <- InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
Streams.read InputStream a
inputStream
        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 -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
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 :: (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