{-# LANGUAGE OverloadedStrings #-}
module System.IO.Streams.Debug
(
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)
-> ByteString
-> OutputStream ByteString
-> InputStream a
-> IO (InputStream a)
debugInput :: (a -> ByteString)
-> ByteString
-> OutputStream ByteString
-> InputStream a
-> IO (InputStream a)
debugInput toBS :: a -> ByteString
toBS name :: ByteString
name debugStream :: OutputStream ByteString
debugStream inputStream :: 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 c :: a
c = do
let s :: ByteString
s = [ByteString] -> ByteString
S.concat [ByteString
name, ": pushback: ", a -> ByteString
toBS a
c, "\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 m :: Maybe a
m = [ByteString] -> ByteString
S.concat [ByteString
name, ": got ", Maybe a -> ByteString
describeChunk Maybe a
m, "\n"]
describeChunk :: Maybe a -> ByteString
describeChunk Nothing = "EOF"
describeChunk (Just s :: a
s) = [ByteString] -> ByteString
S.concat [ "chunk: ", a -> ByteString
toBS a
s ]
debugInputBS ::
ByteString
-> OutputStream ByteString
-> InputStream ByteString
-> 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)
-> ByteString
-> OutputStream ByteString
-> OutputStream a
-> IO (OutputStream a)
debugOutput :: (a -> ByteString)
-> ByteString
-> OutputStream ByteString
-> OutputStream a
-> IO (OutputStream a)
debugOutput toBS :: a -> ByteString
toBS name :: ByteString
name debugStream :: OutputStream ByteString
debugStream outputStream :: 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 m :: 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 m :: Maybe a
m = [ByteString] -> ByteString
S.concat [ByteString
name, ": got ", Maybe a -> ByteString
describeChunk Maybe a
m, "\n"]
describeChunk :: Maybe a -> ByteString
describeChunk Nothing = "EOF"
describeChunk (Just s :: a
s) = [ByteString] -> ByteString
S.concat [ "chunk: ", a -> ByteString
toBS a
s]
debugOutputBS ::
ByteString
-> OutputStream ByteString
-> OutputStream ByteString
-> 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 s :: ByteString
s | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 32 = [ByteString] -> ByteString
S.concat [ "\"", ByteString
s, "\"" ]
| Bool
otherwise = [ByteString] -> ByteString
S.concat [
"\""
, Int -> ByteString -> ByteString
S.take Int
k ByteString
s
, " ... "
, Int -> ByteString -> ByteString
S.drop (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) ByteString
s
, "\" ("
, String -> ByteString
S.pack (Int -> String
forall a. Show a => a -> String
show Int
l)
, " bytes)"
]
where
k :: Int
k = 14
l :: Int
l = ByteString -> Int
S.length ByteString
s